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

gcc/ada/ChangeLog

+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,

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

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));

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

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
 

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;
 

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;