exp_dist.adb (Build_From_Any_Call): For a subtype that is a generic actual type...

2009-04-16  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb (Build_From_Any_Call): For a subtype that is a generic
	actual type, use the base type to build the To_Any function.
	(Build_From_Any_Function): Remove junk, useless subtype conversion.

2009-04-16  Thomas Quinot  <quinot@adacore.com>

	* exp_ch9.adb, exp_code.adb, tbuild.adb, sem_case.adb,
	restrict.adb: Minor code reorganization (use
	Add_{Char,Str}_To_Name_Buffer instead of inlining it by hand).

From-SVN: r146166

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 50605213065a95930342b623c4399fc8a9b503b5..8f657b5ef26164d7645d7b3974570cbaf6817cf0 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2009-04-16  Thomas Quinot  <quinot@adacore.com>
+
+       * exp_dist.adb (Build_From_Any_Call): For a subtype that is a generic
+       actual type, use the base type to build the To_Any function.
+       (Build_From_Any_Function): Remove junk, useless subtype conversion.
+
+2009-04-16  Thomas Quinot  <quinot@adacore.com>
+
+       * exp_ch9.adb, exp_code.adb, tbuild.adb, sem_case.adb,
+       restrict.adb: Minor code reorganization (use
+       Add_{Char,Str}_To_Name_Buffer instead of inlining it by hand).
+
 2009-04-16  Bob Duff  <duff@adacore.com>
 
        * exp_ch6.ads, exp_ch6.adb (Is_Build_In_Place_Function_Return): Remove,

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 0284943cda0938caef2dcb87700eca28cbb1df8d..d09911a680bcb00dd29c8918df62c0f3ca15f29b 100644 (file)
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -1218,8 +1218,7 @@ package body Exp_Ch9 is
 
          --  Add a leading '('
 
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := '(';
+         Add_Char_To_Name_Buffer ('(');
 
          --  Generate:
          --    new String'("<Entry name>(" & Lnn'Img & ")");
@@ -3176,13 +3175,9 @@ package body Exp_Ch9 is
          Name_Len := Name_Len - 1;
       end if;
 
-      Name_Buffer (Name_Len + 1) := '_';
-      Name_Buffer (Name_Len + 2) := '_';
-
-      Name_Len := Name_Len + 2;
+      Add_Str_To_Name_Buffer ("__");
       for J in 1 .. Select_Len loop
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := Select_Buffer (J);
+         Add_Char_To_Name_Buffer (Select_Buffer (J));
       end loop;
 
       --  Now add the Append_Char if specified. The encoding to follow
@@ -3195,13 +3190,10 @@ package body Exp_Ch9 is
 
       if Append_Char /= ' ' then
          if Append_Char = 'P' or Append_Char = 'N' then
-            Name_Len := Name_Len + 1;
-            Name_Buffer (Name_Len) := Append_Char;
+            Add_Char_To_Name_Buffer (Append_Char);
             return Name_Find;
          else
-            Name_Buffer (Name_Len + 1) := '_';
-            Name_Buffer (Name_Len + 2) := Append_Char;
-            Name_Len := Name_Len + 2;
+            Add_Str_To_Name_Buffer ((1 => '_', 2 => Append_Char));
             return New_External_Name (Name_Find, ' ', -1);
          end if;
       else

diff --git a/gcc/ada/exp_code.adb b/gcc/ada/exp_code.adb
index e42bd6aa9dc30de578a1e58d24a797ef397cfef1..2b0275268cf807f682541c08d7db6d021012efd5 100644 (file)
--- a/gcc/ada/exp_code.adb
+++ b/gcc/ada/exp_code.adb
@@ -220,8 +220,7 @@ package body Exp_Code is
 
       Name_Len := 0;
       loop
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := C;
+         Add_Char_To_Name_Buffer (C);
          Clobber_Ptr := Clobber_Ptr + 1;
          exit when Clobber_Ptr > Len;
          C := Get_Character (Get_String_Char (Str, Clobber_Ptr));

diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index 63ccc358d21515651e7bc281ce79d029f48acd3b..28916b02935d2325cb2e5d6fbaaafa6753f38e8e 100644 (file)
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -8461,8 +8461,17 @@ package body Exp_Dist is
             else
                declare
                   Decl : Entity_Id;
+                  Typ  : Entity_Id := U_Type;
+
                begin
-                  Build_From_Any_Function (Loc, U_Type, Decl, Fnam);
+                  --  For the subtype representing a generic actual type, go
+                  --  to the base type.
+
+                  if Is_Generic_Actual_Type (Typ) then
+                     Typ := Base_Type (Typ);
+                  end if;
+
+                  Build_From_Any_Function (Loc, Typ, Decl, Fnam);
                   Append_To (Decls, Decl);
                end;
             end if;
@@ -8565,11 +8574,10 @@ package body Exp_Dist is
                   Append_To (Stms,
                     Make_Simple_Return_Statement (Loc,
                       Expression =>
-                        OK_Convert_To (Typ,
-                          Build_From_Any_Call
-                            (Etype (Typ),
-                             New_Occurrence_Of (Any_Parameter, Loc),
-                             Decls))));
+                        Build_From_Any_Call
+                          (Etype (Typ),
+                           New_Occurrence_Of (Any_Parameter, Loc),
+                           Decls)));
 
                else
                   declare

diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 99a20afcad9c9642db2d56ba70c311572eadaca1..c883e0a8963c411f0d2af69ea258b539a60cf57d 100644 (file)
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -154,10 +154,7 @@ package body Restrict is
             --  Strip extension and pad to eight characters
 
             Name_Len := Name_Len - 4;
-            while Name_Len < 8 loop
-               Name_Len := Name_Len + 1;
-               Name_Buffer (Name_Len) := ' ';
-            end loop;
+            Add_Str_To_Name_Buffer ((Name_Len + 1 .. 8 => ' '));
 
             --  If predefined unit, check the list of restricted units
 

diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 7afd0d3f718bf9f0d43666edbbbe744eecc8778b..5de995d984b5f6a0c4b69e491f608056e793e5b1 100644 (file)
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -313,26 +313,11 @@ package body Sem_Case is
       --  the pos value passed as an argument to Choice_Image.
 
       Get_Name_String (Chars (First_Subtype (Ctype)));
-      Name_Len := Name_Len + 1;
-      Name_Buffer (Name_Len) := ''';
-      Name_Len := Name_Len + 1;
-      Name_Buffer (Name_Len) := 'v';
-      Name_Len := Name_Len + 1;
-      Name_Buffer (Name_Len) := 'a';
-      Name_Len := Name_Len + 1;
-      Name_Buffer (Name_Len) := 'l';
-      Name_Len := Name_Len + 1;
-      Name_Buffer (Name_Len) := '(';
 
+      Add_Str_To_Name_Buffer ("'val(");
       UI_Image (Value);
-
-      for J in 1 .. UI_Image_Length loop
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := UI_Image_Buffer (J);
-      end loop;
-
-      Name_Len := Name_Len + 1;
-      Name_Buffer (Name_Len) := ')';
+      Add_Str_To_Name_Buffer (UI_Image_Buffer (1 .. UI_Image_Length));
+      Add_Char_To_Name_Buffer (')');
       return Name_Find;
    end Choice_Image;
 

diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
index 217c7f2d8f27455a2dd48663b6b13f081479da3c..395a71376593e91345242f67e1ab72d15ee62d1f 100644 (file)
--- a/gcc/ada/tbuild.adb
+++ b/gcc/ada/tbuild.adb
@@ -511,8 +511,7 @@ package body Tbuild is
 
       if Suffix /= ' ' then
          pragma Assert (Is_OK_Internal_Letter (Suffix));
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := Suffix;
+         Add_Char_To_Name_Buffer (Suffix);
       end if;
 
       if Suffix_Index /= 0 then
@@ -637,10 +636,8 @@ package body Tbuild is
    is
    begin
       Get_Name_String (Related_Id);
-      Name_Len := Name_Len + 1;
-      Name_Buffer (Name_Len) := '_';
-      Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
-      Name_Len := Name_Len + Suffix'Length;
+      Add_Char_To_Name_Buffer ('_');
+      Add_Str_To_Name_Buffer (Suffix);
       return Name_Find;
    end New_Suffixed_Name;