From: Andrew Burgess <andrew.burgess@embecosm.com>
To: gdb-patches@sourceware.org
Subject: [PATCHv2 1/2] gdb/fortran: resolve dynamic types when readjusting after an indirection
Date: Mon, 13 Jul 2020 14:33:21 +0100 [thread overview]
Message-ID: <237cb61d9000746255ffe61b327d43b539f52905.1594647094.git.andrew.burgess@embecosm.com> (raw)
In-Reply-To: <cover.1594647094.git.andrew.burgess@embecosm.com>
After dereferencing a pointer (in value_ind) or following a
reference (in coerce_ref) we call readjust_indirect_value_type to
"fixup" the type of the resulting value object.
This fixup handles cases relating to the type of the resulting object
being different (a sub-class) of the original pointers target type.
If we encounter a pointer to a dynamic type then after dereferencing a
pointer (in value_ind) the type of the object created will have had
its dynamic type resolved. However, in readjust_indirect_value_type,
we use the target type of the original pointer to "fixup" the type of
the resulting value. In this case, the target type will be a dynamic
type, so the resulting value object, once again has a dynamic type.
This then triggers an assertion later within GDB.
The solution I propose here is that we call resolve_dynamic_type on
the pointer's target type (within readjust_indirect_value_type) so
that the resulting value is not converted back to a dynamic type.
The test case is based on the original test in the bug report.
gdb/ChangeLog:
PR fortran/23051
PR fortran/26139
* valops.c (value_ind): Pass address to
readjust_indirect_value_type.
* value.c (readjust_indirect_value_type): Make parameter
non-const, and add extra address parameter. Resolve original type
before using it.
* value.h (readjust_indirect_value_type): Update function
signature and comment.
gdb/testsuite/ChangeLog:
PR fortran/23051
PR fortran/26139
* gdb.fortran/class-allocatable-array.exp: New file.
* gdb.fortran/class-allocatable-array.f90: New file.
* gdb.fortran/pointer-to-pointer.exp: New file.
* gdb.fortran/pointer-to-pointer.f90: New file.
---
gdb/ChangeLog | 12 +++++
gdb/testsuite/ChangeLog | 9 ++++
.../gdb.fortran/class-allocatable-array.exp | 43 +++++++++++++++
.../gdb.fortran/class-allocatable-array.f90 | 54 +++++++++++++++++++
.../gdb.fortran/pointer-to-pointer.exp | 46 ++++++++++++++++
.../gdb.fortran/pointer-to-pointer.f90 | 34 ++++++++++++
gdb/valops.c | 24 +++++----
gdb/value.c | 23 +++++---
gdb/value.h | 7 ++-
9 files changed, 233 insertions(+), 19 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/class-allocatable-array.exp
create mode 100644 gdb/testsuite/gdb.fortran/class-allocatable-array.f90
create mode 100644 gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
create mode 100644 gdb/testsuite/gdb.fortran/pointer-to-pointer.f90
diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
new file mode 100644
index 00000000000..9475ba3b393
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
@@ -0,0 +1,43 @@
+# Copyright 2020 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/> .
+
+# Test that GDB can print an allocatable array that is a data field
+# within a class like type.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "Break Here"]
+gdb_continue_to_breakpoint "Break Here"
+
+# If this first test fails then the Fortran compiler being used uses
+# different names, or maybe a completely different approach, for
+# representing class like structures. The following tests are
+# cetainly going to fail.
+gdb_test "print this" " = \\( _data = \[^\r\n\]+, _vptr = \[^\r\n\]+\\)"
+gdb_test "print this%_data" " = \\(PTR TO -> \\( Type test_type \\)\\) \[^\r\n\]+"
+gdb_test "print this%_data%b" " = \\(\\( 1, 2, 3\\) \\( 4, 5, 6\\) \\)"
diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.f90 b/gdb/testsuite/gdb.fortran/class-allocatable-array.f90
new file mode 100644
index 00000000000..26d5fab0355
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.f90
@@ -0,0 +1,54 @@
+! Copyright 2020 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 test_module
+ type test_type
+ integer a
+ real, allocatable :: b (:, :)
+ contains
+ procedure :: test_proc
+ end type test_type
+
+contains
+
+ subroutine test_proc (this)
+ class(test_type), intent (inout) :: this
+ allocate (this%b (3, 2))
+ call fill_array_2d (this%b)
+ print *, "" ! Break Here
+ contains
+ ! Helper subroutine to fill 2-dimensional array with unique
+ ! values.
+ subroutine fill_array_2d (array)
+ real, dimension (:,:) :: array
+ real :: counter
+
+ counter = 1.0
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+ end subroutine test_proc
+end module
+
+program test
+ use test_module
+ implicit none
+ type(test_type) :: t
+ call t%test_proc ()
+end program test
diff --git a/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
new file mode 100644
index 00000000000..7129e431ed1
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
@@ -0,0 +1,46 @@
+# Copyright 2020 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/> .
+
+# Test for GDB printing a pointer to a type containing a buffer.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "Break Here"]
+gdb_continue_to_breakpoint "Break Here"
+
+gdb_test "print *buffer" \
+ " = \\( alpha = \\(1\\.5, 2\\.5, 3\\.5, 4\\.5, 5\\.5\\) \\)"
+
+set l_buffer_type [multi_line \
+ "Type l_buffer" \
+ " real\\(kind=4\\) :: alpha\\(:\\)" \
+ "End Type l_buffer" ]
+
+gdb_test "ptype buffer" "type = PTR TO -> \\( ${l_buffer_type} \\)"
+gdb_test "ptype *buffer" "type = ${l_buffer_type}"
+gdb_test "ptype buffer%alpha" "type = real\\(kind=4\\) \\(5\\)"
diff --git a/gdb/testsuite/gdb.fortran/pointer-to-pointer.f90 b/gdb/testsuite/gdb.fortran/pointer-to-pointer.f90
new file mode 100644
index 00000000000..353217963a8
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointer-to-pointer.f90
@@ -0,0 +1,34 @@
+! Copyright 2020 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/>.
+
+program allocate_array
+
+ type l_buffer
+ real, dimension(:), pointer :: alpha
+ end type l_buffer
+ type(l_buffer), pointer :: buffer
+
+ allocate (buffer)
+ allocate (buffer%alpha (5))
+
+ buffer%alpha (1) = 1.5
+ buffer%alpha (2) = 2.5
+ buffer%alpha (3) = 3.5
+ buffer%alpha (4) = 4.5
+ buffer%alpha (5) = 5.5
+
+ print *, buffer%alpha ! Break Here.
+
+end program allocate_array
diff --git a/gdb/valops.c b/gdb/valops.c
index afdb429dc37..61625977f00 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -1559,20 +1559,24 @@ value_ind (struct value *arg1)
enc_type = check_typedef (value_enclosing_type (arg1));
enc_type = TYPE_TARGET_TYPE (enc_type);
+ CORE_ADDR base_addr;
if (check_typedef (enc_type)->code () == TYPE_CODE_FUNC
|| check_typedef (enc_type)->code () == TYPE_CODE_METHOD)
- /* For functions, go through find_function_addr, which knows
- how to handle function descriptors. */
- arg2 = value_at_lazy (enc_type,
- find_function_addr (arg1, NULL));
+ {
+ /* For functions, go through find_function_addr, which knows
+ how to handle function descriptors. */
+ base_addr = find_function_addr (arg1, NULL);
+ }
else
- /* Retrieve the enclosing object pointed to. */
- arg2 = value_at_lazy (enc_type,
- (value_as_address (arg1)
- - value_pointed_to_offset (arg1)));
-
+ {
+ /* Retrieve the enclosing object pointed to. */
+ base_addr = (value_as_address (arg1)
+ - value_pointed_to_offset (arg1));
+ }
+ arg2 = value_at_lazy (enc_type, base_addr);
enc_type = value_type (arg2);
- return readjust_indirect_value_type (arg2, enc_type, base_type, arg1);
+ return readjust_indirect_value_type (arg2, enc_type, base_type,
+ arg1, base_addr);
}
error (_("Attempt to take contents of a non-pointer value."));
diff --git a/gdb/value.c b/gdb/value.c
index 97a099ddbd3..826cd35b43f 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -3618,10 +3618,20 @@ coerce_ref_if_computed (const struct value *arg)
struct value *
readjust_indirect_value_type (struct value *value, struct type *enc_type,
const struct type *original_type,
- const struct value *original_value)
+ struct value *original_value,
+ CORE_ADDR original_value_address)
{
+ gdb_assert (original_type->code () == TYPE_CODE_PTR
+ || TYPE_IS_REFERENCE (original_type));
+
+ struct type *original_target_type = TYPE_TARGET_TYPE (original_type);
+ gdb::array_view<const gdb_byte> view;
+ struct type *resolved_original_target_type
+ = resolve_dynamic_type (original_target_type, view,
+ original_value_address);
+
/* Re-adjust type. */
- deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type));
+ deprecated_set_value_type (value, resolved_original_target_type);
/* Add embedding info. */
set_value_enclosing_type (value, enc_type);
@@ -3648,12 +3658,11 @@ coerce_ref (struct value *arg)
enc_type = check_typedef (value_enclosing_type (arg));
enc_type = TYPE_TARGET_TYPE (enc_type);
- retval = value_at_lazy (enc_type,
- unpack_pointer (value_type (arg),
- value_contents (arg)));
+ CORE_ADDR addr = unpack_pointer (value_type (arg), value_contents (arg));
+ retval = value_at_lazy (enc_type, addr);
enc_type = value_type (retval);
- return readjust_indirect_value_type (retval, enc_type,
- value_type_arg_tmp, arg);
+ return readjust_indirect_value_type (retval, enc_type, value_type_arg_tmp,
+ arg, addr);
}
struct value *
diff --git a/gdb/value.h b/gdb/value.h
index 70c3d5667ae..12e4a13e3e4 100644
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -488,7 +488,9 @@ extern struct value *coerce_ref_if_computed (const struct value *arg);
/* Setup a new value type and enclosing value type for dereferenced value VALUE.
ENC_TYPE is the new enclosing type that should be set. ORIGINAL_TYPE and
- ORIGINAL_VAL are the type and value of the original reference or pointer.
+ ORIGINAL_VAL are the type and value of the original reference or
+ pointer. ORIGINAL_VALUE_ADDRESS is the address within VALUE, that is
+ the address that was dereferenced.
Note, that VALUE is modified by this function.
@@ -497,7 +499,8 @@ extern struct value *coerce_ref_if_computed (const struct value *arg);
extern struct value * readjust_indirect_value_type (struct value *value,
struct type *enc_type,
const struct type *original_type,
- const struct value *original_val);
+ struct value *original_val,
+ CORE_ADDR original_value_address);
/* Convert a REF to the object referenced. */
--
2.25.4
next prev parent reply other threads:[~2020-07-13 13:33 UTC|newest]
Thread overview: 14+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-07-10 15:22 [PATCH 0/2] Fortran dynamic type related fixes Andrew Burgess
2020-07-10 15:22 ` [PATCH 1/2] gdb/fortran: resolve dynamic types when readjusting after an indirection Andrew Burgess
2020-07-10 15:22 ` [PATCH 2/2] gdb/fortran: Access elements of a structure with dynamic type Andrew Burgess
2020-07-13 13:33 ` [PATCHv2 0/2] Fortran dynamic type related fixes Andrew Burgess
2020-07-13 13:33 ` Andrew Burgess [this message]
2020-07-22 19:10 ` [PATCHv2 1/2] gdb/fortran: resolve dynamic types when readjusting after an indirection Tom Tromey
2020-07-25 0:31 ` Andrew Burgess
2020-07-13 13:33 ` [PATCHv2 2/2] gdb/fortran: Access elements of a structure with dynamic type Andrew Burgess
2020-07-22 19:19 ` Tom Tromey
2020-07-23 10:28 ` Andrew Burgess
2020-07-24 20:03 ` Tom Tromey
2020-07-26 19:31 ` Tom Tromey
2020-08-04 19:19 ` Tom Tromey
2020-08-06 15:38 ` Andrew Burgess
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=237cb61d9000746255ffe61b327d43b539f52905.1594647094.git.andrew.burgess@embecosm.com \
--to=andrew.burgess@embecosm.com \
--cc=gdb-patches@sourceware.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).