diff options
author | Steve Baird <baird@adacore.com> | 2024-06-13 15:39:37 -0700 |
---|---|---|
committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2024-07-02 15:20:35 +0200 |
commit | 15d3f36f76bda1720555b7f426957951d4e3b76d (patch) | |
tree | caa1fb387d7d7e0ce3a13913423e53bde8ba9bba /gcc/ada | |
parent | 03308301c7bb2eed0bc8990db7038aac3a2dcb97 (diff) | |
download | gcc-15d3f36f76bda1720555b7f426957951d4e3b76d.zip gcc-15d3f36f76bda1720555b7f426957951d4e3b76d.tar.gz gcc-15d3f36f76bda1720555b7f426957951d4e3b76d.tar.bz2 |
ada: Put_Image aspect spec ignored for null extension.
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.
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/exp_put_image.adb | 17 |
1 files changed, 16 insertions, 1 deletions
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index 94299e3..bf14ede 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. |