From cccb761bc29d4c32a24c79d68ef9ac76308d54fc Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 14:49:24 +0200 Subject: [PATCH] [multiple changes] 2017-04-25 Pascal Obry * g-sercom.ads: Add simple usage of GNAT.Serial_Communication. 2017-04-25 Hristian Kirtchev * 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 * sem_ch13.adb (Build_Predicate_Function_Declaration): Set Needs_Debug_Info when producing SCOs. 2017-04-25 Thomas Quinot * 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 --- gcc/ada/ChangeLog | 25 +++++++++++++++++++++ gcc/ada/exp_ch6.adb | 3 ++- gcc/ada/g-sercom.ads | 52 +++++++++++++++++++++++++++++++++++++++++++- gcc/ada/sem_ch13.adb | 7 ++++++ gcc/ada/sem_res.adb | 46 ++++++++++++++++++++++++++++----------- 5 files changed, 118 insertions(+), 15 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3e6afcd1e9a..7f7a28a4057 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2017-04-25 Pascal Obry + + * g-sercom.ads: Add simple usage of GNAT.Serial_Communication. + +2017-04-25 Hristian Kirtchev + + * 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 + + * sem_ch13.adb (Build_Predicate_Function_Declaration): Set + Needs_Debug_Info when producing SCOs. + +2017-04-25 Thomas Quinot + + * 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 PR ada/78845 diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 2a425285d75..24de185bf9b 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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); diff --git a/gcc/ada/g-sercom.ads b/gcc/ada/g-sercom.ads index 9987011cd67..f185a7737df 100644 --- a/gcc/ada/g-sercom.ads +++ b/gcc/ada/g-sercom.ads @@ -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 diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 14d71af0746..38e8279aad5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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, diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 683686f5caa..2a8010dad40 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; -- 2.30.2