This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[PATCH v2 3/7] Fortran: Accessing fields of inherited types via fully qualified name.
- From: Pawel Wodkowski <pwodkowski at pl dot sii dot eu>
- To: gdb-patches at sourceware dot org, murbanski at pl dot sii dot eu, sbasierski at pl dot sii dot eu
- Cc: tim dot wiederhake at intel dot com, dragos dot carciumaru at intel dot com, Bernhard Heckel <bernhard dot heckel at intel dot com>
- Date: Mon, 19 Nov 2018 22:38:46 +0100
- Subject: [PATCH v2 3/7] Fortran: Accessing fields of inherited types via fully qualified name.
- References: <1542663530-140490-1-git-send-email-pwodkowski@pl.sii.eu>
From: Bernhard Heckel <bernhard.heckel@intel.com>
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 <bernhard.heckel@intel.com>
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 <http://www.gnu.org/licenses/>.
+
+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 = <not allocated>"
+
+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 <http://www.gnu.org/licenses/>.
+
+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,
--
2.7.4