This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[PATCH 2/3] Fortran: Resolve dynamic target types of pointers.
- From: Bernhard Heckel <bernhard dot heckel at intel dot com>
- To: qiyaoltc at gmail dot com, eliz at gnu dot org
- Cc: gdb-patches at sourceware dot org, Bernhard Heckel <bernhard dot heckel at intel dot com>
- Date: Mon, 6 Jun 2016 15:37:12 +0200
- Subject: [PATCH 2/3] Fortran: Resolve dynamic target types of pointers.
- Authentication-results: sourceware.org; auth=none
- References: <1465220233-32286-1-git-send-email-bernhard dot heckel at intel dot com>
Dynamic target types of pointers have to be resolved before
they can be further processed. If not, GDB will show wrong
boundaries, size,... or even crash as it will access some
random memory.
2016-05-25 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog:
* NEWS: Added new fortran feature.
* gdbtypes.c (resolve_dynamic_pointer_types): Resolve dynamic target types.
* valops.c (address_of_value): Handle not allocated arrays.
gdb/Testsuite/Changelog:
* gdb.fortran/pointers.f90: Add dynamic variables.
* gdb.fortran/pointers.exp: Test dynamic variables.
* gdb.fortran/vla-value.exp: Adapt error message.
---
gdb/NEWS | 2 ++
gdb/gdbtypes.c | 18 +++++++++++++++
gdb/testsuite/gdb.fortran/pointers.exp | 34 ++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/pointers.f90 | 38 +++++++++++++++++++++++++++++++-
gdb/testsuite/gdb.fortran/print_type.exp | 38 +++++++++++++++++++++++++++++++-
gdb/testsuite/gdb.fortran/vla-value.exp | 2 +-
gdb/valops.c | 3 +++
7 files changed, 132 insertions(+), 3 deletions(-)
diff --git a/gdb/NEWS b/gdb/NEWS
index 3e8e7a1..bea86d3 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -3,6 +3,8 @@
*** Changes since GDB 7.11
+* Fortran: Support pointers to dynamic types.
+
* Fortran: Support structures with fields of dynamic types and
arrays of dynamic types.
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index ae5b69a..061785e 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2165,6 +2165,24 @@ resolve_dynamic_pointer (struct type *type,
associated. For example "print *((integer*) &intvla)". */
}
+ /* Don't resolve not associated pointers. */
+ if (type_not_associated (type))
+ return type;
+
+ pinfo.type = check_typedef (TYPE_TARGET_TYPE (type));
+ pinfo.valaddr = NULL;
+ /* Data location attr. refers to the "address of the variable".
+ Therefore we don't derefence anything here but
+ keep the "address of the variable". */
+ if (NULL != TYPE_DATA_LOCATION (pinfo.type))
+ pinfo.addr = addr_stack->addr;
+ else
+ pinfo.addr = read_memory_typed_address (addr_stack->addr, type);
+ pinfo.next = addr_stack;
+ TYPE_TARGET_TYPE (type) =
+ resolve_dynamic_type_internal (TYPE_TARGET_TYPE (type),
+ &pinfo, 0);
+
return type;
}
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
index 0ab08c0..ebb04a7 100644
--- a/gdb/testsuite/gdb.fortran/pointers.exp
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -40,9 +40,17 @@ gdb_test "print charp" "= <not associated>" "print charp, not associated"
gdb_test "print charap" "= <not associated>" "print charap, not associated"
gdb_test "print intp" "= <not associated>" "print intp, not associated"
gdb_test "print intap" "= <not associated>" "print intap, not associated"
+gdb_test "print intvlap" "= <not associated>" "print intvlap, not associated"
gdb_test "print realp" "= <not associated>" "print realp, not associated"
+gdb_test "print twop" "= <not associated>" "print twop, not associated"
gdb_test "print \$my_var = intp" "= <not associated>"
+gdb_breakpoint [gdb_get_line_number "Before value assignment"]
+gdb_continue_to_breakpoint "Before value assignment"
+gdb_test "print twop%ivla2" "= <not allocated>"
+gdb_test "print *((integer*) &intvla)" "Array \"intvla\" is not allocated." \
+ "print temporary pointer, not allocated vla"
+
gdb_breakpoint [gdb_get_line_number "After value assignment"]
gdb_continue_to_breakpoint "After value assignment"
gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?" "print logp, associated"
@@ -50,5 +58,31 @@ gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) $hex\( <.*>\)?" "prin
gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) $hex\( <.*>\)?" "print charp, associated"
gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\( <.*>\)?" "print charap, associated"
gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) $hex\( <.*>\)?" "print intp, associated"
+set test_name "print intap, associated"
+gdb_test_multiple "print intap" $test_name {
+ -re "= \\(1, 1, 3(, 1){7}\\)\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ -re "= \\(PTR TO -> \\( $int \\(10\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ timeout { fail "$test_name (timeout)" }
+}
+set test_name "print intvlap, associated"
+gdb_test_multiple "print intvlap" $test_name {
+ -re "= \\(2, 2, 2, 4(, 2){6}\\)\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ -re "= \\(PTR TO -> \\( $int \\(10\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ timeout { fail "$test_name (timeout)" }
+}
gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) $hex\( <.*>\)?" "print realp, associated"
+gdb_test "print twop" "= \\(PTR TO -> \\( Type two \\)\\) $hex\( <.*>\)?"
+gdb_test "print arrayOfPtr(2)%p" "= \\(PTR TO -> \\( Type two \\)\\) $hex\( <.*>\)?"
+gdb_test "print arrayOfPtr(3)%p" "= <not associated>"
gdb_test "print *((integer*) &inta + 2)" "= 3" "print temporary pointer, array"
+gdb_test "print *((integer*) &intvla + 3)" "= 4" "print temporary pointer, allocated vla"
+gdb_test "print \$pc" "= \\(PTR TO -> \\( void \\(\\)\\(\\)\\)\\) $hex <pointers\\+\\d+>" "Print program counter"
+
diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
index fbfaed6..8b26959 100644
--- a/gdb/testsuite/gdb.fortran/pointers.f90
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -15,13 +15,25 @@
program pointers
+ type :: two
+ integer, allocatable :: ivla1 (:)
+ integer, allocatable :: ivla2 (:, :)
+ end type two
+
+ type :: twoPtr
+ type (two), pointer :: p
+ end type twoPtr
+
logical, target :: logv
complex, target :: comv
character, target :: charv
character (len=3), target :: chara
integer, target :: intv
integer, target :: inta (10)
+ integer, allocatable, target :: intvla (:)
real, target :: realv
+ type(two), target :: twov
+ type(twoPtr) :: arrayOfPtr (3)
logical, pointer :: logp
complex, pointer :: comp
@@ -29,7 +41,9 @@ program pointers
character (len=3), pointer:: charap
integer, pointer :: intp
integer, pointer :: intap (:)
+ integer, pointer :: intvlap (:)
real, pointer :: realp
+ type(two), pointer :: twop
nullify (logp)
nullify (comp)
@@ -37,7 +51,12 @@ program pointers
nullify (charap)
nullify (intp)
nullify (intap)
+ nullify (intvlap)
nullify (realp)
+ nullify (twop)
+ nullify (arrayOfPtr(1)%p)
+ nullify (arrayOfPtr(2)%p)
+ nullify (arrayOfPtr(3)%p)
logp => logv ! Before pointer assignment
comp => comv
@@ -45,7 +64,10 @@ program pointers
charap => chara
intp => intv
intap => inta
+ intvlap => intvla
realp => realv
+ twop => twov
+ arrayOfPtr(2)%p => twov
logv = associated(logp) ! Before value assignment
comv = cmplx(1,2)
@@ -54,8 +76,22 @@ program pointers
intv = 10
inta(:) = 1
inta(3) = 3
+ allocate (intvla(10))
+ intvla(:) = 2
+ intvla(4) = 4
+ intvlap => intvla
realv = 3.14
-
+
+ allocate (twov%ivla1(3))
+ allocate (twov%ivla2(2,2))
+ twov%ivla1(1) = 11
+ twov%ivla1(2) = 12
+ twov%ivla1(3) = 13
+ twov%ivla2(1,1) = 211
+ twov%ivla2(2,1) = 221
+ twov%ivla2(1,2) = 212
+ twov%ivla2(2,2) = 222
+
intv = intv + 1 ! After value assignment
end program pointers
diff --git a/gdb/testsuite/gdb.fortran/print_type.exp b/gdb/testsuite/gdb.fortran/print_type.exp
index 283cb24..e97fb42 100755
--- a/gdb/testsuite/gdb.fortran/print_type.exp
+++ b/gdb/testsuite/gdb.fortran/print_type.exp
@@ -41,7 +41,18 @@ gdb_test "ptype charp" "= <not associated>" "ptype charp, not associated"
gdb_test "ptype charap" "= <not associated>" "ptype charap, not associated"
gdb_test "ptype intp" "= <not associated>" "ptype intp, not associated"
gdb_test "ptype intap" "= <not associated>" "ptype intap, not associated"
+gdb_test "ptype intvlap" "= <not associated>" "ptype intvlap, not associated"
gdb_test "ptype realp" "= <not associated>" "ptype realp, not associated"
+gdb_test "ptype twop" "= <not associated>" "ptype twop, not associated"
+
+gdb_breakpoint [gdb_get_line_number "Before value assignment"]
+gdb_continue_to_breakpoint "Before value assignment"
+gdb_test "ptype twop" \
+ [multi_line "type = PTR TO -> \\( Type two" \
+ " $int :: ivla1\\(<not allocated>\\)" \
+ " $int :: ivla2\\(<not allocated>\\)" \
+ "End Type two \\)"] \
+ "ptype twop, members not allocated"
gdb_breakpoint [gdb_get_line_number "After value assignment"]
gdb_continue_to_breakpoint "After value assignment"
@@ -51,6 +62,7 @@ gdb_test "ptype charv" "type = character\\*1"
gdb_test "ptype chara" "type = character\\*3"
gdb_test "ptype intv" "type = $int"
gdb_test "ptype inta" "type = $int \\(10\\)"
+gdb_test "ptype intvla" "type = $int \\(10\\)"
gdb_test "ptype realv" "type = $real"
gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)"
@@ -58,5 +70,29 @@ gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)"
gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)"
gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)"
gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)"
+set test "ptype intap"
+gdb_test_multiple $test $test {
+ -re "type = $int \\(10\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = PTR TO -> \\( $int \\(10\\)\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ timeout { fail "$test (timeout)" }
+}
+set test "ptype intvlap"
+gdb_test_multiple $test $test {
+ -re "type = $int \\(10\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = PTR TO -> \\( $int \\(10\\)\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ timeout { fail "$test (timeout)" }
+}
gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)"
-
+gdb_test "ptype twop" \
+ [multi_line "type = PTR TO -> \\( Type two" \
+ " $int :: ivla1\\(3\\)" \
+ " $int :: ivla2\\(2,2\\)" \
+ "End Type two \\)"]
diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
index 0945181..d12a335 100644
--- a/gdb/testsuite/gdb.fortran/vla-value.exp
+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
@@ -30,7 +30,7 @@ gdb_breakpoint [gdb_get_line_number "vla1-init"]
gdb_continue_to_breakpoint "vla1-init"
gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
gdb_test "print &vla1" \
- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \
+ "Array \"vla1\" is not allocated." \
"print non-allocated &vla1"
gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \
"print member in non-allocated vla1 (1)"
diff --git a/gdb/valops.c b/gdb/valops.c
index 5ef0c65..5efe9b1 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -1314,6 +1314,9 @@ address_of_variable (struct symbol *var, const struct block *b)
val = value_of_variable (var, b);
type = value_type (val);
+ if (type_not_allocated (type))
+ error (_("Array \"%s\" is not allocated."), SYMBOL_PRINT_NAME (var));
+
if ((VALUE_LVAL (val) == lval_memory && value_lazy (val))
|| TYPE_CODE (type) == TYPE_CODE_FUNC)
{
--
2.7.1.339.g0233b80