From: Steve Baird <ba...@adacore.com>
If type T1 is is a tagged null record with a Put_Image aspect specification
and type T2 is a null extension of T1 (with no aspect specifications), then
evaluation of a T2'Image call should include a call to the specified procedure
(as opposed to yielding "(NULL RECORD)").
gcc/ada/
* exp_put_image.adb
(Build_Record_Put_Image_Procedure): Declare new Boolean-valued
function Null_Record_Default_Implementation_OK; call it as part of
deciding whether to generate "(NULL RECORD)" text.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_put_image.adb | 17 ++++++++++++++++-
1 file changed, 16 insertions(+), 1 deletion(-)
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index 94299e39661..bf14eded93e 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -580,6 +580,18 @@ package body Exp_Put_Image is
function Make_Component_Name (C : Entity_Id) return Node_Id;
-- Create a call that prints "Comp_Name => "
+ function Null_Record_Default_Implementation_OK
+ (Null_Record_Type : Entity_Id) return Boolean
+ is
+ (if Has_Aspect (Null_Record_Type, Aspect_Put_Image)
+ then False
+ elsif not Is_Derived_Type
+ (Implementation_Base_Type (Null_Record_Type))
+ then True
+ else Null_Record_Default_Implementation_OK
+ (Implementation_Base_Type (Etype (Null_Record_Type))));
+ -- return True iff ok to emit "(NULL RECORD)" for given null record type
+
------------------------------------
-- Make_Component_List_Attributes --
------------------------------------
@@ -852,7 +864,10 @@ package body Exp_Put_Image is
Type_Name))));
end;
end if;
- elsif Is_Null_Record_Type (Btyp, Ignore_Privacy => True) then
+
+ elsif Is_Null_Record_Type (Btyp, Ignore_Privacy => True)
+ and then Null_Record_Default_Implementation_OK (Btyp)
+ then
-- Interface types take this path.
--
2.45.2
