diff options
author | Bob Duff <duff@adacore.com> | 2020-03-30 10:16:49 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-15 04:04:22 -0400 |
commit | 3dd1cc4a05f57e0d65435a055d532e699c574403 (patch) | |
tree | b2bcf466855c7cb10058d6022de07f2f8e57d620 /gcc | |
parent | eb72521915b1f109b3b65aa384005c2527f76c31 (diff) | |
download | gcc-3dd1cc4a05f57e0d65435a055d532e699c574403.zip gcc-3dd1cc4a05f57e0d65435a055d532e699c574403.tar.gz gcc-3dd1cc4a05f57e0d65435a055d532e699c574403.tar.bz2 |
[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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/exp_imgv.adb | 25 | ||||
-rw-r--r-- | 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; |