From patchwork Wed Aug 4 13:49:59 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 60853 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 80602B70A9 for ; Wed, 4 Aug 2010 23:50:12 +1000 (EST) Received: (qmail 27350 invoked by alias); 4 Aug 2010 13:50:09 -0000 Received: (qmail 27338 invoked by uid 22791); 4 Aug 2010 13:50:07 -0000 X-SWARE-Spam-Status: No, hits=-1.1 required=5.0 tests=AWL, BAYES_05, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 04 Aug 2010 13:50:02 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id DC608CB021A; Wed, 4 Aug 2010 15:49:59 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id Ov2V-y0b1eug; Wed, 4 Aug 2010 15:49:59 +0200 (CEST) Received: from chinon.act-europe.fr (chinon.act-europe.fr [10.10.0.182]) by mel.act-europe.fr (Postfix) with ESMTP id 9EEB6CB01F0; Wed, 4 Aug 2010 15:49:59 +0200 (CEST) Received: by chinon.act-europe.fr (Postfix, from userid 525) id 68972D8B88; Wed, 4 Aug 2010 15:49:59 +0200 (CEST) Date: Wed, 4 Aug 2010 15:49:59 +0200 From: Arnaud Charlet To: "Joseph S. Myers" , gcc-patches@gcc.gnu.org Cc: Arnaud Charlet Subject: [patch] improve support for nested types in -fdump-ada-spec Message-ID: <20100804134959.GA16132@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This is a patch to c-ada-spec.c which performs two things: - fix generate of reference to struct by using the proper type reference, for instance consider the following code: typedef struct _some_internal_name { int field; } my_real_type; void my_function (my_real_type *t); Before this patch, we would generate: procedure my_function (arg1 : access u_some_internal_name); -- struct.h:5:6 pragma Import (C, my_function, "my_function"); instead of: procedure my_function (arg1 : access my_real_type); -- struct.h:5 pragma Import (C, my_function, "my_function"); as done with this patch. - also, this patch fixes some cases where we would not generate a forward reference to a type before using it, as in: --- struct _cairo_path_data_t; typedef struct _cairo_path_data_t cairo_path_data_t; struct _cairo_path_data_t { int x; }; typedef struct _cairo_path_data_t struct2; -- where we would generate: subtype cairo_path_data_t is u_cairo_path_data_t; instead of: type u_cairo_path_data_t; subtype cairo_path_data_t is u_cairo_path_data_t; In order to decide when to generate forward references, we make additional use of the TREE_VISITED flag in c-ada-spec.c. Tested on x86_64-linux-gnu, OK for trunk? * c-ada-spec.c (dump_ada_template): Mark underlying instance type as visited. (dump_generic_ada_node): Code clean up. Use TREE_VISITED flag to decide whether a type has already been declared/seen. Do not go to the original type. (dump_nested_types): New parameter forward. Generate forward declaration if needed and mark type as visited. (print_ada_declaration): Call dump_nested_types if not already done. Mark types as visited. Index: c-ada-spec.c =================================================================== --- c-ada-spec.c (revision 161187) +++ c-ada-spec.c (working copy) @@ -1815,6 +1815,7 @@ dump_ada_template (pretty_printer *buffe spc += INDENT_INCR; newline_and_indent (buffer, spc); + TREE_VISITED (get_underlying_decl (instance)) = 1; pp_string (buffer, "type "); dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true); package_prefix = true; @@ -2121,7 +2122,7 @@ dump_generic_ada_node (pretty_printer *b /* For now, handle all access-to-access or access-to-unknown-structs as opaque system.address. */ - tree typ = TYPE_NAME (TREE_TYPE (node)); + tree type_name = TYPE_NAME (TREE_TYPE (node)); const_tree typ2 = !type || DECL_P (type) ? type : TYPE_NAME (type); const_tree underlying_type = @@ -2135,7 +2136,13 @@ dump_generic_ada_node (pretty_printer *b || !TYPE_FIELDS (TREE_TYPE (underlying_type)))) /* Pointer to opaque structure. */ - || (typ && typ2 + || (!typ2 + && !TREE_VISITED (underlying_type) + && !TREE_VISITED (type_name) + && !is_tagged_type (TREE_TYPE (node)) + && DECL_SOURCE_FILE (underlying_type) + == source_file_base) + || (type_name && typ2 && DECL_P (underlying_type) && DECL_P (typ2) && decl_sloc (underlying_type, true) @@ -2193,28 +2200,10 @@ dump_generic_ada_node (pretty_printer *b } if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) - && TYPE_NAME (TREE_TYPE (node))) - { - tree name = TYPE_NAME (TREE_TYPE (node)); - tree tmp; - - if (TREE_CODE (name) == TYPE_DECL - && DECL_ORIGINAL_TYPE (name) - && TYPE_STUB_DECL (DECL_ORIGINAL_TYPE (name))) - { - tmp = TYPE_NAME (TREE_TYPE (TYPE_STUB_DECL - (DECL_ORIGINAL_TYPE (name)))); - - if (tmp == NULL_TREE) - tmp = TYPE_NAME (TREE_TYPE (node)); - } - else - tmp = TYPE_NAME (TREE_TYPE (node)); - - dump_generic_ada_node - (buffer, tmp, - TREE_TYPE (node), cpp_check, spc, is_access, true); - } + && type_name != NULL_TREE) + dump_generic_ada_node + (buffer, type_name, + TREE_TYPE (node), cpp_check, spc, is_access, true); else dump_generic_ada_node (buffer, TREE_TYPE (node), TREE_TYPE (node), @@ -2392,11 +2381,13 @@ print_ada_methods (pretty_printer *buffe } /* Dump in BUFFER anonymous types nested inside T's definition. - PARENT is the parent node of T. CPP_CHECK is used to perform C++ queries on + PARENT is the parent node of T. + FORWARD indicates whether a forward declaration of T should be generated. + CPP_CHECK is used to perform C++ queries on nodes. SPC is the indentation level. */ static void -dump_nested_types (pretty_printer *buffer, tree t, tree parent, +dump_nested_types (pretty_printer *buffer, tree t, tree parent, bool forward, int (*cpp_check)(tree, cpp_operation), int spc) { tree field, outer, decl; @@ -2412,6 +2403,16 @@ dump_nested_types (pretty_printer *buffe if (outer == NULL_TREE) return; + if (forward) + { + pp_string (buffer, "type "); + dump_generic_ada_node + (buffer, t, t, cpp_check, spc, false, true); + pp_semicolon (buffer); + newline_and_indent (buffer, spc); + TREE_VISITED (t) = 1; + } + field = TYPE_FIELDS (outer); while (field) { @@ -2472,7 +2473,7 @@ dump_nested_types (pretty_printer *buffe case UNION_TYPE: TREE_VISITED (t) = 1; - dump_nested_types (buffer, field, t, cpp_check, spc); + dump_nested_types (buffer, field, t, false, cpp_check, spc); pp_string (buffer, "type "); @@ -2527,7 +2528,7 @@ dump_nested_types (pretty_printer *buffe } TREE_VISITED (t) = 1; - dump_nested_types (buffer, field, t, cpp_check, spc); + dump_nested_types (buffer, field, t, false, cpp_check, spc); pp_string (buffer, "type "); if (TYPE_NAME (TREE_TYPE (field))) @@ -2563,6 +2564,8 @@ dump_nested_types (pretty_printer *buffe } field = TREE_CHAIN (field); } + + TREE_VISITED (t) = 1; } /* Dump in BUFFER destructor spec corresponding to T. */ @@ -2623,7 +2626,8 @@ print_ada_declaration (pretty_printer *b if (orig && TYPE_STUB_DECL (orig)) { - tree typ = TREE_TYPE (TYPE_STUB_DECL (orig)); + tree stub = TYPE_STUB_DECL (orig); + tree typ = TREE_TYPE (stub); if (TYPE_NAME (typ)) { @@ -2642,6 +2646,11 @@ print_ada_declaration (pretty_printer *b } else { + if (!TREE_VISITED (stub) + && DECL_SOURCE_FILE (stub) == source_file_base) + dump_nested_types + (buffer, stub, stub, true, cpp_check, spc); + pp_string (buffer, "subtype "); dump_generic_ada_node (buffer, t, type, 0, spc, false, true); pp_string (buffer, " is "); @@ -2715,6 +2724,7 @@ print_ada_declaration (pretty_printer *b { pp_string (buffer, "-- skipped anonymous struct "); dump_generic_ada_node (buffer, t, type, 0, spc, false, true); + TREE_VISITED (t) = 1; return 1; } @@ -2722,7 +2732,7 @@ print_ada_declaration (pretty_printer *b pp_string (buffer, "subtype "); else { - dump_nested_types (buffer, t, t, cpp_check, spc); + dump_nested_types (buffer, t, t, false, cpp_check, spc); if (TYPE_METHODS (TREE_TYPE (t)) || has_static_fields (TREE_TYPE (t))) @@ -2767,6 +2777,7 @@ print_ada_declaration (pretty_printer *b default: pp_string (buffer, "subtype "); } + TREE_VISITED (t) = 1; } else { @@ -3011,6 +3022,7 @@ print_ada_declaration (pretty_printer *b } } + TREE_VISITED (t) = 1; if (is_interface) { pp_string (buffer, "limited interface; -- ");