From patchwork Fri Aug 11 11:06:47 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "Wiederhake, Tim" X-Patchwork-Id: 22073 Received: (qmail 70528 invoked by alias); 11 Aug 2017 11:07:31 -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 70470 invoked by uid 89); 11 Aug 2017 11:07:27 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-25.7 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=coo, angle, 3200 X-HELO: mga09.intel.com Received: from mga09.intel.com (HELO mga09.intel.com) (134.134.136.24) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 11 Aug 2017 11:07:25 +0000 Received: from orsmga004.jf.intel.com ([10.7.209.38]) by orsmga102.jf.intel.com with ESMTP/TLS/DHE-RSA-AES256-GCM-SHA384; 11 Aug 2017 04:07:23 -0700 X-ExtLoop1: 1 Received: from irvmail001.ir.intel.com ([163.33.26.43]) by orsmga004.jf.intel.com with ESMTP; 11 Aug 2017 04:07:21 -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 v7BB7Lb5007183; Fri, 11 Aug 2017 12:07:21 +0100 Received: from ulvlx001.iul.intel.com (localhost [127.0.0.1]) by ulvlx001.iul.intel.com with ESMTP id v7BB7Exa009131; Fri, 11 Aug 2017 13:07:14 +0200 Received: (from twiederh@localhost) by ulvlx001.iul.intel.com with LOCAL id v7BB7EBG009127; Fri, 11 Aug 2017 13:07:14 +0200 From: Tim Wiederhake To: gdb-patches@sourceware.org Cc: qiyaoltc@gmail.com, Bernhard Heckel Subject: [PATCH v3 2/6] Fortran: Accessing fields of inherited types via fully qualified name. Date: Fri, 11 Aug 2017 13:06:47 +0200 Message-Id: <1502449611-8865-3-git-send-email-tim.wiederhake@intel.com> In-Reply-To: <1502449611-8865-1-git-send-email-tim.wiederhake@intel.com> References: <1502449611-8865-1-git-send-email-tim.wiederhake@intel.com> X-IsSubscribed: yes From: Bernhard Heckel Fortran 2003 supports type extension. This patch allows access to inherited members by using it's fully qualified name as described in the Fortran Standard. Before: (gdb) print my_extended_obj%base_class_name%member_base Syntax error near base_class_name%member_base (gdb) print my_extended_obj%member_base $1 = (10, 10, 10) After: (gdb) print my_extended_obj%base_clase_name%member_base $1 = (10, 10, 10) (gdb) print my_extended_obj%member_base $1 = (10, 10, 10) xxxx-yy-zz Bernhard Heckel gdb/ChangeLog: * f-exp.y (name): Allow TYPENAME. * valops.c (search_struct_method): Look also for baseclass. gdb/testsuite/ChangeLog: * gdb.fortran/oop_extend_type.f90: New file. * gdb.fortran/oop_extend_type.exp: New file. --- gdb/f-exp.y | 7 +- gdb/testsuite/gdb.fortran/oop_extend_type.exp | 97 +++++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/oop_extend_type.f90 | 56 ++++++++++++++++ gdb/valops.c | 6 ++ 4 files changed, 164 insertions(+), 2 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/oop_extend_type.exp create mode 100644 gdb/testsuite/gdb.fortran/oop_extend_type.f90 diff --git a/gdb/f-exp.y b/gdb/f-exp.y index 7e9e234..8a71a53 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -608,8 +608,11 @@ nonempty_typelist } ; -name : NAME - { $$ = $1.stoken; } +name + : NAME + { $$ = $1.stoken; } + | TYPENAME + { $$ = $1.stoken; } ; name_not_typename : NAME diff --git a/gdb/testsuite/gdb.fortran/oop_extend_type.exp b/gdb/testsuite/gdb.fortran/oop_extend_type.exp new file mode 100644 index 0000000..162a23b --- /dev/null +++ b/gdb/testsuite/gdb.fortran/oop_extend_type.exp @@ -0,0 +1,97 @@ +# Copyright 2017 Free Software Foundation, Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +standard_testfile ".f90" +load_lib "fortran.exp" + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto MAIN__] { + untested "could not run to breakpoint MAIN__" + return -1 +} + +# Depending on the compiler being used, the type names can be printed +# differently. +set real [fortran_real4] + +gdb_breakpoint [gdb_get_line_number "! Before vla allocation"] +gdb_continue_to_breakpoint "! Before vla allocation" ".*! Before vla allocation" +gdb_test "whatis wp_vla" "type = " + +gdb_breakpoint [gdb_get_line_number "! After value assignment"] +gdb_continue_to_breakpoint "! After value assignment" ".*! After value assignment" +set test "p wp%coo" +gdb_test_multiple "$test" "$test" { + -re " = \\(1, 2, 1\\)\r\n$gdb_prompt $" { + pass "$test" + } + -re "There is no member named coo.\r\n$gdb_prompt $" { + xfail "gcc/49475" + } +} +gdb_test "p wp%point%coo" " = \\(1, 2, 1\\)" +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 test "ptype wp%coo" +gdb_test_multiple "$test" "$test" { + -re "$real \\(3\\)\r\n$gdb_prompt $" { + pass "$test" + } + -re "There is no member named coo.\r\n$gdb_prompt $" { + xfail "gcc/49475" + } +} +gdb_test "ptype wp%point%coo" "$real \\(3\\)" + +set test "p wp_vla(1)%coo" +gdb_test_multiple "$test" "$test" { + -re " = \\(10, 12, 10\\)\r\n$gdb_prompt $" { + pass "$test" + } + -re "There is no member named coo.\r\n$gdb_prompt $" { + xfail "gcc/49475" + } +} +gdb_test "p wp_vla(1)%point%coo" " = \\(10, 12, 10\\)" +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(1)%coo" +gdb_test_multiple "$test" "$test" { + -re "$real \\(3\\)\r\n$gdb_prompt $" { + pass "$test" + } + -re "There is no member named coo.\r\n$gdb_prompt $" { + xfail "gcc/49475" + } +} +gdb_test "ptype wp_vla(1)%point%coo" "$real \\(3\\)" diff --git a/gdb/testsuite/gdb.fortran/oop_extend_type.f90 b/gdb/testsuite/gdb.fortran/oop_extend_type.f90 new file mode 100644 index 0000000..95bf4d5 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/oop_extend_type.f90 @@ -0,0 +1,56 @@ +! Copyright 2017 Free Software Foundation, Inc. +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see . + +module testmod + implicit none + type :: point + real :: coo(3) + end type + + type, extends(point) :: waypoint + real :: angle + end type + +end module + +program testprog + use testmod + implicit none + + logical l + type(waypoint) :: wp + type(waypoint), allocatable :: wp_vla(:) + + l = allocated(wp_vla) + allocate(wp_vla(3)) ! Before vla allocation + + l = allocated(wp_vla) ! After vla allocation + wp%angle = 100.00 + wp%point%coo(:) = 1.00 + wp%point%coo(2) = 2.00 + + wp_vla(1)%angle = 101.00 + wp_vla(1)%point%coo(:) = 10.00 + wp_vla(1)%point%coo(2) = 12.00 + wp_vla(2)%angle = 102.00 + wp_vla(2)%point%coo(:) = 20.00 + wp_vla(2)%point%coo(2) = 22.00 + wp_vla(3)%angle = 103.00 + wp_vla(3)%point%coo(:) = 30.00 + wp_vla(3)%point%coo(2) = 32.00 + + print *, wp, wp_vla ! After value assignment + +end program diff --git a/gdb/valops.c b/gdb/valops.c index 3668f0b..2da5a80 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -2182,6 +2182,12 @@ value_struct_elt (struct value **argp, struct value **args, if (v) return v; + /* fortran: If it is not a field it is the + type name of an inherited structure. */ + v = search_struct_field (name, *argp, t, 1); + if (v) + return v; + /* C++: If it was not found as a data field, then try to return it as a pointer to a method. */ v = search_struct_method (name, argp, args, 0,