[multiple changes]

2013-04-23  Robert Dewar  <dewar@adacore.com>

	* xoscons.adb: Minor reformatting.

2013-04-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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  <quinot@adacore.com>

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3c09dd0..c6d114d 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,24 @@
 2013-04-23  Robert Dewar  <dewar@adacore.com>
 
+       * xoscons.adb: Minor reformatting.
+
+2013-04-23  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * 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  <quinot@adacore.com>
+
+       * 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  <dewar@adacore.com>
+
        * 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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..095101f 100644 (file)
--- 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