From patchwork Fri Nov 16 13:10:00 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pawel Wodkowski X-Patchwork-Id: 30165 Received: (qmail 40332 invoked by alias); 16 Nov 2018 13:11:22 -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 40160 invoked by uid 89); 16 Nov 2018 13:11:21 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, SPF_FAIL, SPF_HELO_PASS autolearn=ham version=3.3.2 spammy=6048, angle X-HELO: mga12.intel.com Received: from mga12.intel.com (HELO mga12.intel.com) (192.55.52.136) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 16 Nov 2018 13:11:18 +0000 Received: from fmsmga007.fm.intel.com ([10.253.24.52]) by fmsmga106.fm.intel.com with ESMTP/TLS/DHE-RSA-AES256-GCM-SHA384; 16 Nov 2018 05:11:18 -0800 Received: from kraken.imu.intel.com ([10.217.246.153]) by fmsmga007.fm.intel.com with ESMTP; 16 Nov 2018 05:11:16 -0800 From: Pawel Wodkowski To: gdb-patches@sourceware.org, murbanski@pl.sii.eu, sbasierski@pl.sii.eu Cc: tim.wiederhake@intel.com, dragos.carciumaru@intel.com, Bernhard Heckel Subject: [PATCH 3/7] Fortran: Accessing fields of inherited types via fully qualified name. Date: Fri, 16 Nov 2018 14:10:00 +0100 Message-Id: <1542373804-76019-3-git-send-email-pwodkowski@pl.sii.eu> In-Reply-To: <1542373804-76019-1-git-send-email-pwodkowski@pl.sii.eu> References: <1542373804-76019-1-git-send-email-pwodkowski@pl.sii.eu> 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) 2016-04-22 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. * gdb.fortran/oop-extend-type.exp: New. --- gdb/f-exp.y | 7 +- gdb/testsuite/gdb.fortran/oop-extend-type.exp | 113 ++++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/oop-extend-type.f90 | 56 +++++++++++++ gdb/valops.c | 6 ++ 4 files changed, 180 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 390bd45081b7..4c2e101699ac 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -604,8 +604,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 000000000000..8c3bb50a3ac6 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/oop-extend-type.exp @@ -0,0 +1,113 @@ +# Copyright 2018 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 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 $" { + kfail "gcc/49475" "$test" + } +} +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" +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 $" { + pass "$test" + } + -re "There is no member named coo.\r\n$gdb_prompt $" { + kfail "gcc/49475" "$test" + } +} +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 $" { + kfail "gcc/49475" "$test" + } +} +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\\)" +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 $" { + pass "$test" + } + -re "There is no member named coo.\r\n$gdb_prompt $" { + kfail "gcc/49475" "$test" + } +} +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 000000000000..1fe8611f4632 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/oop-extend-type.f90 @@ -0,0 +1,56 @@ +! Copyright 2018 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 c45caefbf1e0..a34e74b2bee9 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -2163,6 +2163,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,