From db174c984559f8cc7f132a2aaae32b123051a38e Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 8 Sep 2017 12:08:25 +0200 Subject: [PATCH] [multiple changes] 2017-09-08 Hristian Kirtchev * sem_elab.adb (Check_A_Call): Do not consider references to internal variables for SPARK semantics. 2017-09-08 Arnaud Charlet * inline.adb (In_Package_Spec): refine type of the parameter from Node_Id to Entity_Id. 2017-09-08 Justin Squirek * exp_ch5.adb (Expand_Formal_Container_Loop): Reset the scope of the loop parameter after it is reanalyzed. 2017-09-08 Eric Botcazou * sem_util.ads (Set_Rep_Info): New inline procedure. * sem_util.adb (Set_Rep_Info): Implement it. * sem_ch3.adb (Process_Subtype): If the case of a constraint present, always copy the representation aspects onto the subtype. From-SVN: r251882 --- gcc/ada/ChangeLog | 22 ++++++++++++++++++++++ gcc/ada/exp_ch5.adb | 8 +++++++- gcc/ada/inline.adb | 4 ++-- gcc/ada/sem_ch3.adb | 4 +++- gcc/ada/sem_elab.adb | 11 +++++++---- gcc/ada/sem_util.adb | 14 ++++++++++++++ gcc/ada/sem_util.ads | 6 ++++++ 7 files changed, 61 insertions(+), 8 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7b1b79738c4..98e2678a13b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2017-09-08 Hristian Kirtchev + + * sem_elab.adb (Check_A_Call): Do not consider + references to internal variables for SPARK semantics. + +2017-09-08 Arnaud Charlet + + * inline.adb (In_Package_Spec): refine type of + the parameter from Node_Id to Entity_Id. + +2017-09-08 Justin Squirek + + * exp_ch5.adb (Expand_Formal_Container_Loop): + Reset the scope of the loop parameter after it is reanalyzed. + +2017-09-08 Eric Botcazou + + * sem_util.ads (Set_Rep_Info): New inline procedure. + * sem_util.adb (Set_Rep_Info): Implement it. + * sem_ch3.adb (Process_Subtype): If the case of a constraint present, + always copy the representation aspects onto the subtype. + 2017-09-08 Georges-Alex Jaloyan * g-dynhta.adb, g-dynhta.ads (Get_First_Key, Get_Next_key): diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index c3d00659fee..d8d22d02af9 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3126,8 +3126,14 @@ package body Exp_Ch5 is -- as a legal form of assignment to remedy this side effect. Set_Assignment_OK (Name (Advance)); - Analyze (N); + + -- Because we have to analyze the initial declaration of the loop + -- parameter multiple times its scope is incorrectly set at this point + -- to the one surrounding the block statement - so set the scope + -- manually to be the actual block statement. + + Set_Scope (Defining_Identifier (Init_Decl), Entity (Identifier (N))); end Expand_Formal_Container_Loop; ------------------------------------------ diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index aa99201ec9f..7096f7c7431 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -1187,7 +1187,7 @@ package body Inline is -- Return True if subprogram Id defines a compilation unit -- Shouldn't this be in Sem_Aux??? - function In_Package_Spec (Id : Node_Id) return Boolean; + function In_Package_Spec (Id : Entity_Id) return Boolean; -- Return True if subprogram Id is defined in the package specification, -- either its visible or private part. @@ -1292,7 +1292,7 @@ package body Inline is -- In_Package_Spec -- --------------------- - function In_Package_Spec (Id : Node_Id) return Boolean is + function In_Package_Spec (Id : Entity_Id) return Boolean is P : constant Node_Id := Parent (Subprogram_Spec (Id)); -- Parent of the subprogram's declaration diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 9f1d824b4c5..a1d8f8b8714 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -21556,9 +21556,11 @@ package body Sem_Ch3 is Error_Msg_N ("invalid subtype mark in subtype indication", S); end case; - -- Size and Convention are always inherited from the base type + -- Size, Alignment, Representation aspects and Convention are always + -- inherited from the base type. Set_Size_Info (Def_Id, (Subtype_Mark_Id)); + Set_Rep_Info (Def_Id, (Subtype_Mark_Id)); Set_Convention (Def_Id, Convention (Subtype_Mark_Id)); return Def_Id; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 6d920e49477..7be57cfce97 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -721,22 +721,25 @@ package body Sem_Elab is and then not Is_Call_Of_Generic_Formal (N) then return; - end if; -- If this is a rewrite of a Valid_Scalars attribute, then nothing to -- check, we don't mind in this case if the call occurs before the body -- since this is all generated code. - if Nkind (Original_Node (N)) = N_Attribute_Reference + elsif Nkind (Original_Node (N)) = N_Attribute_Reference and then Attribute_Name (Original_Node (N)) = Name_Valid_Scalars then return; - end if; -- Intrinsics such as instances of Unchecked_Deallocation do not have -- any body, so elaboration checking is not needed, and would be wrong. - if Is_Intrinsic_Subprogram (E) then + elsif Is_Intrinsic_Subprogram (E) then + return; + + -- Do not consider references to internal variables for SPARK semantics + + elsif Variable_Case and then not Comes_From_Source (E) then return; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index a399be05f17..a153e9a04df 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -21659,6 +21659,20 @@ package body Sem_Util is end if; end Set_Referenced_Modified; + ------------------ + -- Set_Rep_Info -- + ------------------ + + procedure Set_Rep_Info (T1, T2 : Entity_Id) is + begin + Set_Is_Atomic (T1, Is_Atomic (T2)); + Set_Is_Independent (T1, Is_Independent (T2)); + Set_Is_Volatile_Full_Access (T1, Is_Volatile_Full_Access (T2)); + if Is_Base_Type (T1) then + Set_Is_Volatile (T1, Is_Volatile (T2)); + end if; + end Set_Rep_Info; + ---------------------------- -- Set_Scope_Is_Transient -- ---------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 2d6de5cad41..d0c3a26e553 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2473,6 +2473,12 @@ package Sem_Util is -- (Referenced_As_LHS if Out_Param is False, Referenced_As_Out_Parameter -- if Out_Param is True) is set True, and the other flag set False. + procedure Set_Rep_Info (T1, T2 : Entity_Id); + pragma Inline (Set_Rep_Info); + -- Copies the Is_Atomic, Is_Independent and Is_Volatile_Full_Access flags + -- from sub(type) entity T2 to (sub)type entity T1, as well as Is_Volatile + -- if T1 is a base type. + procedure Set_Scope_Is_Transient (V : Boolean := True); -- Set the flag Is_Transient of the current scope -- 2.30.2