[gcc(refs/users/guojiufu/heads/guojiufu-branch)] [Ada] Put_Image attribute

[Jiu Fu Guo <guojiufu@gcc.gnu.org>]

https://gcc.gnu.org/g:d84eb7c511b163473c272f846905631fc4a66a52

commit d84eb7c511b163473c272f846905631fc4a66a52
Author: Bob Duff <duff@adacore.com>
Date:   Mon Mar 16 15:22:25 2020 -0400

    [Ada] Put_Image attribute
    
    2020-06-11  Bob Duff  <duff@adacore.com>
    
    gcc/ada/
    
            * exp_put_image.adb (Build_Elementary_Put_Image_Call): If the
            underlying type is real, call Put_Image_Unknown.
            (Build_Unknown_Put_Image_Call): Pass the type name to
            Put_Image_Unknown.
            * libgnat/s-putima.ads, libgnat/s-putima.adb
            (Put_Image_Unknown): Add Type_Name parameter.  Remove
            overly-detailed documentation of what it does; better to leave
            it open.

Diff:
---
 gcc/ada/exp_put_image.adb    | 20 ++++++++++++++++----
 gcc/ada/libgnat/s-putima.adb |  6 ++++--
 gcc/ada/libgnat/s-putima.ads |  4 ++--
 3 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index 3a6cbc1f667..db7c65bf7fb 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -27,6 +27,7 @@ with Atree;    use Atree;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Exp_Tss;  use Exp_Tss;
+with Exp_Util;
 with Lib;      use Lib;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
@@ -340,26 +341,34 @@ package body Exp_Put_Image is
          --
          --  Note that this is putting a leading space for reals.
 
+         --  ???Work around the fact that Put_Image doesn't work for private
+         --  types whose full type is real.
+
+         if Is_Real_Type (U_Type) then
+            return Build_Unknown_Put_Image_Call (N);
+         end if;
+
          declare
             Image : constant Node_Id :=
               Make_Attribute_Reference (Loc,
                 Prefix => New_Occurrence_Of (U_Type, Loc),
                 Attribute_Name => Name_Wide_Wide_Image,
                 Expressions => New_List (Relocate_Node (Item)));
-         begin
-            return
+            Put_Call : constant Node_Id :=
               Make_Procedure_Call_Statement (Loc,
                 Name =>
                   New_Occurrence_Of (RTE (RE_Put_Wide_Wide_String), Loc),
                 Parameter_Associations => New_List
                   (Relocate_Node (Sink), Image));
+         begin
+            return Put_Call;
          end;
       end if;
 
       --  Unchecked-convert parameter to the required type (i.e. the type of
       --  the corresponding parameter), and call the appropriate routine.
       --  We could use a normal type conversion for scalars, but the
-      --  "unchecked" is needed for access types.
+      --  "unchecked" is needed for access and private types.
 
       declare
          Libent : constant Entity_Id := RTE (Lib_RE);
@@ -800,7 +809,10 @@ package body Exp_Put_Image is
         Make_Procedure_Call_Statement (Loc,
           Name => New_Occurrence_Of (Libent, Loc),
           Parameter_Associations => New_List (
-            Relocate_Node (Sink)));
+            Relocate_Node (Sink),
+            Make_String_Literal (Loc,
+              Exp_Util.Fully_Qualified_Name_String (
+                Entity (Prefix (N)), Append_NUL => False))));
    end Build_Unknown_Put_Image_Call;
 
    ----------------------
diff --git a/gcc/ada/libgnat/s-putima.adb b/gcc/ada/libgnat/s-putima.adb
index cad693f4996..50597b2422a 100644
--- a/gcc/ada/libgnat/s-putima.adb
+++ b/gcc/ada/libgnat/s-putima.adb
@@ -212,9 +212,11 @@ package body System.Put_Images is
       Put_7bit (S, ')');
    end Record_After;
 
-   procedure Put_Image_Unknown (S : in out Sink'Class) is
+   procedure Put_Image_Unknown (S : in out Sink'Class; Type_Name : String) is
    begin
-      Put_UTF_8 (S, "{unknown image}");
+      Put_UTF_8 (S, "{");
+      Put_String (S, Type_Name);
+      Put_UTF_8 (S, " object}");
    end Put_Image_Unknown;
 
 end System.Put_Images;
diff --git a/gcc/ada/libgnat/s-putima.ads b/gcc/ada/libgnat/s-putima.ads
index 0cfe2171e8f..0bedd3dace4 100644
--- a/gcc/ada/libgnat/s-putima.ads
+++ b/gcc/ada/libgnat/s-putima.ads
@@ -86,8 +86,8 @@ package System.Put_Images is
    procedure Record_Between (S : in out Sink'Class);
    procedure Record_After (S : in out Sink'Class);
 
-   procedure Put_Image_Unknown (S : in out Sink'Class);
+   procedure Put_Image_Unknown (S : in out Sink'Class; Type_Name : String);
    --  For Put_Image of types that don't have the attribute, such as type
-   --  Sink. Prints a canned string.
+   --  Sink.
 
 end System.Put_Images;