[gcc r12-7812] Fix issue for pointers to anonymous types with -fdump-ada-spec

[gcc r12-7812] Fix issue for pointers to anonymous types with -fdump-ada-spec

[Eric Botcazou]

https://gcc.gnu.org/g:711c7f079bc0d250e6c5c4450828453c1096542c

commit r12-7812-g711c7f079bc0d250e6c5c4450828453c1096542c
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Fri Mar 25 12:35:33 2022 +0100

    Fix issue for pointers to anonymous types with -fdump-ada-spec
    
    This used to work long ago but broke at some point.
    
    gcc/c-family/
            * c-ada-spec.cc (dump_ada_import): Deal with the "section" attribute
            (dump_ada_node) <POINTER_TYPE>: Do not modify and pass the name, but
            the referenced type instead.  Deal with the anonymous original type
            of a typedef'ed type.  In the actual access case, follow the chain
            of external subtypes.
            <TYPE_DECL>: Tidy up control flow.

Diff:
---
 gcc/c-family/c-ada-spec.cc | 89 ++++++++++++++++++++++++++++------------------
 1 file changed, 54 insertions(+), 35 deletions(-)

diff --git a/gcc/c-family/c-ada-spec.cc b/gcc/c-family/c-ada-spec.cc
index aeb429136b6..f291e150934 100644
--- a/gcc/c-family/c-ada-spec.cc
+++ b/gcc/c-family/c-ada-spec.cc
@@ -1526,6 +1526,15 @@ dump_ada_import (pretty_printer *buffer, tree t, int spc)
 
   newline_and_indent (buffer, spc + 5);
 
+  tree sec = lookup_attribute ("section", DECL_ATTRIBUTES (t));
+  if (sec)
+    {
+      pp_string (buffer, "Linker_Section => \"");
+      pp_string (buffer, TREE_STRING_POINTER (TREE_VALUE (TREE_VALUE (sec))));
+      pp_string (buffer, "\", ");
+      newline_and_indent (buffer, spc + 5);
+    }
+
   pp_string (buffer, "External_Name => \"");
 
   if (is_stdcall)
@@ -2179,10 +2188,11 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
 	}
       else
 	{
-	  const unsigned int quals = TYPE_QUALS (TREE_TYPE (node));
+	  tree ref_type = TREE_TYPE (node);
+	  const unsigned int quals = TYPE_QUALS (ref_type);
 	  bool is_access = false;
 
-	  if (VOID_TYPE_P (TREE_TYPE (node)))
+	  if (VOID_TYPE_P (ref_type))
 	    {
 	      if (!name_only)
 		pp_string (buffer, "new ");
@@ -2197,9 +2207,8 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
 	  else
 	    {
 	      if (TREE_CODE (node) == POINTER_TYPE
-		  && TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
-		  && id_equal (DECL_NAME (TYPE_NAME (TREE_TYPE (node))),
-			       "char"))
+		  && TREE_CODE (ref_type) == INTEGER_TYPE
+		  && id_equal (DECL_NAME (TYPE_NAME (ref_type)), "char"))
 		{
 		  if (!name_only)
 		    pp_string (buffer, "new ");
@@ -2214,28 +2223,11 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
 		}
 	      else
 		{
-		  tree type_name = TYPE_NAME (TREE_TYPE (node));
-
-		  /* Generate "access <type>" instead of "access <subtype>"
-		     if the subtype comes from another file, because subtype
-		     declarations do not contribute to the limited view of a
-		     package and thus subtypes cannot be referenced through
-		     a limited_with clause.  */
-		  if (type_name
-		      && TREE_CODE (type_name) == TYPE_DECL
-		      && DECL_ORIGINAL_TYPE (type_name)
-		      && TYPE_NAME (DECL_ORIGINAL_TYPE (type_name)))
-		    {
-		      const expanded_location xloc
-			= expand_location (decl_sloc (type_name, false));
-		      if (xloc.line
-			  && xloc.file
-			  && xloc.file != current_source_file)
-			type_name = DECL_ORIGINAL_TYPE (type_name);
-		    }
+		  tree stub = TYPE_STUB_DECL (ref_type);
+		  tree type_name = TYPE_NAME (ref_type);
 
 		  /* For now, handle access-to-access as System.Address.  */
-		  if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE)
+		  if (TREE_CODE (ref_type) == POINTER_TYPE)
 		    {
 		      if (package_prefix)
 			{
@@ -2251,7 +2243,7 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
 
 		  if (!package_prefix)
 		    pp_string (buffer, "access");
-		  else if (AGGREGATE_TYPE_P (TREE_TYPE (node)))
+		  else if (AGGREGATE_TYPE_P (ref_type))
 		    {
 		      if (!type || TREE_CODE (type) != FUNCTION_DECL)
 			{
@@ -2281,12 +2273,41 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
 			pp_string (buffer, "all ");
 		    }
 
-		  if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) && type_name)
-		    dump_ada_node (buffer, type_name, TREE_TYPE (node), spc,
-				   is_access, true);
-		  else
-		    dump_ada_node (buffer, TREE_TYPE (node), TREE_TYPE (node),
-				   spc, false, true);
+		  /* If this is the anonymous original type of a typedef'ed
+		     type, then use the name of the latter.  */
+		  if (!type_name
+		      && stub
+		      && DECL_CHAIN (stub)
+		      && TREE_CODE (DECL_CHAIN (stub)) == TYPE_DECL
+		      && DECL_ORIGINAL_TYPE (DECL_CHAIN (stub)) == ref_type)
+		    ref_type = TREE_TYPE (DECL_CHAIN (stub));
+
+		  /* Generate "access <type>" instead of "access <subtype>"
+		     if the subtype comes from another file, because subtype
+		     declarations do not contribute to the limited view of a
+		     package and thus subtypes cannot be referenced through
+		     a limited_with clause.  */
+		  else if (is_access)
+		    while (type_name
+			   && TREE_CODE (type_name) == TYPE_DECL
+			   && DECL_ORIGINAL_TYPE (type_name)
+			   && TYPE_NAME (DECL_ORIGINAL_TYPE (type_name)))
+		      {
+			const expanded_location xloc
+			  = expand_location (decl_sloc (type_name, false));
+			if (xloc.line
+			    && xloc.file
+			    && xloc.file != current_source_file)
+			  {
+			    ref_type = DECL_ORIGINAL_TYPE (type_name);
+			    type_name = TYPE_NAME (ref_type);
+			  }
+			else
+			  break;
+		      }
+
+		  dump_ada_node (buffer, ref_type, ref_type, spc, is_access,
+				 true);
 		}
 	    }
 	}
@@ -2361,10 +2382,8 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
 	      else
 		pp_string (buffer, "address");
 	    }
-	  break;
 	}
-
-      if (name_only)
+      else if (name_only)
 	dump_ada_decl_name (buffer, node, limited_access);
       else
 	{