From 3dd1cc4a05f57e0d65435a055d532e699c574403 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 30 Mar 2020 10:16:49 -0400 Subject: [PATCH] [Ada] Put_Image: Implement for private types with full real type 2020-06-15 Bob Duff 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 | 25 ++++++++++++++++++++++++- gcc/ada/exp_put_image.adb | 8 -------- 2 files changed, 24 insertions(+), 9 deletions(-) diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index d7be8e4..bae292c 100644 --- 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 4d63e39..763323f 100644 --- 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; -- 2.7.4