From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1285) id 49A273858C2D; Fri, 25 Mar 2022 11:37:45 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 49A273858C2D MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Eric Botcazou To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-7812] Fix issue for pointers to anonymous types with -fdump-ada-spec X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/master X-Git-Oldrev: 45e955b0a936eafc9838cdc00dcc31b3799b321b X-Git-Newrev: 711c7f079bc0d250e6c5c4450828453c1096542c Message-Id: <20220325113745.49A273858C2D@sourceware.org> Date: Fri, 25 Mar 2022 11:37:45 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 25 Mar 2022 11:37:45 -0000 https://gcc.gnu.org/g:711c7f079bc0d250e6c5c4450828453c1096542c commit r12-7812-g711c7f079bc0d250e6c5c4450828453c1096542c Author: Eric Botcazou 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) : 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. : 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 " instead of "access " - 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 " instead of "access " + 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 {