From d4129bfa7c814dc1878c3256d34f721398617255 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 22 Jan 2014 17:42:55 +0100 Subject: [PATCH] [multiple changes] 2014-01-22 Robert Dewar * debug.adb, exp_ch4.adb, erroutc.adb: Minor reformatting. 2014-01-22 Thomas Quinot * sem_ch7.adb, sem_ch8.adb, exp_ch3.adb: Minor reformatting. 2014-01-22 Thomas Quinot * sem_ch3.adb (Analyze_Object_Declaration): For a constant declaration initialized with a function call, whose type has variable size, need to remove side effects so that the initialization expression becomes a dereference of a temporary reference to the function result. From-SVN: r206928 --- gcc/ada/ChangeLog | 16 ++++++++++++++++ gcc/ada/debug.adb | 5 ++++- gcc/ada/erroutc.adb | 26 ++++++++++++++------------ gcc/ada/exp_ch3.adb | 2 +- gcc/ada/exp_ch4.adb | 3 +-- gcc/ada/sem_ch3.adb | 34 ++++++++++++++++++++++++++++------ gcc/ada/sem_ch7.adb | 2 +- gcc/ada/sem_ch8.adb | 2 +- 8 files changed, 66 insertions(+), 24 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1cb84d207be..44ab1e956eb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2014-01-22 Robert Dewar + + * debug.adb, exp_ch4.adb, erroutc.adb: Minor reformatting. + +2014-01-22 Thomas Quinot + + * sem_ch7.adb, sem_ch8.adb, exp_ch3.adb: Minor reformatting. + +2014-01-22 Thomas Quinot + + * sem_ch3.adb (Analyze_Object_Declaration): For a constant + declaration initialized with a function call, whose type + has variable size, need to remove side effects so that the + initialization expression becomes a dereference of a temporary + reference to the function result. + 2014-01-22 Yannick Moy * errout.adb (Initialize): Remove trick to add dummy entry diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 4cc8febb888..b1c17f8cd42 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -596,7 +596,10 @@ package body Debug is -- d.E Turn selected errors into warnings. This debug switch causes a -- specific set of error messages into warnings. Setting this switch - -- causes Opt.Error_To_Warning to be set to True. + -- causes Opt.Error_To_Warning to be set to True. Right now the only + -- error affected is the case of overlapping subprogram parameters + -- which has become illegal in Ada 2012, but only generates a warning + -- in earlier versions of Ada. -- d.F Sets GNATprove_Mode to True. This allows debugging the frontend in -- the special mode used by GNATprove. diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index d5497d6da6b..63aea28e86a 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1180,26 +1180,27 @@ package body Erroutc is and then not GNATprove_Mode then return; + end if; -- If last entry in table already covers us, this is a redundant pragma -- Warnings (Off) and can be ignored. - elsif Warnings.Last >= Warnings.First + if Warnings.Last >= Warnings.First and then Warnings.Table (Warnings.Last).Start <= Loc and then Loc <= Warnings.Table (Warnings.Last).Stop then return; - - -- Otherwise establish a new entry, extending from the location of the - -- pragma to the end of the current source file. This ending point will - -- be adjusted by a subsequent pragma Warnings (On). - - else - Warnings.Increment_Last; - Warnings.Table (Warnings.Last).Start := Loc; - Warnings.Table (Warnings.Last).Stop := - Source_Last (Current_Source_File); end if; + + -- If none of those special conditions holds, establish a new entry, + -- extending from the location of the pragma to the end of the current + -- source file. This ending point will be adjusted by a subsequent + -- corresponding pragma Warnings (On). + + Warnings.Increment_Last; + Warnings.Table (Warnings.Last).Start := Loc; + Warnings.Table (Warnings.Last).Stop := + Source_Last (Current_Source_File); end Set_Warnings_Mode_Off; -------------------------- @@ -1223,11 +1224,12 @@ package body Erroutc is and then not GNATprove_Mode then return; + end if; -- If the last entry in the warnings table covers this pragma, then -- we adjust the end point appropriately. - elsif Warnings.Last >= Warnings.First + if Warnings.Last >= Warnings.First and then Warnings.Table (Warnings.Last).Start <= Loc and then Loc <= Warnings.Table (Warnings.Last).Stop then diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index ce7f01fb2d0..d055831e34b 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5561,7 +5561,7 @@ package body Exp_Ch3 is Apply_Constraint_Check (Expr, Typ); -- If the expression has been marked as requiring a range - -- generate it now and reset the flag. + -- check, generate it now and reset the flag. if Do_Range_Check (Expr) then Set_Do_Range_Check (Expr, False); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 03dc4fdccc4..97368c09acc 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7330,7 +7330,6 @@ package body Exp_Ch4 is declare Bt : constant Entity_Id := Root_Type (Underlying_Type (Bastyp)); Et : constant Entity_Id := Root_Type (Underlying_Type (Exptyp)); - begin Rewrite (N, Unchecked_Convert_To (Typ, @@ -7610,7 +7609,7 @@ package body Exp_Ch4 is then Rewrite (N, Make_Function_Call (Loc, - Name => New_Reference_To (RTE (Rent), Loc), + Name => New_Reference_To (RTE (Rent), Loc), Parameter_Associations => New_List (Base, Exp))); -- Otherwise we have to introduce conversions (conversions are also diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 74fc6639c61..30c37487507 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2991,6 +2991,11 @@ package body Sem_Ch3 is -- or a variant record type is encountered, Check_Restrictions is called -- indicating the count is unknown. + function Has_Unconstrained_Elements (T : Entity_Id) return Boolean; + -- True if T has discriminants and is unconstrained, or is an array + -- type whose element type Has_Unconstrained_Elements. Shouldn't this + -- be in sem_util??? + ----------------- -- Count_Tasks -- ----------------- @@ -3045,6 +3050,24 @@ package body Sem_Ch3 is end if; end Count_Tasks; + -------------------------------- + -- Has_Unconstrained_Elements -- + -------------------------------- + + function Has_Unconstrained_Elements (T : Entity_Id) return Boolean is + U_T : constant Entity_Id := Underlying_Type (T); + begin + if No (U_T) then + return False; + elsif Is_Record_Type (U_T) then + return Has_Discriminants (U_T) and then not Is_Constrained (U_T); + elsif Is_Array_Type (U_T) then + return Has_Unconstrained_Elements (Component_Type (U_T)); + else + return False; + end if; + end Has_Unconstrained_Elements; + -- Start of processing for Analyze_Object_Declaration begin @@ -3647,16 +3670,15 @@ package body Sem_Ch3 is Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc)); - elsif Present (Underlying_Type (T)) - and then not Is_Constrained (Underlying_Type (T)) - and then Has_Discriminants (Underlying_Type (T)) - and then Nkind (E) = N_Function_Call + elsif Nkind (E) = N_Function_Call and then Constant_Present (N) + and then Has_Unconstrained_Elements (Etype (E)) then -- The back-end has problems with constants of a discriminated type -- with defaults, if the initial value is a function call. We - -- generate an intermediate temporary for the result of the call. - -- It is unclear why this should make it acceptable to gcc. ??? + -- generate an intermediate temporary that will receive a reference + -- to the result of the call. The initialization expression then + -- becomes a dereference of that temporary. Remove_Side_Effects (E); diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 322785afb74..5ae4aa360dd 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -2,7 +2,7 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- S E M . C H 7 -- +-- S E M _ C H 7 -- -- -- -- B o d y -- -- -- diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index a766866dd46..b44d4e0f94a 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -2,7 +2,7 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- S E M . C H 8 -- +-- S E M _ C H 8 -- -- -- -- B o d y -- -- --