diff options
author | Thomas Quinot <quinot@adacore.com> | 2009-04-16 10:31:23 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-04-16 12:31:23 +0200 |
commit | dae4faf2e17c5c51954dd6f7e29229780371750c (patch) | |
tree | 0d8ff538d28b6c30c21077d81930181dcde2d797 /gcc | |
parent | 2794f02243b66df4e2ecbb042e26835f8b4a2a93 (diff) | |
download | gcc-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/ChangeLog | 12 | ||||
-rw-r--r-- | gcc/ada/exp_ch9.adb | 18 | ||||
-rw-r--r-- | gcc/ada/exp_code.adb | 3 | ||||
-rw-r--r-- | gcc/ada/exp_dist.adb | 20 | ||||
-rw-r--r-- | gcc/ada/restrict.adb | 5 | ||||
-rw-r--r-- | gcc/ada/sem_case.adb | 21 | ||||
-rw-r--r-- | gcc/ada/tbuild.adb | 9 |
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; |