From: Arnaud Charlet Date: Thu, 20 Feb 2014 13:48:32 +0000 (+0100) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.9.0~813 X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=c0cdbd39634ec31bb882cb8fd10281c466a3f116;p=thirdparty%2Fgcc.git [multiple changes] 2014-02-20 Robert Dewar * s-os_lib.ads (Rename_File): Minor commment addition. 2014-02-20 Thomas Quinot * einfo.ads: Minor reformatting. 2014-02-20 Hristian Kirtchev * aspects.adb (Exchange_Aspects): New routine. * aspects.ads (Exchange_Aspects): New routine. * atree.adb (Rewrite): Do not check whether the save node has aspects as it never will, instead check the node about to be clobbered. * einfo.adb (Write_Field25_Name): Abstract_States can appear in entities of generic packages. * sem_ch6.adb (Analyze_Expression_Function): Fix the parent pointer of an aspect specification list after rewriting takes place. * sem_ch7.adb (Analyze_Package_Body_Helper): Swap the aspect specifications of the generic template and the copy used for analysis. * sem_ch12.adb (Analyze_Generic_Package_Declaration): Swap the aspect specifications of the generic template and the copy used for analysis. (Analyze_Package_Instantiation): Propagate the aspect specifications from the generic template to the instantiation. (Build_Instance_Compilation_Unit_Nodes): Propagate the aspect specifications from the generic template to the instantiation. * sem_ch13.adb (Analyze_Aspect_Specifications): Handle aspects Abstract_State, Initializes and Initial_Condition when they apply to a package instantiation. 2014-02-20 Robert Dewar * stringt.adb: Add call to Initialize in package initialization. From-SVN: r207946 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7f5199889552..ccd4d0e1c8f1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,38 @@ +2014-02-20 Robert Dewar + + * s-os_lib.ads (Rename_File): Minor commment addition. + +2014-02-20 Thomas Quinot + + * einfo.ads: Minor reformatting. + +2014-02-20 Hristian Kirtchev + + * aspects.adb (Exchange_Aspects): New routine. + * aspects.ads (Exchange_Aspects): New routine. + * atree.adb (Rewrite): Do not check whether the save node has + aspects as it never will, instead check the node about to be clobbered. + * einfo.adb (Write_Field25_Name): Abstract_States can appear in + entities of generic packages. + * sem_ch6.adb (Analyze_Expression_Function): Fix the parent + pointer of an aspect specification list after rewriting takes place. + * sem_ch7.adb (Analyze_Package_Body_Helper): Swap the aspect + specifications of the generic template and the copy used for analysis. + * sem_ch12.adb (Analyze_Generic_Package_Declaration): Swap + the aspect specifications of the generic template and the + copy used for analysis. + (Analyze_Package_Instantiation): Propagate the aspect specifications + from the generic template to the instantiation. + (Build_Instance_Compilation_Unit_Nodes): Propagate the aspect + specifications from the generic template to the instantiation. + * sem_ch13.adb (Analyze_Aspect_Specifications): Handle aspects + Abstract_State, Initializes and Initial_Condition when they + apply to a package instantiation. + +2014-02-20 Robert Dewar + + * stringt.adb: Add call to Initialize in package initialization. + 2014-02-20 Robert Dewar * a-crbtgk.adb, a-cihama.adb, a-coinve.adb, a-ciorse.adb, a-crbtgo.adb, diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index e34c9faad014..3e45c508e76d 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -174,6 +174,31 @@ package body Aspects is return True; end Aspects_On_Body_Or_Stub_OK; + ---------------------- + -- Exchange_Aspects -- + ---------------------- + + procedure Exchange_Aspects (N1 : Node_Id; N2 : Node_Id) is + begin + pragma Assert + (Permits_Aspect_Specifications (N1) + and then Permits_Aspect_Specifications (N2)); + + -- Perform the exchange only when both nodes have lists to be swapped + + if Has_Aspects (N1) and then Has_Aspects (N2) then + declare + L1 : constant List_Id := Aspect_Specifications (N1); + L2 : constant List_Id := Aspect_Specifications (N2); + begin + Set_Parent (L1, N2); + Set_Parent (L2, N1); + Aspect_Specifications_Hash_Table.Set (N1, L2); + Aspect_Specifications_Hash_Table.Set (N2, L1); + end; + end if; + end Exchange_Aspects; + ----------------- -- Find_Aspect -- ----------------- diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index be39625fb938..d0b625edc435 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -786,6 +786,11 @@ package Aspects is -- N denotes a body [stub] with aspects. Determine whether all aspects of N -- are allowed to appear on a body [stub]. + procedure Exchange_Aspects (N1 : Node_Id; N2 : Node_Id); + -- Exchange the aspect specifications of two nodes. If either node lacks an + -- aspect specification list, the routine has no effect. It is assumed that + -- both nodes can support aspects. + function Find_Aspect (Id : Entity_Id; A : Aspect_Id) return Node_Id; -- Find the aspect specification of aspect A associated with entity I. -- Return Empty if Id does not have the requested aspect. diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 35e8a7a09ff3..9e7897e79aad 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -1870,8 +1870,7 @@ package body Atree is -- Both the old and new copies of the node will share the same list -- of aspect specifications if aspect specifications are present. - if Has_Aspects (Sav_Node) then - Set_Has_Aspects (Sav_Node, False); + if Old_Has_Aspects then Set_Aspect_Specifications (Sav_Node, Aspect_Specifications (Old_Node)); end if; diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index c1e0dd17849b..1502d446aad5 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -9290,7 +9290,8 @@ package body Einfo is procedure Write_Field25_Name (Id : Entity_Id) is begin case Ekind (Id) is - when E_Package => + when E_Generic_Package | + E_Package => Write_Str ("Abstract_States"); when E_Variable => diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 0b5d72b1c87d..9fef149ecca5 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3622,13 +3622,12 @@ package Einfo is -- in a Relative_Deadline pragma for a task type. -- Renamed_Entity (Node18) --- Defined in exceptions, packages, subprograms and generic units. Set +-- Defined in exceptions, packages, subprograms, and generic units. Set -- for entities that are defined by a renaming declaration. Denotes the -- renamed entity, or transitively the ultimate renamed entity if -- there is a chain of renaming declarations. Empty if no renaming. -- Renamed_In_Spec (Flag231) - -- Defined in package entities. If a package renaming occurs within -- a package spec, then this flag is set on the renamed package. The -- purpose is to prevent a warning about unused entities in the renamed diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index 32a006eac565..00aebc24e1a6 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -301,7 +301,9 @@ package System.OS_Lib is New_Name : String; Success : out Boolean); -- Rename a file. Success is set True or False indicating if the rename is - -- successful or not. + -- successful or not. Note that on some Systems (notably Windows), if there + -- is already an existing file with the name New_Name, that is one of the + -- conditions that can cause failure. -- The following defines the mode for the Copy_File procedure below. Note -- that "time stamps and other file attributes" in the descriptions below diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 56cdc3d00db5..15c1cbe36c0c 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3019,6 +3019,11 @@ package body Sem_Ch12 is New_N := Copy_Generic_Node (N, Empty, Instantiating => False); Set_Parent_Spec (New_N, Save_Parent); Rewrite (N, New_N); + + -- Once the contents of the generic copy and the template are swapped, + -- do the same for their respective aspect specifications. + + Exchange_Aspects (N, New_N); Id := Defining_Entity (N); Generate_Definition (Id); @@ -3088,7 +3093,6 @@ package body Sem_Ch12 is Check_References (Id); end if; end if; - end Analyze_Generic_Package_Declaration; -------------------------------------------- @@ -3598,7 +3602,7 @@ package body Sem_Ch12 is Make_Package_Renaming_Declaration (Loc, Defining_Unit_Name => Make_Defining_Identifier (Loc, Chars (Gen_Unit)), - Name => New_Occurrence_Of (Act_Decl_Id, Loc)); + Name => New_Occurrence_Of (Act_Decl_Id, Loc)); Append (Unit_Renaming, Renaming_List); @@ -3616,6 +3620,14 @@ package body Sem_Ch12 is Make_Package_Declaration (Loc, Specification => Act_Spec); + -- Propagate the aspect specifications from the package declaration + -- template to the instantiated version of the package declaration. + + if Has_Aspects (Act_Tree) then + Set_Aspect_Specifications (Act_Decl, + New_Copy_List_Tree (Aspect_Specifications (Act_Tree))); + end if; + -- Save the instantiation node, for subsequent instantiation of the -- body, if there is one and we are generating code for the current -- unit. Mark unit as having a body (avoids premature error message). @@ -5007,7 +5019,7 @@ package body Sem_Ch12 is Unit => Act_Decl, Aux_Decls_Node => Make_Compilation_Unit_Aux (Sloc (N))); - Set_Parent_Spec (Act_Decl, Parent_Spec (N)); + Set_Parent_Spec (Act_Decl, Parent_Spec (N)); -- The new compilation unit is linked to its body, but both share the -- same file, so we do not set Body_Required on the new unit so as not @@ -5018,6 +5030,15 @@ package body Sem_Ch12 is -- compilation unit of the instance, since this is the main unit. Rewrite (N, Act_Body); + + -- Propagate the aspect specifications from the package body template to + -- the instantiated version of the package body. + + if Has_Aspects (Act_Body) then + Set_Aspect_Specifications + (N, New_Copy_List_Tree (Aspect_Specifications (Act_Body))); + end if; + Body_Cunit := Parent (N); -- The two compilation unit nodes are linked by the Library_Unit field diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index cf80e8d68489..1e81110fec6b 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2008,13 +2008,22 @@ package body Sem_Ch13 is -- immediately. when Aspect_Abstract_State => Abstract_State : declare - Decls : List_Id; + Context : Node_Id := N; + Decls : List_Id; begin - if Nkind_In (N, N_Generic_Package_Declaration, - N_Package_Declaration) + -- When aspect Abstract_State appears on a generic package, + -- it is propageted to the package instance. The context in + -- this case is the instance spec. + + if Nkind (Context) = N_Package_Instantiation then + Context := Instance_Spec (Context); + end if; + + if Nkind_In (Context, N_Generic_Package_Declaration, + N_Package_Declaration) then - Decls := Visible_Declarations (Specification (N)); + Decls := Visible_Declarations (Specification (Context)); Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( @@ -2025,7 +2034,7 @@ package body Sem_Ch13 is if No (Decls) then Decls := New_List; - Set_Visible_Declarations (N, Decls); + Set_Visible_Declarations (Context, Decls); end if; Prepend_To (Decls, Aitem); @@ -2084,13 +2093,22 @@ package body Sem_Ch13 is -- it must be evaluated at the end of the said declarations. when Aspect_Initial_Condition => Initial_Condition : declare - Decls : List_Id; + Context : Node_Id := N; + Decls : List_Id; begin - if Nkind_In (N, N_Generic_Package_Declaration, - N_Package_Declaration) + -- When aspect Abstract_State appears on a generic package, + -- it is propageted to the package instance. The context in + -- this case is the instance spec. + + if Nkind (Context) = N_Package_Instantiation then + Context := Instance_Spec (Context); + end if; + + if Nkind_In (Context, N_Generic_Package_Declaration, + N_Package_Declaration) then - Decls := Visible_Declarations (Specification (N)); + Decls := Visible_Declarations (Specification (Context)); Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( @@ -2104,7 +2122,7 @@ package body Sem_Ch13 is if No (Decls) then Decls := New_List; - Set_Visible_Declarations (N, Decls); + Set_Visible_Declarations (Context, Decls); end if; Prepend_To (Decls, Aitem); @@ -2125,13 +2143,22 @@ package body Sem_Ch13 is -- said declarations. when Aspect_Initializes => Initializes : declare - Decls : List_Id; + Context : Node_Id := N; + Decls : List_Id; begin - if Nkind_In (N, N_Generic_Package_Declaration, - N_Package_Declaration) + -- When aspect Abstract_State appears on a generic package, + -- it is propageted to the package instance. The context in + -- this case is the instance spec. + + if Nkind (Context) = N_Package_Instantiation then + Context := Instance_Spec (Context); + end if; + + if Nkind_In (Context, N_Generic_Package_Declaration, + N_Package_Declaration) then - Decls := Visible_Declarations (Specification (N)); + Decls := Visible_Declarations (Specification (Context)); Make_Aitem_Pragma (Pragma_Argument_Associations => New_List ( @@ -2144,7 +2171,7 @@ package body Sem_Ch13 is if No (Decls) then Decls := New_List; - Set_Visible_Declarations (N, Decls); + Set_Visible_Declarations (Context, Decls); end if; Prepend_To (Decls, Aitem); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index b3aeb9c63e5e..2bd2e3c70806 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -374,6 +374,13 @@ package body Sem_Ch6 is Generate_Reference (Prev, Defining_Entity (N), 'b', Force => True); Rewrite (N, New_Body); + -- Correct the parent pointer of the aspect specification list to + -- reference the rewritten node. + + if Has_Aspects (N) then + Set_Parent (Aspect_Specifications (N), N); + end if; + -- Propagate any pragmas that apply to the expression function to the -- proper body when the expression function acts as a completion. -- Aspects are automatically transfered because of node rewriting. @@ -429,6 +436,14 @@ package body Sem_Ch6 is Make_Subprogram_Declaration (Loc, Specification => Spec); Rewrite (N, New_Decl); + + -- Correct the parent pointer of the aspect specification list to + -- reference the rewritten node. + + if Has_Aspects (N) then + Set_Parent (Aspect_Specifications (N), N); + end if; + Analyze (N); Set_Is_Inlined (Defining_Entity (New_Decl)); diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 4b3b613e8da7..caf69cea7f9e 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -327,6 +327,11 @@ package body Sem_Ch7 is New_N := Copy_Generic_Node (N, Empty, Instantiating => False); Rewrite (N, New_N); + -- Once the contents of the generic copy and the template are + -- swapped, do the same for their respective aspect specifications. + + Exchange_Aspects (N, New_N); + -- Update Body_Id to point to the copied node for the remainder of -- the processing. diff --git a/gcc/ada/stringt.adb b/gcc/ada/stringt.adb index 6afba04f3def..e5d1573abe1c 100644 --- a/gcc/ada/stringt.adb +++ b/gcc/ada/stringt.adb @@ -475,6 +475,7 @@ package body Stringt is -- Setup the null string begin + Initialize; Start_String; Null_String_Id := End_String;