From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mga07.intel.com (mga07.intel.com [134.134.136.100]) by sourceware.org (Postfix) with ESMTPS id C2F8E388C00C for ; Thu, 13 Jan 2022 16:39:35 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org C2F8E388C00C X-IronPort-AV: E=McAfee;i="6200,9189,10225"; a="307391731" X-IronPort-AV: E=Sophos;i="5.88,286,1635231600"; d="scan'208";a="307391731" Received: from orsmga006.jf.intel.com ([10.7.209.51]) by orsmga105.jf.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 13 Jan 2022 08:39:33 -0800 X-IronPort-AV: E=Sophos;i="5.88,286,1635231600"; d="scan'208";a="475383119" Received: from labpcdell3650-003.iul.intel.com (HELO localhost) ([172.28.49.87]) by orsmga006-auth.jf.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 13 Jan 2022 08:39:32 -0800 From: Nils-Christian Kempke To: gdb-patches@sourceware.org Cc: Bernhard Heckel , Nils-Christian Kempke Subject: [PATCH 1/2][PR fortran/26373][PR fortran/22497] gdb/fortran: add support for accessing fields of extended types Date: Thu, 13 Jan 2022 17:39:08 +0100 Message-Id: <20220113163909.2880018-2-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.7 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, 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:41 -0000 From: Bernhard Heckel Fortran 2003 supports type extension. This patch allows access to inherited members by using their fully qualified name as described in the Fortran standard. In doing so the patch also fixes a bug in GDB when trying to access the members of a base class in a derived class via the derived class' base class member. This patch fixes PR22497 and PR26373 on GDB side. Using the example Fortran program from PR22497 program mvce implicit none type :: my_type integer :: my_int end type my_type type, extends(my_type) :: extended_type end type extended_type type(my_type) :: foo type(extended_type) :: bar foo%my_int = 0 bar%my_int = 1 print*, foo, bar end program mvce and running this with GDB and setting a BP at 17: Before: (gdb) p bar%my_type A syntax error in expression, near `my_type'. (gdb) p bar%my_int There is no member named my_int. (gdb) p bar%my_type%my_int A syntax error in expression, near `my_type%my_int'. (gdb) p bar $1 = ( my_type = ( my_int = 1 ) ) After: (gdb) p bar%my_type $1 = ( my_int = 1 ) (gdb) p bar%my_int $2 = 1 # this line requires DW_TAG_inheritance to work (gdb) p bar%my_type%my_int $3 = 1 (gdb) p bar $4 = ( my_type = ( my_int = 1 ) ) In the above example "p bar%my_int" requires the compiler to emit information about the inheritance relationship between extended_type and my_type which gfortran and flang currently do not de. The respective issue gcc/49475 has been put as kfail. Co-authored-by: Nils-Christian Kempke Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=26373 https://sourceware.org/bugzilla/show_bug.cgi?id=22497 --- gdb/f-exp.y | 7 +- gdb/testsuite/gdb.fortran/oop_extend_type.exp | 159 ++++++++++++++++++ gdb/testsuite/gdb.fortran/oop_extend_type.f90 | 69 ++++++++ gdb/valops.c | 6 + 4 files changed, 239 insertions(+), 2 deletions(-) create mode 100755 gdb/testsuite/gdb.fortran/oop_extend_type.exp create mode 100755 gdb/testsuite/gdb.fortran/oop_extend_type.f90 diff --git a/gdb/f-exp.y b/gdb/f-exp.y index 42d3130bf8..a00e211b80 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -808,8 +808,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 100755 index 0000000000..5d73e14a56 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/oop_extend_type.exp @@ -0,0 +1,159 @@ +# Copyright 2016 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 { [skip_fortran_tests] } { + return -1 +} + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![fortran_runto_main] { + perror "could not run to main" + return -1 +} + +# Depending on the compiler being used, the type names can be printed differently. +set real [fortran_real4] +set logical [fortran_logical4] + +set line1 [gdb_get_line_number "! Before vla allocation"] +gdb_breakpoint $line1 +gdb_continue_to_breakpoint "line1" ".*$srcfile:$line1.*" + +gdb_test "whatis wp_vla" "type = Type waypoint, allocatable \\(:\\)" \ + "whatis wp_vla before allocation" + +set line2 [gdb_get_line_number "! After value assignment"] +gdb_breakpoint $line2 +gdb_continue_to_breakpoint "line2" ".*$srcfile:$line2.*" + +# test print of wp +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" +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 $" { + kfail "gcc/49475" "$test" + } +} +gdb_test "ptype wp%point%coo" "$real \\(3\\)" + +# test print of fwp +set test "p fwp%coo" +gdb_test_multiple "$test" "$test" { + -re " = \\(1, 2, 2\\)\r\n$gdb_prompt $" { + pass "$test" + } + -re "There is no member named coo.\r\n$gdb_prompt $" { + kfail "gcc/49475" "$test" + } +} +gdb_test "p fwp%waypoint%point%coo" " = \\(1, 2, 2\\)" +gdb_test "p fwp%waypoint%point" " = \\( coo = \\(1, 2, 2\\) \\)" +gdb_test "p fwp%waypoint" \ + " = \\( point = \\( coo = \\(1, 2, 2\\) \\), angle = 10 \\)" +gdb_test "p fwp" \ + " = \\( waypoint = \\( point = \\( coo = \\(1, 2, 2\\) \\), angle = 10 \\), is_fancy = \.TRUE\. \\)" + +set test "p fwp%angle" +gdb_test_multiple "$test" "$test" { + -re " = 10\r\n$gdb_prompt $" { + pass "$test" + } + -re "There is no member named angle.\r\n$gdb_prompt $" { + kfail "gcc/49475" "$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%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 fwp%waypoint%point%coo" "$real \\(3\\)" + +# test print of wp_vla +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, 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(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 100755 index 0000000000..dc91c45c60 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/oop_extend_type.f90 @@ -0,0 +1,69 @@ +! Copyright 2022 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 . + +! Test fortran extends feature (also for chained extends). +module testmod + implicit none + type :: point + real :: coo(3) + end type + + type, extends(point) :: waypoint + real :: angle + end type + + type, extends(waypoint) :: fancywaypoint + logical :: is_fancy + end type +end module + +program testprog + use testmod + implicit none + + logical l + type(waypoint) :: wp + type(fancywaypoint) :: fwp + type(waypoint), allocatable :: wp_vla(:) + + l = .FALSE. + allocate(wp_vla(3)) ! Before vla allocation + + l = allocated(wp_vla) ! After vla allocation + + wp%angle = 100.00 + wp%coo(:) = 1.00 + wp%coo(2) = 2.00 + + fwp%is_fancy = .TRUE. + fwp%angle = 10.00 + fwp%coo(:) = 2.00 + fwp%coo(1) = 1.00 + + wp_vla(1)%angle = 101.00 + wp_vla(1)%coo(:) = 10.00 + wp_vla(1)%coo(2) = 12.00 + + wp_vla(2)%angle = 102.00 + wp_vla(2)%coo(:) = 20.00 + wp_vla(2)%coo(2) = 22.00 + + wp_vla(3)%angle = 103.00 + wp_vla(3)%coo(:) = 30.00 + wp_vla(3)%coo(2) = 32.00 + + print *, wp, wp_vla, fwp ! After value assignment + +end program diff --git a/gdb/valops.c b/gdb/valops.c index e091c445e7..65fad4d5e6 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -2374,6 +2374,12 @@ value_struct_elt (struct value **argp, 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, -- 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