mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 10:40:50 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2017-04-25  Pascal Obry  <obry@adacore.com>

	* g-sercom.ads: Add simple usage of GNAT.Serial_Communication.

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Resolve_Type_Conversion):
	When resolving against any fixed type, set the type of the
	operand as universal real when the operand is a multiplication
	or a division where both operands are of any fixed type.
	(Unique_Fixed_Point_Type): Add local variable ErrN. Improve the
	placement of an error message by pointing to the operand of a
	type conversion rather than the conversion itself.

2017-04-25  Thomas Quinot  <quinot@adacore.com>

	* sem_ch13.adb (Build_Predicate_Function_Declaration): Set
	Needs_Debug_Info when producing SCOs.

2017-04-25  Thomas Quinot  <quinot@adacore.com>

	* exp_ch6.adb (Add_Finalization_Master_Actual_To_Build_In_Place_Call):
	Always pass a null finalization master for a library level named access
	type to which a pragme No_Heap_Finalization applies.

From-SVN: r247216
This commit is contained in:
Arnaud Charlet 2017-04-25 14:49:24 +02:00
parent 6a3936d48b
commit cccb761bc2
5 changed files with 118 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
gcc/ada/ChangeLog
View File

@ -1,3 +1,28 @@
2017-04-25 Pascal Obry <obry@adacore.com>
* g-sercom.ads: Add simple usage of GNAT.Serial_Communication.
2017-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* sem_res.adb (Resolve_Type_Conversion):
When resolving against any fixed type, set the type of the
operand as universal real when the operand is a multiplication
or a division where both operands are of any fixed type.
(Unique_Fixed_Point_Type): Add local variable ErrN. Improve the
placement of an error message by pointing to the operand of a
type conversion rather than the conversion itself.
2017-04-25 Thomas Quinot <quinot@adacore.com>
* sem_ch13.adb (Build_Predicate_Function_Declaration): Set
Needs_Debug_Info when producing SCOs.
2017-04-25 Thomas Quinot <quinot@adacore.com>
* exp_ch6.adb (Add_Finalization_Master_Actual_To_Build_In_Place_Call):
Always pass a null finalization master for a library level named access
type to which a pragme No_Heap_Finalization applies.
2017-04-25 Arnaud Charlet <charlet@adacore.com trojanek>
PR ada/78845

3
gcc/ada/exp_ch6.adb
View File

@ -414,7 +414,8 @@ package body Exp_Ch6 is
-- master.
if Is_Library_Level_Entity (Ptr_Typ)
and then Finalize_Storage_Only (Desig_Typ)
and then (Finalize_Storage_Only (Desig_Typ)
or else No_Heap_Finalization (Ptr_Typ))
then
Actual := Make_Null (Loc);

52
gcc/ada/g-sercom.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2007-2015, AdaCore --
-- Copyright (C) 2007-2016, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -36,6 +36,56 @@ with Interfaces.C;
package GNAT.Serial_Communications is
-- Following is a simple example of using GNAT.Serial_Communications.
--
-- with Ada.Streams;
-- with GNAT.Serial_Communications;
--
-- procedure Serial is
-- use Ada.Streams;
-- use GNAT;
--
-- subtype Message is Stream_Element_Array (1 .. 20);
--
-- Data : constant String (1 .. 20) := "ABCDEFGHIJLKMNOPQRST";
-- Buffer : Message;
--
-- S_Port : constant Natural := 5;
-- -- Serial port number
--
-- begin
-- -- Convert message (String -> Stream_Element_Array)
--
-- for K in Data'Range loop
-- Buffer (Stream_Element_Offset (K)) := Character'Pos (Data (K));
-- end loop;
--
-- declare
-- Port_Name : constant Serial_Communications.Port_Name :=
-- Serial_Communications.Name (Number => S_Port);
-- Port : Serial_Communications.Serial_Port;
--
-- begin
-- Serial_Communications.Open
-- (Port => Port,
-- Name => Port_Name);
--
-- Serial_Communications.Set
-- (Port => Port,
-- Rate => Serial_Communications.B9600,
-- Bits => Serial_Communications.CS8,
-- Stop_Bits => Serial_Communications.One,
-- Parity => Serial_Communications.Even);
--
-- Serial_Communications.Write
-- (Port => Port,
-- Buffer => Buffer);
--
-- Serial_Communications.Close
-- (Port => Port);
-- end;
-- end Serial;
Serial_Error : exception;
-- Raised when a communication problem occurs

7
gcc/ada/sem_ch13.adb
View File

@ -8908,6 +8908,13 @@ package body Sem_Ch13 is
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Predicate"));
-- The predicate function requires debug info when the predicates are
-- subject to Source Coverage Obligations.
if Opt.Generate_SCO then
Set_Debug_Info_Needed (Func_Id);
end if;
Spec :=
Make_Function_Specification (Loc,
Defining_Unit_Name => Func_Id,

46
gcc/ada/sem_res.adb
View File

@ -10711,7 +10711,15 @@ package body Sem_Res is
-- Mixed-mode operation involving a literal. Context must be a fixed
-- type which is applied to the literal subsequently.
if Is_Fixed_Point_Type (Typ) then
-- Multiplication and division involving two fixed type operands must
-- yield a universal real because the result is computed in arbitrary
-- precision.
if Is_Fixed_Point_Type (Typ)
and then Nkind_In (Operand, N_Op_Divide, N_Op_Multiply)
and then Etype (Left_Opnd (Operand)) = Any_Fixed
and then Etype (Right_Opnd (Operand)) = Any_Fixed
then
Set_Etype (Operand, Universal_Real);
elsif Is_Numeric_Type (Typ)
@ -11722,12 +11730,7 @@ package body Sem_Res is
-----------------------------
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id is
T1 : Entity_Id := Empty;
T2 : Entity_Id;
Item : Node_Id;
Scop : Entity_Id;
procedure Fixed_Point_Error;
procedure Fixed_Point_Error (T1 : Entity_Id; T2 : Entity_Id);
-- Give error messages for true ambiguity. Messages are posted on node
-- N, and entities T1, T2 are the possible interpretations.
@ -11735,13 +11738,21 @@ package body Sem_Res is
-- Fixed_Point_Error --
-----------------------
procedure Fixed_Point_Error is
procedure Fixed_Point_Error (T1 : Entity_Id; T2 : Entity_Id) is
begin
Error_Msg_N ("ambiguous universal_fixed_expression", N);
Error_Msg_NE ("\\possible interpretation as}", N, T1);
Error_Msg_NE ("\\possible interpretation as}", N, T2);
end Fixed_Point_Error;
-- Local variables
ErrN : Node_Id;
Item : Node_Id;
Scop : Entity_Id;
T1 : Entity_Id;
T2 : Entity_Id;
-- Start of processing for Unique_Fixed_Point_Type
begin
@ -11761,7 +11772,7 @@ package body Sem_Res is
and then Scope (Base_Type (T2)) = Scop
then
if Present (T1) then
Fixed_Point_Error;
Fixed_Point_Error (T1, T2);
return Any_Type;
else
T1 := T2;
@ -11787,7 +11798,7 @@ package body Sem_Res is
and then (Is_Potentially_Use_Visible (T2) or else In_Use (T2))
then
if Present (T1) then
Fixed_Point_Error;
Fixed_Point_Error (T1, T2);
return Any_Type;
else
T1 := T2;
@ -11802,11 +11813,20 @@ package body Sem_Res is
end loop;
if Nkind (N) = N_Real_Literal then
Error_Msg_NE
("??real literal interpreted as }!", N, T1);
Error_Msg_NE ("??real literal interpreted as }!", N, T1);
else
-- When the context is a type conversion, issue the warning on the
-- expression of the conversion because it is the actual operation.
if Nkind_In (N, N_Type_Conversion, N_Unchecked_Type_Conversion) then
ErrN := Expression (N);
else
ErrN := N;
end if;
Error_Msg_NE
("??universal_fixed expression interpreted as }!", N, T1);
("??universal_fixed expression interpreted as }!", ErrN, T1);
end if;
return T1;