From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from simark.ca by simark.ca with LMTP id uMDFKg5W4GGxSAAAWB0awg (envelope-from ) for ; Thu, 13 Jan 2022 11:40:46 -0500 Received: by simark.ca (Postfix, from userid 112) id AC34D1F34E; Thu, 13 Jan 2022 11:40:46 -0500 (EST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on simark.ca X-Spam-Level: X-Spam-Status: No, score=-3.0 required=5.0 tests=BAYES_00,DKIM_SIGNED, DKIM_VALID,DKIM_VALID_AU,MAILING_LIST_MULTI,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.2 Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by simark.ca (Postfix) with ESMTPS id 0AEBE1ECEB for ; Thu, 13 Jan 2022 11:40:46 -0500 (EST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id A3D3F385C40B for ; Thu, 13 Jan 2022 16:40:45 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org A3D3F385C40B DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=sourceware.org; s=default; t=1642092045; bh=dmCs+gy9qA9fe2o9bf+yiOFZdV7duRLfQ2UeWDaHwQ0=; h=To:Subject:Date:In-Reply-To:References:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To:Cc: From; b=Amx45AcKvrVMh4A/GT10JZG6j4CFPjh2+ouRh375ULO/aMPO1iYlOO5HuUS5tIxp3 KhNdygUk9SWkQt6k9s1mTdT8TG46hEwDvU2w65VqgxQMcRymTAZODkIqf7B7qEsEIy iOBiRJCgIYQV+oS9n+unGsTVfNH0SojoPWPiTIqQ= 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 To: gdb-patches@sourceware.org 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-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: , From: Nils-Christian Kempke via Gdb-patches Reply-To: Nils-Christian Kempke Cc: Bernhard Heckel Errors-To: gdb-patches-bounces+public-inbox=simark.ca@sourceware.org Sender: "Gdb-patches" 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