Patchwork [Ada] Reorganize Full_Qualified_Name handling

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 7, 2010, 10:59 a.m.
Message ID <20101007105953.GA27801@adacore.com>
Download mbox | patch
Permalink /patch/67031/
State New
Headers show

Comments

Arnaud Charlet - Oct. 7, 2010, 10:59 a.m.
This subprogram was in Sem_Util, but this patch moves it to Exp_Util
where it belongs (it was only used in the expander) and renames it to
Fully_Qualified_Name_String.

No test is needed, this is just a cleanup, no functional change

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-07  Robert Dewar  <dewar@adacore.com>

	* exp_disp.adb, exp_dist.adb, exp_util.ads, exp_util.adb,
	exp_ch11.adb: Rename Full_Qualified_Name to Fully_Qualified_Name_String
	* sem_util.adb, sem_util.ads (Full_Qualified_Name): Moved to
	Exp_Util.Fully_Qualified_Name_String.

Patch

Index: exp_util.adb
===================================================================
--- exp_util.adb	(revision 165084)
+++ exp_util.adb	(working copy)
@@ -24,6 +24,7 @@ 
 ------------------------------------------------------------------------------
 
 with Atree;    use Atree;
+with Casing;   use Casing;
 with Checks;   use Checks;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
@@ -1753,6 +1754,62 @@  package body Exp_Util is
       Remove_Side_Effects (Exp, Name_Req, Variable_Ref => True);
    end Force_Evaluation;
 
+   ---------------------------------
+   -- Fully_Qualified_Name_String --
+   ---------------------------------
+
+   function Fully_Qualified_Name_String (E : Entity_Id) 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
+
+      ----------------------------------
+      -- Internal_Full_Qualified_Name --
+      ----------------------------------
+
+      procedure Internal_Full_Qualified_Name (E : Entity_Id) is
+         Ent : Entity_Id;
+
+      begin
+         --  Deal properly with child units
+
+         if Nkind (E) = N_Defining_Program_Unit_Name then
+            Ent := Defining_Identifier (E);
+         else
+            Ent := E;
+         end if;
+
+         --  Compute qualification recursively (only "Standard" has no scope)
+
+         if Present (Scope (Scope (Ent))) then
+            Internal_Full_Qualified_Name (Scope (Ent));
+            Store_String_Char (Get_Char_Code ('.'));
+         end if;
+
+         --  Every entity should have a name except some expanded blocks
+         --  don't bother about those.
+
+         if Chars (Ent) = No_Name then
+            return;
+         end if;
+
+         --  Generates the entity name in upper case
+
+         Get_Decoded_Name_String (Chars (Ent));
+         Set_All_Upper_Case;
+         Store_String_Chars (Name_Buffer (1 .. Name_Len));
+         return;
+      end Internal_Full_Qualified_Name;
+
+   --  Start of processing for Full_Qualified_Name
+
+   begin
+      Start_String;
+      Internal_Full_Qualified_Name (E);
+      Store_String_Char (Get_Char_Code (ASCII.NUL));
+      return End_String;
+   end Fully_Qualified_Name_String;
+
    ------------------------
    -- Generate_Poll_Call --
    ------------------------
Index: exp_util.ads
===================================================================
--- exp_util.ads	(revision 165080)
+++ exp_util.ads	(working copy)
@@ -403,6 +403,10 @@  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;
+   --  Generates the string literal corresponding to the fully qualified name
+   --  of entity E with an ASCII.NUL appended at the end of the name.
+
    procedure Generate_Poll_Call (N : Node_Id);
    --  If polling is active, then a call to the Poll routine is built,
    --  and then inserted before the given node N and analyzed.
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 165080)
+++ sem_util.adb	(working copy)
@@ -3468,71 +3468,6 @@  package body Sem_Util is
       end if;
    end First_Actual;
 
-   -------------------------
-   -- Full_Qualified_Name --
-   -------------------------
-
-   function Full_Qualified_Name (E : Entity_Id) return String_Id is
-      Res : String_Id;
-      pragma Warnings (Off, Res);
-
-      function Internal_Full_Qualified_Name (E : Entity_Id) return String_Id;
-      --  Compute recursively the qualified name without NUL at the end
-
-      ----------------------------------
-      -- Internal_Full_Qualified_Name --
-      ----------------------------------
-
-      function Internal_Full_Qualified_Name (E : Entity_Id) return String_Id is
-         Ent         : Entity_Id := E;
-         Parent_Name : String_Id := No_String;
-
-      begin
-         --  Deals properly with child units
-
-         if Nkind (Ent) = N_Defining_Program_Unit_Name then
-            Ent := Defining_Identifier (Ent);
-         end if;
-
-         --  Compute qualification recursively (only "Standard" has no scope)
-
-         if Present (Scope (Scope (Ent))) then
-            Parent_Name := Internal_Full_Qualified_Name (Scope (Ent));
-         end if;
-
-         --  Every entity should have a name except some expanded blocks
-         --  don't bother about those.
-
-         if Chars (Ent) = No_Name then
-            return Parent_Name;
-         end if;
-
-         --  Add a period between Name and qualification
-
-         if Parent_Name /= No_String then
-            Start_String (Parent_Name);
-            Store_String_Char (Get_Char_Code ('.'));
-
-         else
-            Start_String;
-         end if;
-
-         --  Generates the entity name in upper case
-
-         Get_Decoded_Name_String (Chars (Ent));
-         Set_All_Upper_Case;
-         Store_String_Chars (Name_Buffer (1 .. Name_Len));
-         return End_String;
-      end Internal_Full_Qualified_Name;
-
-   --  Start of processing for Full_Qualified_Name
-
-   begin
-      Res := Internal_Full_Qualified_Name (E);
-      Store_String_Char (Get_Char_Code (ASCII.NUL));
-      return End_String;
-   end Full_Qualified_Name;
-
    -----------------------
    -- Gather_Components --
    -----------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 165080)
+++ sem_util.ads	(working copy)
@@ -379,11 +379,6 @@  package Sem_Util is
    --  is always the expression (not the N_Parameter_Association nodes,
    --  even if named association is used).
 
-   function Full_Qualified_Name (E : Entity_Id) return String_Id;
-   --  Generates the string literal corresponding to the E's full qualified
-   --  name in upper case. An ASCII.NUL is appended as the last character.
-   --  The names in the string are generated by Namet.Get_Decoded_Name_String.
-
    procedure Gather_Components
      (Typ           : Entity_Id;
       Comp_List     : Node_Id;
Index: exp_ch11.adb
===================================================================
--- exp_ch11.adb	(revision 165088)
+++ exp_ch11.adb	(working copy)
@@ -1265,7 +1265,7 @@  package body Exp_Ch11 is
           Object_Definition   => New_Occurrence_Of (Standard_String, Loc),
           Expression          =>
             Make_String_Literal (Loc,
-              Strval => Full_Qualified_Name (Id))));
+              Strval => Fully_Qualified_Name_String (Id))));
 
       Set_Is_Statically_Allocated (Exname);
 
Index: exp_disp.adb
===================================================================
--- exp_disp.adb	(revision 165081)
+++ exp_disp.adb	(working copy)
@@ -4483,8 +4483,7 @@  package body Exp_Disp is
          end loop;
       end if;
 
-      --  Get the _tag entity and the number of primitives of its dispatch
-      --  table.
+      --  Get the _tag entity and number of primitives of its dispatch table
 
       DT_Ptr  := Node (First_Elmt (Access_Disp_Table (Typ)));
       Nb_Prim := UI_To_Int (DT_Entry_Count (First_Tag_Component (Typ)));
@@ -4654,7 +4653,7 @@  package body Exp_Disp is
           Object_Definition   => New_Reference_To (Standard_String, Loc),
           Expression =>
             Make_String_Literal (Loc,
-              Full_Qualified_Name (First_Subtype (Typ)))));
+              Fully_Qualified_Name_String (First_Subtype (Typ)))));
 
       Set_Is_Statically_Allocated (Exname);
       Set_Is_True_Constant (Exname);
@@ -4768,7 +4767,7 @@  package body Exp_Disp is
                               New_External_Name (Tname, 'A'));
 
             Full_Name   : constant String_Id :=
-                            Full_Qualified_Name (First_Subtype (Typ));
+                            Fully_Qualified_Name_String (First_Subtype (Typ));
             Str1_Id     : String_Id;
             Str2_Id     : String_Id;
 
Index: exp_dist.adb
===================================================================
--- exp_dist.adb	(revision 165080)
+++ exp_dist.adb	(working copy)
@@ -5541,7 +5541,7 @@  package body Exp_Dist is
                --  Name
 
                 Make_String_Literal (Loc,
-                  Full_Qualified_Name (Desig)),
+                  Fully_Qualified_Name_String (Desig)),
 
                --  Handler
 
@@ -5887,7 +5887,7 @@  package body Exp_Dist is
                    Unchecked_Convert_To (RTE (RE_Address),
                      New_Occurrence_Of (RACW_Parameter, Loc)),
                    Make_String_Literal (Loc,
-                     Strval => Full_Qualified_Name
+                     Strval => Fully_Qualified_Name_String
                                  (Etype (Designated_Type (RACW_Type)))),
                    Build_Stub_Tag (Loc, RACW_Type),
                    New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
@@ -6083,7 +6083,7 @@  package body Exp_Dist is
                  Parameter_Associations => New_List (
                    Unchecked_Convert_To (RTE (RE_Address), Object),
                   Make_String_Literal (Loc,
-                    Strval => Full_Qualified_Name
+                    Strval => Fully_Qualified_Name_String
                                 (Etype (Designated_Type (RACW_Type)))),
                   Build_Stub_Tag (Loc, RACW_Type),
                   New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),