mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-31 18:40:52 +08:00
ada: Fix expansion of 'Wide_Image and 'Wide_Wide_Image on composite types
Attributes Wide_Image and Wide_Wide_Image applied to composite types are now expanded just like attribute Image. gcc/ada/ * exp_imgv.adb (Expand_Wide_Image_Attribute): Handle just like attribute Image. (Expand_Wide_Wide_Image_Attribute): Likewise. * exp_put_image.adb (Build_Image_Call): Adapt to also work for Wide and Wide_Wide attributes. * exp_put_image.ads (Build_Image_Call): Update comment. * rtsfind.ads (RE_Id): Support wide variants of Get. (RE_Unit_Table): Likewise.
This commit is contained in:
parent
7857d87329
commit
c2596d4533
@ -1842,6 +1842,15 @@ package body Exp_Imgv is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If Image should be transformed using Put_Image, then do so. See
|
||||
-- Exp_Put_Image for details.
|
||||
|
||||
if Exp_Put_Image.Image_Should_Call_Put_Image (N) then
|
||||
Rewrite (N, Exp_Put_Image.Build_Image_Call (N));
|
||||
Analyze_And_Resolve (N, Standard_Wide_String, Suppress => All_Checks);
|
||||
return;
|
||||
end if;
|
||||
|
||||
Rtyp := Root_Type (Entity (Pref));
|
||||
|
||||
Insert_Actions (N, New_List (
|
||||
@ -1942,6 +1951,16 @@ package body Exp_Imgv is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If Image should be transformed using Put_Image, then do so. See
|
||||
-- Exp_Put_Image for details.
|
||||
|
||||
if Exp_Put_Image.Image_Should_Call_Put_Image (N) then
|
||||
Rewrite (N, Exp_Put_Image.Build_Image_Call (N));
|
||||
Analyze_And_Resolve
|
||||
(N, Standard_Wide_Wide_String, Suppress => All_Checks);
|
||||
return;
|
||||
end if;
|
||||
|
||||
Rtyp := Root_Type (Entity (Pref));
|
||||
|
||||
Insert_Actions (N, New_List (
|
||||
|
@ -1058,12 +1058,14 @@ package body Exp_Put_Image is
|
||||
----------------------
|
||||
|
||||
function Build_Image_Call (N : Node_Id) return Node_Id is
|
||||
-- For T'Image (X) Generate an Expression_With_Actions node:
|
||||
-- For T'[[Wide_]Wide_]Image (X) Generate an Expression_With_Actions
|
||||
-- node:
|
||||
--
|
||||
-- do
|
||||
-- S : Buffer;
|
||||
-- U_Type'Put_Image (S, X);
|
||||
-- Result : constant String := Get (S);
|
||||
-- Result : constant [[Wide_]Wide_]String :=
|
||||
-- [[Wide_[Wide_]]Get (S);
|
||||
-- Destroy (S);
|
||||
-- in Result end
|
||||
--
|
||||
@ -1091,14 +1093,33 @@ package body Exp_Put_Image is
|
||||
Image_Prefix));
|
||||
Result_Entity : constant Entity_Id :=
|
||||
Make_Temporary (Loc, 'R');
|
||||
|
||||
subtype Image_Name_Id is Name_Id with Static_Predicate =>
|
||||
Image_Name_Id in Name_Image | Name_Wide_Image | Name_Wide_Wide_Image;
|
||||
-- Attribute names that will be mapped to the corresponding result types
|
||||
-- and functions.
|
||||
|
||||
Attribute_Name_Id : constant Name_Id := Attribute_Name (N);
|
||||
|
||||
Result_Typ : constant Entity_Id :=
|
||||
(case Image_Name_Id'(Attribute_Name_Id) is
|
||||
when Name_Image => Stand.Standard_String,
|
||||
when Name_Wide_Image => Stand.Standard_Wide_String,
|
||||
when Name_Wide_Wide_Image => Stand.Standard_Wide_Wide_String);
|
||||
Get_Func_Id : constant RE_Id :=
|
||||
(case Image_Name_Id'(Attribute_Name_Id) is
|
||||
when Name_Image => RE_Get,
|
||||
when Name_Wide_Image => RE_Wide_Get,
|
||||
when Name_Wide_Wide_Image => RE_Wide_Wide_Get);
|
||||
|
||||
Result_Decl : constant Node_Id :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Result_Entity,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Stand.Standard_String, Loc),
|
||||
New_Occurrence_Of (Result_Typ, Loc),
|
||||
Expression =>
|
||||
Make_Function_Call (Loc,
|
||||
Name => New_Occurrence_Of (RTE (RE_Get), Loc),
|
||||
Name => New_Occurrence_Of (RTE (Get_Func_Id), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
New_Occurrence_Of (Sink_Entity, Loc))));
|
||||
Actions : List_Id;
|
||||
|
@ -91,9 +91,9 @@ package Exp_Put_Image is
|
||||
-- T'Image.
|
||||
|
||||
function Build_Image_Call (N : Node_Id) return Node_Id;
|
||||
-- N is a call to T'Image, and this translates it into the appropriate code
|
||||
-- to call T'Put_Image into a buffer and then extract the string from the
|
||||
-- buffer.
|
||||
-- N is a call to T'[[Wide_]Wide_]Image, and this translates it into the
|
||||
-- appropriate code to call T'Put_Image into a buffer and then extract the
|
||||
-- [[wide] wide] string from the buffer.
|
||||
|
||||
procedure Preload_Root_Buffer_Type (Compilation_Unit : Node_Id);
|
||||
-- Call RTE (RE_Root_Buffer_Type) if necessary, to load the packages
|
||||
|
@ -609,6 +609,8 @@ package Rtsfind is
|
||||
|
||||
RE_Buffer_Type, -- Ada.Strings.Text_Buffers.Unbounded
|
||||
RE_Get, -- Ada.Strings.Text_Buffers.Unbounded
|
||||
RE_Wide_Get, -- Ada.Strings.Text_Buffers.Unbounded
|
||||
RE_Wide_Wide_Get, -- Ada.Strings.Text_Buffers.Unbounded
|
||||
|
||||
RE_Wait_For_Release, -- Ada.Synchronous_Barriers
|
||||
|
||||
@ -2245,6 +2247,8 @@ package Rtsfind is
|
||||
|
||||
RE_Buffer_Type => Ada_Strings_Text_Buffers_Unbounded,
|
||||
RE_Get => Ada_Strings_Text_Buffers_Unbounded,
|
||||
RE_Wide_Get => Ada_Strings_Text_Buffers_Unbounded,
|
||||
RE_Wide_Wide_Get => Ada_Strings_Text_Buffers_Unbounded,
|
||||
|
||||
RE_Wait_For_Release => Ada_Synchronous_Barriers,
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user