From 72267417bd5d1072812339dee3bf426b686f81b6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 23 Apr 2013 11:48:55 +0200 Subject: [multiple changes] 2013-04-23 Robert Dewar * xoscons.adb: Minor reformatting. 2013-04-23 Hristian Kirtchev * sem_prag.adb (Check_Mode): Ensure that a self-referential output appears in both input and output lists of the subprogram as categorized by aspect Global. (Check_Usage): Rename formal parameters to better illustrate their function. Update all uses of the said formals. 2013-04-23 Thomas Quinot * exp_util.adb, exp_util.ads (Fully_Qualified_Name_String): New parameter Append_NUL to make NUL-termination optional. * exp_dist.adb: Consistently use the above throughout instead of Get_Library_Unit_Name_String. From-SVN: r198183 --- gcc/ada/ChangeLog | 19 +++++++++++++++++++ gcc/ada/exp_dist.adb | 49 +++++++++++++++++++++---------------------------- gcc/ada/exp_util.adb | 9 +++++++-- gcc/ada/exp_util.ads | 6 ++++-- gcc/ada/sem_prag.adb | 25 ++++++++++++++----------- gcc/ada/xoscons.adb | 1 - 6 files changed, 65 insertions(+), 44 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3c09dd0..c6d114d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,24 @@ 2013-04-23 Robert Dewar + * xoscons.adb: Minor reformatting. + +2013-04-23 Hristian Kirtchev + + * sem_prag.adb (Check_Mode): Ensure that a + self-referential output appears in both input and output lists of + the subprogram as categorized by aspect Global. + (Check_Usage): Rename formal parameters to better illustrate their + function. Update all uses of the said formals. + +2013-04-23 Thomas Quinot + + * exp_util.adb, exp_util.ads (Fully_Qualified_Name_String): New + parameter Append_NUL to make NUL-termination optional. + * exp_dist.adb: Consistently use the above throughout instead of + Get_Library_Unit_Name_String. + +2013-04-23 Robert Dewar + * sem_util.adb, sem_res.adb, prj-tree.adb, prj-tree.ads: Minor reformatting. diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index d7055f2..3643303 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -2318,7 +2318,7 @@ package body Exp_Dist is procedure Build_Passive_Partition_Stub (U : Node_Id) is Pkg_Spec : Node_Id; - Pkg_Name : String_Id; + Pkg_Ent : Entity_Id; L : List_Id; Reg : Node_Id; Loc : constant Source_Ptr := Sloc (U); @@ -2343,18 +2343,17 @@ package body Exp_Dist is Pkg_Spec := Parent (Corresponding_Spec (U)); L := Declarations (U); end if; + Pkg_Ent := Defining_Entity (Pkg_Spec); - Get_Library_Unit_Name_String (Pkg_Spec); - Pkg_Name := String_From_Name_Buffer; Reg := Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (RTE (RE_Register_Passive_Package), Loc), Parameter_Associations => New_List ( - Make_String_Literal (Loc, Pkg_Name), + Make_String_Literal (Loc, + Fully_Qualified_Name_String (Pkg_Ent, Append_NUL => False)), Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc), + Prefix => New_Occurrence_Of (Pkg_Ent, Loc), Attribute_Name => Name_Version))); Append_To (L, Reg); Analyze (Reg); @@ -4111,13 +4110,13 @@ package body Exp_Dist is Append_To (Decls, Pkg_RPC_Receiver_Body); Analyze (Last (Decls)); - Get_Library_Unit_Name_String (Pkg_Spec); - -- Name Append_To (Register_Pkg_Actuals, Make_String_Literal (Loc, - Strval => String_From_Name_Buffer)); + Strval => + Fully_Qualified_Name_String + (Defining_Entity (Pkg_Spec), Append_NUL => False))); -- Receiver @@ -5591,7 +5590,7 @@ package body Exp_Dist is -- Name Make_String_Literal (Loc, - Fully_Qualified_Name_String (Desig)), + Fully_Qualified_Name_String (Desig, Append_NUL => False)), -- Handler @@ -5938,7 +5937,8 @@ package body Exp_Dist is New_Occurrence_Of (RACW_Parameter, Loc)), Make_String_Literal (Loc, Strval => Fully_Qualified_Name_String - (Etype (Designated_Type (RACW_Type)))), + (Etype (Designated_Type (RACW_Type)), + Append_NUL => False)), Build_Stub_Tag (Loc, RACW_Type), New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), Make_Attribute_Reference (Loc, @@ -6134,7 +6134,8 @@ package body Exp_Dist is Unchecked_Convert_To (RTE (RE_Address), Object), Make_String_Literal (Loc, Strval => Fully_Qualified_Name_String - (Etype (Designated_Type (RACW_Type)))), + (Etype (Designated_Type (RACW_Type)), + Append_NUL => False)), Build_Stub_Tag (Loc, RACW_Type), New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), Make_Attribute_Reference (Loc, @@ -7069,13 +7070,13 @@ package body Exp_Dist is Append_To (Decls, Pkg_RPC_Receiver_Object); Analyze (Last (Decls)); - Get_Library_Unit_Name_String (Pkg_Spec); - -- Name Append_To (Register_Pkg_Actuals, Make_String_Literal (Loc, - Strval => String_From_Name_Buffer)); + Strval => + Fully_Qualified_Name_String + (Defining_Entity (Pkg_Spec), Append_NUL => False))); -- Version @@ -9210,20 +9211,12 @@ package body Exp_Dist is Repo_Id_Str : out String_Id) is begin + Name_Str := Fully_Qualified_Name_String (E, Append_NUL => False); Start_String; Store_String_Chars ("DSA:"); - Get_Library_Unit_Name_String (Scope (E)); - Store_String_Chars - (Name_Buffer (Name_Buffer'First .. - Name_Buffer'First + Name_Len - 1)); - Store_String_Char ('.'); - Get_Name_String (Chars (E)); - Store_String_Chars - (Name_Buffer (Name_Buffer'First .. - Name_Buffer'First + Name_Len - 1)); + Store_String_Chars (Name_Str); Store_String_Chars (":1.0"); Repo_Id_Str := End_String; - Name_Str := String_From_Name_Buffer; end Build_Name_And_Repository_Id; ----------------------- @@ -11134,11 +11127,11 @@ package body Exp_Dist is Package_Spec : Node_Id) return Node_Id is Inst : Node_Id; - Pkg_Name : String_Id; + Pkg_Name : constant String_Id := + Fully_Qualified_Name_String + (Defining_Entity (Package_Spec), Append_NUL => False); begin - Get_Library_Unit_Name_String (Package_Spec); - Pkg_Name := String_From_Name_Buffer; Inst := Make_Package_Instantiation (Loc, Defining_Unit_Name => Make_Temporary (Loc, 'R'), diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index d5f5f0e..c38b023 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2535,7 +2535,10 @@ package body Exp_Util is -- Fully_Qualified_Name_String -- --------------------------------- - function Fully_Qualified_Name_String (E : Entity_Id) return String_Id is + function Fully_Qualified_Name_String + (E : Entity_Id; + Append_NUL : Boolean := True) return String_Id + is procedure Internal_Full_Qualified_Name (E : Entity_Id); -- Compute recursively the qualified name without NUL at the end, adding -- it to the currently started string being generated @@ -2583,7 +2586,9 @@ package body Exp_Util is begin Start_String; Internal_Full_Qualified_Name (E); - Store_String_Char (Get_Char_Code (ASCII.NUL)); + if Append_NUL then + Store_String_Char (Get_Char_Code (ASCII.NUL)); + end if; return End_String; end Fully_Qualified_Name_String; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 39d1c0b..f83aebe 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -442,10 +442,12 @@ package Exp_Util is -- Force_Evaluation further guarantees that all evaluations will yield -- the same result. - function Fully_Qualified_Name_String (E : Entity_Id) return String_Id; + function Fully_Qualified_Name_String + (E : Entity_Id; + Append_NUL : Boolean := True) return String_Id; -- Generates the string literal corresponding to the fully qualified name -- of entity E, in all upper case, with an ASCII.NUL appended at the end - -- of the name. + -- of the name if Append_NUL is True. procedure Generate_Poll_Call (N : Node_Id); -- If polling is active, then a call to the Poll routine is built, diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 8d6a38e..373828e 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9365,10 +9365,10 @@ package body Sem_Prag is -- dependency clause has operator "+". procedure Check_Usage - (Subp_List : Elist_Id; - Item_List : Elist_Id; - Is_Input : Boolean); - -- Verify that all items from list Subp_List appear in Item_List. + (Subp_Items : Elist_Id; + Used_Items : Elist_Id; + Is_Input : Boolean); + -- Verify that all items from Subp_Items appear in Used_Items. -- Emit an error if this is not the case. procedure Collect_Subprogram_Inputs_Outputs; @@ -9765,7 +9765,10 @@ package body Sem_Prag is if Ekind_In (Item_Id, E_Abstract_State, E_Variable) then if Global_Seen - and then not Appears_In (Subp_Inputs, Item_Id) + and then not + (Appears_In (Subp_Inputs, Item_Id) + and then + Appears_In (Subp_Outputs, Item_Id)) then Error_Msg_NE ("item & must have mode in out", Item, Item_Id); @@ -9795,9 +9798,9 @@ package body Sem_Prag is ----------------- procedure Check_Usage - (Subp_List : Elist_Id; - Item_List : Elist_Id; - Is_Input : Boolean) + (Subp_Items : Elist_Id; + Used_Items : Elist_Id; + Is_Input : Boolean) is procedure Usage_Error (Item : Node_Id; Item_Id : Entity_Id); -- Emit an error concerning the erroneous usage of an item @@ -9828,14 +9831,14 @@ package body Sem_Prag is -- Start of processing for Check_Usage begin - if No (Subp_List) then + if No (Subp_Items) then return; end if; -- Each input or output of the subprogram must appear in a -- dependency relation. - Elmt := First_Elmt (Subp_List); + Elmt := First_Elmt (Subp_Items); while Present (Elmt) loop Item := Node (Elmt); @@ -9847,7 +9850,7 @@ package body Sem_Prag is -- The item does not appear in a dependency - if not Contains (Item_List, Item_Id) then + if not Contains (Used_Items, Item_Id) then if Is_Formal (Item_Id) then Usage_Error (Item, Item_Id); diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb index 2aafe08..095101f5 100644 --- a/gcc/ada/xoscons.adb +++ b/gcc/ada/xoscons.adb @@ -441,7 +441,6 @@ procedure XOSCons is Ada_Ofile, C_Ofile : Sfile; Current_Line : in out Integer) is - function Get_Value (Name : String) return Int_Value_Type; -- Returns the value of the variable Name -- cgit v1.1