summaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorThomas Quinot <quinot@adacore.com>2009-04-16 10:31:23 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2009-04-16 12:31:23 +0200
commitdae4faf2e17c5c51954dd6f7e29229780371750c (patch)
tree0d8ff538d28b6c30c21077d81930181dcde2d797 /gcc
parent2794f02243b66df4e2ecbb042e26835f8b4a2a93 (diff)
downloadgcc-dae4faf2e17c5c51954dd6f7e29229780371750c.tar.gz
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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog12
-rw-r--r--gcc/ada/exp_ch9.adb18
-rw-r--r--gcc/ada/exp_code.adb3
-rw-r--r--gcc/ada/exp_dist.adb20
-rw-r--r--gcc/ada/restrict.adb5
-rw-r--r--gcc/ada/sem_case.adb21
-rw-r--r--gcc/ada/tbuild.adb9
7 files changed, 39 insertions, 49 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 50605213065..8f657b5ef26 100644
--- 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 0284943cda0..d09911a680b 100644
--- 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 e42bd6aa9dc..2b0275268cf 100644
--- 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 63ccc358d21..28916b02935 100644
--- 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 99a20afcad9..c883e0a8963 100644
--- 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 7afd0d3f718..5de995d984b 100644
--- 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 217c7f2d8f2..395a7137659 100644
--- 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;