summaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2022-03-25 12:35:33 +0100
committerEric Botcazou <ebotcazou@adacore.com>2022-03-25 12:37:01 +0100
commit711c7f079bc0d250e6c5c4450828453c1096542c (patch)
treedd5c153e937137d7ae166d1e8d41031a5177b860 /gcc
parent45e955b0a936eafc9838cdc00dcc31b3799b321b (diff)
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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/c-family/c-ada-spec.cc89
1 files 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
{