mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 01:20:52 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Thomas Quinot 2009-04-16 10:31:23 +00:00 committed by Arnaud Charlet
parent 2794f02243
commit dae4faf2e1
7 changed files with 39 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
View File

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

18
gcc/ada/exp_ch9.adb
View File

@ -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

3
gcc/ada/exp_code.adb
View File

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

20
gcc/ada/exp_dist.adb
View File

@ -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

5
gcc/ada/restrict.adb
View File

@ -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

21
gcc/ada/sem_case.adb
View File

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

9
gcc/ada/tbuild.adb
View File

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