diff options
Diffstat (limited to 'gcc/ada/exp_put_image.adb')
-rw-r--r-- | gcc/ada/exp_put_image.adb | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index 0fa4304..d550a1d 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -915,6 +915,79 @@ package body Exp_Put_Image is return Make_Defining_Identifier (Loc, Sname); end Make_Put_Image_Name; + function Image_Should_Call_Put_Image (N : Node_Id) return Boolean is + begin + if Ada_Version < Ada_2020 then + return False; + end if; + + -- In Ada 2020, T'Image calls T'Put_Image if there is an explicit + -- aspect_specification for Put_Image, or if U_Type'Image is illegal + -- in pre-2020 versions of Ada. + + declare + U_Type : constant Entity_Id := Underlying_Type (Entity (Prefix (N))); + begin + if Present (TSS (U_Type, TSS_Put_Image)) then + return True; + end if; + + return not Is_Scalar_Type (U_Type); + end; + end Image_Should_Call_Put_Image; + + function Build_Image_Call (N : Node_Id) return Node_Id is + -- For T'Image (X) Generate an Expression_With_Actions node: + -- + -- do + -- S : Buffer := New_Buffer; + -- U_Type'Put_Image (S, X); + -- Result : constant String := Get (S); + -- Destroy (S); + -- in Result end + -- + -- where U_Type is the underlying type, as needed to bypass privacy. + + Loc : constant Source_Ptr := Sloc (N); + U_Type : constant Entity_Id := Underlying_Type (Entity (Prefix (N))); + Sink_Entity : constant Entity_Id := + Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('S')); + Sink_Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => Sink_Entity, + Object_Definition => + New_Occurrence_Of (RTE (RE_Buffer), Loc), + Expression => + Make_Function_Call (Loc, + Name => New_Occurrence_Of (RTE (RE_New_Buffer), Loc), + Parameter_Associations => Empty_List)); + Put_Im : constant Node_Id := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (U_Type, Loc), + Attribute_Name => Name_Put_Image, + Expressions => New_List ( + New_Occurrence_Of (Sink_Entity, Loc), + New_Copy_Tree (First (Expressions (N))))); + Result_Entity : constant Entity_Id := + Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('R')); + Result_Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => Result_Entity, + Object_Definition => + New_Occurrence_Of (Stand.Standard_String, Loc), + Expression => + Make_Function_Call (Loc, + Name => New_Occurrence_Of (RTE (RE_Get), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Sink_Entity, Loc)))); + Image : constant Node_Id := + Make_Expression_With_Actions (Loc, + Actions => New_List (Sink_Decl, Put_Im, Result_Decl), + Expression => New_Occurrence_Of (Result_Entity, Loc)); + begin + return Image; + end Build_Image_Call; + ------------------ -- Preload_Sink -- ------------------ |