public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Piotr Trojanek <trojanek@adacore.com>
Subject: [COMMITTED] ada: Fix expansion of 'Wide_Image and 'Wide_Wide_Image on composite types
Date: Tue,  8 Nov 2022 09:42:22 +0100	[thread overview]
Message-ID: <20221108084222.301318-1-poulhies@adacore.com> (raw)

From: Piotr Trojanek <trojanek@adacore.com>

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.

Tested on x86_64-pc-linux-gnu, committed on master.

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


                 reply	other threads:[~2022-11-08  8:42 UTC|newest]

Thread overview: [no followups] expand[flat|nested]  mbox.gz  Atom feed

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20221108084222.301318-1-poulhies@adacore.com \
    --to=poulhies@adacore.com \
    --cc=gcc-patches@gcc.gnu.org \
    --cc=trojanek@adacore.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
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).