public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-3785] ada: Fix expansion of 'Wide_Image and 'Wide_Wide_Image on composite types
@ 2022-11-08 8:41 Marc Poulhi?s
0 siblings, 0 replies; only message in thread
From: Marc Poulhi?s @ 2022-11-08 8:41 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:c2596d4533389b8898516b444f8464a1720711af
commit r13-3785-gc2596d4533389b8898516b444f8464a1720711af
Author: Piotr Trojanek <trojanek@adacore.com>
Date: Thu Jun 17 19:44:40 2021 +0200
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.
Diff:
---
gcc/ada/exp_imgv.adb | 19 +++++++++++++++++++
gcc/ada/exp_put_image.adb | 29 +++++++++++++++++++++++++----
gcc/ada/exp_put_image.ads | 6 +++---
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 f2043f525d5..398e4771c14 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 c489ad41fd1..f90f0206f27 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 b2b65aa2374..d4055d10b96 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 24aca2cf6b6..ce49e2df149 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,
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-11-08 8:41 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-11-08 8:41 [gcc r13-3785] ada: Fix expansion of 'Wide_Image and 'Wide_Wide_Image on composite types Marc Poulhi?s
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).