ada: Default Put_Image for composite derived types is missing information

The output generated by a call to Some_Derived_Composite_Type'Put_Image
(in Ada2022 code) is incomplete in some cases, notably for a type derived
from a container type (i.e., from the Set/Map/List/Vector type declared in
an instance of one of Ada's predefined container generics) with no
user-specified Put_Image procedure.

gcc/ada/

	* aspects.ads (Find_Aspect): Add Boolean parameter Or_Rep_Item
	(defaulted to False).
	* aspects.adb (Find_Aspect): If new Boolean parameter Or_Rep_Item
	is True, then instead of returning an empty result if no
	appropriate N_Aspect_Specification node is found, return an
	appropriate N_Attribute_Definition_Clause if one is found.
	* exp_put_image.ads: Change name of Enable_Put_Image function to
	Put_Image_Enabled.
	* exp_put_image.adb (Build_Record_Put_Image_Procedure): Detect the
	case where a call to the Put_Image procedure of a derived type can
	be transformed into a call to the parent type's Put_Image
	procedure (with a type conversion to the parent type as the actual
	parameter).
	(Put_Image_Enabled): Change name of function (previously
	Enable_Put_Image). Return True in more cases. In particular,
	return True for a type with an explicitly specified Put_Image
	aspect even if the type is declared in a predefined unit (or in an
	instance of a predefined generic unit).
	* exp_attr.adb: Changes due to Put_Image_Enabled function name
	change.

1 files changed, 22 insertions, 8 deletions

diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index c14769c..86dbd18 100644
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -193,13 +193,14 @@ package body Aspects is
    function Find_Aspect
      (Id            : Entity_Id;
       A             : Aspect_Id;
-      Class_Present : Boolean := False) return Node_Id
+      Class_Present : Boolean := False;
+      Or_Rep_Item   : Boolean := False) return Node_Id
    is
-      Decl  : Node_Id;
-      Item  : Node_Id;
-      Owner : Entity_Id;
-      Spec  : Node_Id;
-
+      Decl                 : Node_Id;
+      Item                 : Node_Id;
+      Owner                : Entity_Id;
+      Spec                 : Node_Id;
+      Alternative_Rep_Item : Node_Id := Empty;
    begin
       Owner := Id;
 
@@ -231,6 +232,18 @@ package body Aspects is
            and then Class_Present = Sinfo.Nodes.Class_Present (Item)
          then
             return Item;
+
+         --  We could do something similar here for an N_Pragma node
+         --  when Get_Aspect_Id (Pragma_Name (Item)) = A, but let's
+         --  wait for a demonstrated need.
+
+         elsif Or_Rep_Item
+           and then not Class_Present
+           and then Nkind (Item) = N_Attribute_Definition_Clause
+           and then Get_Aspect_Id (Chars (Item)) = A
+         then
+            --  Remember this candidate in case we don't find anything better
+            Alternative_Rep_Item := Item;
          end if;
 
          Next_Rep_Item (Item);
@@ -266,9 +279,10 @@ package body Aspects is
       end if;
 
       --  The entity does not carry any aspects or the desired aspect was not
-      --  found.
+      --  found. We have no N_Aspect_Specification node to return, but
+      --  Alternative_Rep_Item may have been set (if Or_Rep_Item is True).
 
-      return Empty;
+      return Alternative_Rep_Item;
    end Find_Aspect;
 
    --------------------------