From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mga17.intel.com (mga17.intel.com [192.55.52.151]) by sourceware.org (Postfix) with ESMTPS id 452B8385C40D for ; Thu, 13 Jan 2022 16:39:46 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 452B8385C40D X-IronPort-AV: E=McAfee;i="6200,9189,10225"; a="224737385" X-IronPort-AV: E=Sophos;i="5.88,286,1635231600"; d="scan'208";a="224737385" Received: from orsmga008.jf.intel.com ([10.7.209.65]) by fmsmga107.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 13 Jan 2022 08:39:44 -0800 X-IronPort-AV: E=Sophos;i="5.88,286,1635231600"; d="scan'208";a="529727519" Received: from labpcdell3650-003.iul.intel.com (HELO localhost) ([172.28.49.87]) by orsmga008-auth.jf.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 13 Jan 2022 08:39:43 -0800 From: Nils-Christian Kempke To: gdb-patches@sourceware.org Cc: Bernhard Heckel , Nils-Christian Kempke Subject: [PATCH 2/2] gdb/fortran: print fortran extended types with ptype Date: Thu, 13 Jan 2022 17:39:09 +0100 Message-Id: <20220113163909.2880018-3-nils-christian.kempke@intel.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220113163909.2880018-1-nils-christian.kempke@intel.com> References: <20220113163909.2880018-1-nils-christian.kempke@intel.com> MIME-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit X-Spam-Status: No, score=-10.9 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, SPF_HELO_NONE, SPF_NONE, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 13 Jan 2022 16:39:48 -0000 From: Bernhard Heckel Add the print of the base-class of an extended type to the output of ptype. This requires the Fortran compiler to emit DW_AT_inheritance for the extended type. Co-authored-by: Nils-Christian Kempke --- gdb/f-lang.h | 11 ++++ gdb/f-typeprint.c | 24 ++++++- gdb/testsuite/gdb.fortran/oop_extend_type.exp | 65 ++++++++++++++----- 3 files changed, 81 insertions(+), 19 deletions(-) diff --git a/gdb/f-lang.h b/gdb/f-lang.h index 26b2c09309..14ab8ce245 100644 --- a/gdb/f-lang.h +++ b/gdb/f-lang.h @@ -260,6 +260,17 @@ class f_language : public language_defn int arrayprint_recurse_level, bool print_rank_only) const; + /* If TYPE is an extended type, then print out derivation information. + + A typical output could look like this: + "Type, extends(point) :: waypoint" + " Type point :: point" + " real(kind=4) :: angle" + "End Type waypoint". */ + + void f_type_print_derivation_info (struct type *type, + struct ui_file *stream) const; + /* Print the name of the type (or the ultimate pointer target, function value or array element), or the description of a structure or union. diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index a633e47b2d..1761a38e94 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -282,6 +282,19 @@ f_language::f_type_print_varspec_suffix (struct type *type, /* See f-lang.h. */ +void +f_language::f_type_print_derivation_info (struct type *type, + struct ui_file *stream) const +{ + const int i = 0; // Fortran doesn't support multiple inheritance. + + if (TYPE_N_BASECLASSES (type) > 0) + fprintf_filtered (stream, ", extends(%s) ::", + TYPE_BASECLASS (type, i)->name ()); +} + +/* See f-lang.h. */ + void f_language::f_type_print_base (struct type *type, struct ui_file *stream, int show, int level) const @@ -392,10 +405,17 @@ f_language::f_type_print_base (struct type *type, struct ui_file *stream, case TYPE_CODE_STRUCT: case TYPE_CODE_UNION: if (type->code () == TYPE_CODE_UNION) - fprintf_filtered (stream, "%*sType, C_Union :: ", level, ""); + fprintf_filtered (stream, "%*sType, C_Union ::", level, ""); else - fprintf_filtered (stream, "%*sType ", level, ""); + fprintf_filtered (stream, "%*sType", level, ""); + + if (show > 0) + f_type_print_derivation_info (type, stream); + + fputs_filtered (" ", stream); + fputs_filtered (type->name (), stream); + /* According to the definition, we only print structure elements in case show > 0. */ if (show > 0) diff --git a/gdb/testsuite/gdb.fortran/oop_extend_type.exp b/gdb/testsuite/gdb.fortran/oop_extend_type.exp index 5d73e14a56..3b4e6cac3a 100755 --- a/gdb/testsuite/gdb.fortran/oop_extend_type.exp +++ b/gdb/testsuite/gdb.fortran/oop_extend_type.exp @@ -60,12 +60,24 @@ gdb_test "p wp%point" " = \\( coo = \\(1, 2, 1\\) \\)" gdb_test "p wp" " = \\( point = \\( coo = \\(1, 2, 1\\) \\), angle = 100 \\)" gdb_test "whatis wp" "type = Type waypoint" -gdb_test "ptype wp" \ - [multi_line "type = Type waypoint" \ - " Type point :: point" \ - " $real :: angle" \ - "End Type waypoint"] - +set output_pass_wp [multi_line "type = Type, extends\\(point\\) :: waypoint" \ + " Type point :: point" \ + " $real :: angle" \ + "End Type waypoint(, allocatable)?"] +set output_kfail_wp [multi_line "type = Type waypoint" \ + " Type point :: point" \ + " $real :: angle" \ + "End Type waypoint(, allocatable)?"] + +set test "ptype wp" +gdb_test_multiple "$test" "$test" { + -re "$output_pass_wp\r\n$gdb_prompt $" { + pass "$test" + } + -re "$output_kfail_wp\r\n$gdb_prompt $" { + kfail "gcc/49475" "$test" + } +} set test "ptype wp%coo" gdb_test_multiple "$test" "$test" { -re "$real \\(3\\)\r\n$gdb_prompt $" { @@ -105,11 +117,27 @@ gdb_test_multiple "$test" "$test" { } gdb_test "whatis fwp" "type = Type fancywaypoint" -gdb_test "ptype fwp" \ - [multi_line "type = Type fancywaypoint" \ - " Type waypoint :: waypoint" \ - " $logical :: is_fancy" \ - "End Type fancywaypoint"] +set test "ptype fwp" + +set output_pass_fwp \ + [multi_line "type = Type, extends\\(waypoint\\) :: fancywaypoint" \ + " Type waypoint :: waypoint" \ + " $logical :: is_fancy" \ + "End Type fancywaypoint"] +set output_kfail_fwp \ + [multi_line "type = Type fancywaypoint" \ + " Type waypoint :: waypoint" \ + " $logical :: is_fancy" \ + "End Type fancywaypoint"] + +gdb_test_multiple "$test" "$test" { + -re "$output_pass_fwp\r\n$gdb_prompt $" { + pass "$test" + } + -re "$output_kfail_fwp\r\n$gdb_prompt $" { + kfail "gcc/49475" "$test" + } +} set test "ptype fwp%coo" gdb_test_multiple "$test" "$test" { @@ -140,12 +168,15 @@ gdb_test "p wp_vla(1)" " = \\( point = \\( coo = \\(10, 12, 10\\) \\), angle = 1 gdb_test "whatis wp_vla" "type = Type waypoint, allocatable \\(3\\)" \ "whatis wp_vla after allocation" -gdb_test "ptype wp_vla" \ - [multi_line "type = Type waypoint" \ - " Type point :: point" \ - " $real :: angle" \ - "End Type waypoint, allocatable \\(3\\)"] - +set test "ptype wp_vla" +gdb_test_multiple "$test" "$test" { + -re "$output_pass_wp \\(3\\)\r\n$gdb_prompt $" { + pass "$test" + } + -re "$output_kfail_wp \\(3\\)\r\n$gdb_prompt $" { + kfail "gcc/49475" "$test" + } +} set test "ptype wp_vla(1)%coo" gdb_test_multiple "$test" "$test" { -re "$real \\(3\\)\r\n$gdb_prompt $" { -- 2.25.1 Intel Deutschland GmbH Registered Address: Am Campeon 10, 85579 Neubiberg, Germany Tel: +49 89 99 8853-0, www.intel.de Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva Chairperson of the Supervisory Board: Nicole Lau Registered Office: Munich Commercial Register: Amtsgericht Muenchen HRB 186928