diff options
author | Piotr Trojanek <trojanek@adacore.com> | 2021-06-17 19:44:40 +0200 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2022-11-08 09:34:59 +0100 |
commit | c2596d4533389b8898516b444f8464a1720711af (patch) | |
tree | 2ac6ed1559db1940265052bdaf2d006ef14d7e46 /gcc | |
parent | 7857d873293d2333e1cc8e67ff9bb963fc8b4d1f (diff) | |
download | gcc-c2596d4533389b8898516b444f8464a1720711af.zip gcc-c2596d4533389b8898516b444f8464a1720711af.tar.gz gcc-c2596d4533389b8898516b444f8464a1720711af.tar.bz2 |
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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/exp_imgv.adb | 19 | ||||
-rw-r--r-- | gcc/ada/exp_put_image.adb | 29 | ||||
-rw-r--r-- | gcc/ada/exp_put_image.ads | 6 | ||||
-rw-r--r-- | gcc/ada/rtsfind.ads | 4 |
4 files changed, 51 insertions, 7 deletions
diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index f2043f5..398e477 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -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 ( diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index c489ad4..f90f020 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -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; diff --git a/gcc/ada/exp_put_image.ads b/gcc/ada/exp_put_image.ads index b2b65aa..d4055d1 100644 --- a/gcc/ada/exp_put_image.ads +++ b/gcc/ada/exp_put_image.ads @@ -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 diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 24aca2c..ce49e2d 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -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, |