From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1285) id 1D311398E417; Thu, 3 Jun 2021 15:57:54 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 1D311398E417 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-1193] Fix issue for external subtypes with -fdump-ada-spec X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/master X-Git-Oldrev: 5f2ef25b08f782a9f72adb8e6389ce66d302594b X-Git-Newrev: 517155ceb971d33881cfeecd767406f0801c6512 Message-Id: <20210603155754.1D311398E417@sourceware.org> Date: Thu, 3 Jun 2021 15:57:54 +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: Thu, 03 Jun 2021 15:57:54 -0000 https://gcc.gnu.org/g:517155ceb971d33881cfeecd767406f0801c6512 commit r12-1193-g517155ceb971d33881cfeecd767406f0801c6512 Author: Eric Botcazou Date: Thu Jun 3 17:50:44 2021 +0200 Fix issue for external subtypes with -fdump-ada-spec This works around an irregularity of the language whereby subtypes, unlike types, are not visible through a limited_with clause. gcc/c-family/ * c-ada-spec.c (pp_ada_tree_identifier): Tidy up. (dump_ada_node) : Deal specially with external subtypes. Diff: --- gcc/c-family/c-ada-spec.c | 91 +++++++++++++++++++++++++++-------------------- 1 file changed, 53 insertions(+), 38 deletions(-) diff --git a/gcc/c-family/c-ada-spec.c b/gcc/c-family/c-ada-spec.c index ef0c74c3f08..751cc0edef8 100644 --- a/gcc/c-family/c-ada-spec.c +++ b/gcc/c-family/c-ada-spec.c @@ -1341,49 +1341,46 @@ pp_ada_tree_identifier (pretty_printer *buffer, tree node, tree type, char *s = to_ada_name (name, &space_found); tree decl = get_underlying_decl (type); - /* If the entity comes from another file, generate a package prefix. */ if (decl) { - expanded_location xloc = expand_location (decl_sloc (decl, false)); + /* If the entity comes from another file, generate a package prefix. */ + const expanded_location xloc = expand_location (decl_sloc (decl, false)); - if (xloc.file && xloc.line) + if (xloc.line && xloc.file && xloc.file != current_source_file) { - if (xloc.file != current_source_file) + switch (TREE_CODE (type)) { - switch (TREE_CODE (type)) - { - case ENUMERAL_TYPE: - case INTEGER_TYPE: - case REAL_TYPE: - case FIXED_POINT_TYPE: - case BOOLEAN_TYPE: - case REFERENCE_TYPE: - case POINTER_TYPE: - case ARRAY_TYPE: - case RECORD_TYPE: - case UNION_TYPE: - case TYPE_DECL: - if (package_prefix) - { - char *s1 = get_ada_package (xloc.file); - append_withs (s1, limited_access); - pp_string (buffer, s1); - pp_dot (buffer); - free (s1); - } - break; - default: - break; - } + case ENUMERAL_TYPE: + case INTEGER_TYPE: + case REAL_TYPE: + case FIXED_POINT_TYPE: + case BOOLEAN_TYPE: + case REFERENCE_TYPE: + case POINTER_TYPE: + case ARRAY_TYPE: + case RECORD_TYPE: + case UNION_TYPE: + case TYPE_DECL: + if (package_prefix) + { + char *s1 = get_ada_package (xloc.file); + append_withs (s1, limited_access); + pp_string (buffer, s1); + pp_dot (buffer); + free (s1); + } + break; + default: + break; + } - /* Generate the additional package prefix for C++ classes. */ - if (separate_class_package (decl)) - { - pp_string (buffer, "Class_"); - pp_string (buffer, s); - pp_dot (buffer); - } - } + /* Generate the additional package prefix for C++ classes. */ + if (separate_class_package (decl)) + { + pp_string (buffer, "Class_"); + pp_string (buffer, s); + pp_dot (buffer); + } } } @@ -2220,6 +2217,24 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc, { 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); + } + /* For now, handle access-to-access as System.Address. */ if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE) { @@ -2241,8 +2256,8 @@ dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc, { if (!type || TREE_CODE (type) != FUNCTION_DECL) { - pp_string (buffer, "access "); is_access = true; + pp_string (buffer, "access "); if (quals & TYPE_QUAL_CONST) pp_string (buffer, "constant ");