Implement Put_Image for private types whose full type is a fixed or
floating point type. Also implement 'Image for private types in general.
This affects integers and enumeration types.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-15 Bob Duff <d...@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.
--- gcc/ada/exp_imgv.adb
+++ 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
--- gcc/ada/exp_put_image.adb
+++ 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;