From patchwork Mon Aug 7 09:37:31 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "Wiederhake, Tim" X-Patchwork-Id: 21941 Received: (qmail 87206 invoked by alias); 7 Aug 2017 09:38:16 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 87065 invoked by uid 89); 7 Aug 2017 09:38:16 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-25.5 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_LAZY_DOMAIN_SECURITY, RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy= X-HELO: mga14.intel.com Received: from mga14.intel.com (HELO mga14.intel.com) (192.55.52.115) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 07 Aug 2017 09:38:14 +0000 Received: from orsmga001.jf.intel.com ([10.7.209.18]) by fmsmga103.fm.intel.com with ESMTP/TLS/DHE-RSA-AES256-GCM-SHA384; 07 Aug 2017 02:38:13 -0700 X-ExtLoop1: 1 Received: from irvmail001.ir.intel.com ([163.33.26.43]) by orsmga001.jf.intel.com with ESMTP; 07 Aug 2017 02:38:11 -0700 Received: from ulvlx001.iul.intel.com (ulvlx001.iul.intel.com [172.28.207.17]) by irvmail001.ir.intel.com (8.14.3/8.13.6/MailSET/Hub) with ESMTP id v779cBE8028390; Mon, 7 Aug 2017 10:38:11 +0100 Received: from ulvlx001.iul.intel.com (localhost [127.0.0.1]) by ulvlx001.iul.intel.com with ESMTP id v779c4o2025571; Mon, 7 Aug 2017 11:38:04 +0200 Received: (from twiederh@localhost) by ulvlx001.iul.intel.com with LOCAL id v779c4gs025567; Mon, 7 Aug 2017 11:38:04 +0200 From: Tim Wiederhake To: gdb-patches@sourceware.org Cc: qiyaoltc@gmail.com, Bernhard Heckel Subject: [PATCH v2 3/6] Fortran: Ptype, print type extension. Date: Mon, 7 Aug 2017 11:37:31 +0200 Message-Id: <1502098654-25203-4-git-send-email-tim.wiederhake@intel.com> In-Reply-To: <1502098654-25203-1-git-send-email-tim.wiederhake@intel.com> References: <1502098654-25203-1-git-send-email-tim.wiederhake@intel.com> X-IsSubscribed: yes From: Bernhard Heckel Print base-class of an extended type when doing a ptype. xxxx-yy-zz Bernhard Heckel gdb/ChangeLog: * gdb/f-typeprint.c (f_type_print_derivation_info): New function. (f_type_print_base): Print baseclass info. gdb/testsuite/ChangeLog: * gdb.fortran/oop_extend_type.exp: Adapt expected results. --- gdb/f-typeprint.c | 31 ++++++++++++++++++++++++--- gdb/testsuite/gdb.fortran/oop_extend_type.exp | 30 ++++++++++++++++++++------ 2 files changed, 51 insertions(+), 10 deletions(-) diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 7dbe093..64b2f92 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -256,6 +256,26 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, } } +/* 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" + */ + +static void +f_type_print_derivation_info (struct type *type, struct ui_file *stream) +{ + /* Fortran doesn't support multiple inheritance. */ + int i = 0; + + if (TYPE_N_BASECLASSES (type) > 0) + fprintf_filtered (stream, ", extends(%s) ::", + type_name_no_tag (TYPE_BASECLASS (type, i))); +} + /* Print the name of the type (or the ultimate pointer target, function value or array element), or the description of a structure or union. @@ -362,10 +382,15 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show, case TYPE_CODE_STRUCT: case TYPE_CODE_UNION: if (TYPE_CODE (type) == TYPE_CODE_UNION) - fprintfi_filtered (level, stream, "Type, C_Union :: "); + fprintfi_filtered (level, stream, "Type, C_Union ::"); else - fprintfi_filtered (level, stream, "Type "); - fputs_filtered (TYPE_TAG_NAME (type), stream); + fprintfi_filtered (level, stream, "Type"); + + if (show > 0) + f_type_print_derivation_info (type, stream); + + fprintf_filtered (stream, " %s", TYPE_TAG_NAME (type)); + /* 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 a880414..200ce7b 100644 --- a/gdb/testsuite/gdb.fortran/oop_extend_type.exp +++ b/gdb/testsuite/gdb.fortran/oop_extend_type.exp @@ -50,11 +50,23 @@ 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" \ +set output_pass [multi_line "type = Type, extends\\(point\\) :: waypoint" \ " Type point :: point" \ " $real :: angle" \ "End Type waypoint"] +set output_kfail [multi_line "type = Type waypoint" \ + " Type point :: point" \ + " $real :: angle" \ + "End Type waypoint"] +set test "ptype wp" +gdb_test_multiple $test %test { + -re "$output_pass\r\n$gdb_prompt $" { + pass "$test" + } + -re "$output_kfail\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 $" { @@ -80,11 +92,15 @@ gdb_test "p wp_vla(1)%point" " = \\( coo = \\(10, 12, 10\\) \\)" gdb_test "p wp_vla(1)" " = \\( point = \\( coo = \\(10, 12, 10\\) \\), angle = 101 \\)" gdb_test "whatis wp_vla" "type = Type waypoint \\(3\\)" -gdb_test "ptype wp_vla" \ - [multi_line "type = Type waypoint" \ - " Type point :: point" \ - " $real :: angle" \ - "End Type waypoint \\(3\\)"] +set test "ptype wp_vla" +gdb_test_multiple $test %test { + -re "$output_pass \\(3\\)\r\n$gdb_prompt $" { + pass "$test" + } + -re "$output_kfail \\(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 $" {