[Ada] Put_Image: Implement for private types with full real type

2020-06-15  Bob Duff  <duff@adacore.com>

gcc/ada/

	* exp_imgv.adb (Expand_Image_Attribute): Allow private types.
	Put_Image generates Image for numeric types, and private types
	whose full type is numeric. This requires the Conversion_OK flag
	for integer and floating-point types. For fixed point, we need
	the extra conversion.
	* exp_put_image.adb (Build_Elementary_Put_Image_Call): Remove
	special handling of real types.
	(Enable_Put_Image): Enable for reals.

diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index d7be8e44a401a7b3982b6fc5bbe758ea0c97f169..bae292c79582f65f1ee9862818af88f6a61fb201 100644 (file)
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -640,8 +640,31 @@ package body Exp_Imgv is
              Prefix         => New_Occurrence_Of (Ptyp, Loc),
              Expressions    => New_List (Expr)));
 
+      --  AI12-0020: Ada 2020 allows 'Image for all types, including private
+      --  types. If the full type is not a fixed-point type, then it is enough
+      --  to set the Conversion_OK flag. However, that would not work for
+      --  fixed-point types, because that flag changes the run-time semantics
+      --  of fixed-point type conversions; therefore, we must first convert to
+      --  Rtyp, and then to Tent.
+
       else
-         Arg_List := New_List (Convert_To (Tent, Expr));
+         declare
+            Conv : Node_Id;
+         begin
+            if Ada_Version >= Ada_2020
+              and then Is_Private_Type (Etype (Expr))
+            then
+               if Is_Fixed_Point_Type (Rtyp) then
+                  Conv := Convert_To (Tent, OK_Convert_To (Rtyp, Expr));
+               else
+                  Conv := OK_Convert_To (Tent, Expr);
+               end if;
+            else
+               Conv := Convert_To (Tent, Expr);
+            end if;
+
+            Arg_List := New_List (Conv);
+         end;
       end if;
 
       --  Append Snn, Pnn arguments

diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index 4d63e39213163ef36f66518ddfa5065fca47db9d..763323fd6930fc0c0b1f30470ec39962d7da603c 100644 (file)
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -345,10 +345,6 @@ package body Exp_Put_Image is
          --
          --  Note that this is putting a leading space for reals.
 
-         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,
@@ -831,9 +827,6 @@ package body Exp_Put_Image is
       --
       --  Put_Image on tagged types triggers some bugs.
       --
-      --  Put_Image doesn't work for private types whose full type is real.
-      --  Disable for all real types, for simplicity.
-      --
       --  Put_Image doesn't work for access-to-protected types, because of
       --  confusion over their size. Disable for all access-to-subprogram
       --  types, just in case.
@@ -841,7 +834,6 @@ package body Exp_Put_Image is
       if Is_Remote_Types (Scope (Typ))
         or else (Is_Tagged_Type (Typ) and then In_Predefined_Unit (Typ))
         or else (Is_Tagged_Type (Typ) and then not Tagged_Put_Image_Enabled)
-        or else Is_Real_Type (Typ)
         or else Is_Access_Subprogram_Type (Typ)
       then
          return False;