[PATCH V2 3/5] Fortran: Resolve dynamic target types of pointers.
Bernhard Heckel
bernhard.heckel@intel.com
Mon Jul 4 09:52:00 GMT 2016
Dynamic target types of pointers have to be resolved before
they can be further processed. If not, GDB wil show wrong
boundaries, size,... or even crash as it will access some
random memory.
2016-06-30 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 (value_ind): Throw error when pointer is
not associated.
gdb/Testsuite/Changelog:
* gdb.fortran/pointers.f90: Add dynamic variables.
* gdb.fortran/pointers.exp: Test dynamic variables.
* gdb.fortran/print_type.exp: Test pointer to dynamic
types.
---
gdb/NEWS | 2 +
gdb/gdbtypes.c | 83 ++++++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/pointers.exp | 48 ++++++++++++++++++
gdb/testsuite/gdb.fortran/pointers.f90 | 17 +++++++
gdb/testsuite/gdb.fortran/print_type.exp | 10 ++++
gdb/valops.c | 3 ++
6 files changed, 163 insertions(+)
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 9e1759b..76ae406 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1828,6 +1828,18 @@ is_dynamic_type_internal (struct type *type, int top_level)
switch (TYPE_CODE (type))
{
+ case TYPE_CODE_PTR:
+ {
+ /* Some Fortran compiler don't create the associated property which
+ would cause a "return 1".
+ For a correct value/type print we have to treat every pointer as
+ dynamic type to cover nullified pointers as well as dynamic target
+ types. */
+ if (current_language->la_language == language_fortran)
+ return 1;
+
+ return 0;
+ }
case TYPE_CODE_RANGE:
{
/* A range type is obviously dynamic if it has at least one
@@ -2105,6 +2117,73 @@ resolve_dynamic_struct (struct type *type,
return resolved_type;
}
+/* Worker for pointer types. */
+
+static struct type *
+resolve_dynamic_pointer (struct type *type,
+ struct property_addr_info *addr_stack)
+{
+ struct property_addr_info pinfo;
+ int is_associated;
+
+ /* If valaddr is set, the type was already resolved
+ and assigned to an value. */
+ if (0 != addr_stack->valaddr)
+ return type;
+
+ if (TYPE_OBJFILE_OWNED (type))
+ {
+ struct dynamic_prop *prop;
+ CORE_ADDR value;
+
+ type = copy_type (type);
+
+ /* Resolve associated property. */
+ prop = TYPE_ASSOCIATED_PROP (type);
+ if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+ {
+ TYPE_DYN_PROP_ADDR (prop) = value;
+ TYPE_DYN_PROP_KIND (prop) = PROP_CONST;
+ is_associated = value;
+ }
+ else
+ {
+ /* Compiler doesn't create associated property for this pointer
+ therefore we have to check whether it is still null. */
+ if (0 != read_memory_typed_address (addr_stack->addr, type))
+ is_associated = 1;
+ else
+ is_associated = 0;
+ }
+ }
+ else
+ {
+ /* Do nothing, as this pointer is created on the fly and therefore
+ associated. For example "print *((integer*) &intvla)". */
+ is_associated = 1;
+ }
+
+ /* Don't resolve not associated pointers. */
+ if (0 == is_associated)
+ 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;
+}
+
/* Worker for resolved_dynamic_type. */
static struct type *
@@ -2153,6 +2232,10 @@ resolve_dynamic_type_internal (struct type *type,
break;
}
+ case TYPE_CODE_PTR:
+ resolved_type = resolve_dynamic_pointer (type, addr_stack);
+ break;
+
case TYPE_CODE_ARRAY:
resolved_type = resolve_dynamic_array (type, addr_stack);
break;
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
index beecbe4..310544c 100644
--- a/gdb/testsuite/gdb.fortran/pointers.exp
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -59,6 +59,11 @@ gdb_test "print *realp" "Cannot access memory at address 0x0" "print *realp, not
gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0"
+gdb_breakpoint [gdb_get_line_number "Before value assignment"]
+gdb_continue_to_breakpoint "Before value assignment"
+gdb_test "print *(twop)%ivla2" "= <not allocated>"
+
+
gdb_breakpoint [gdb_get_line_number "After value assignment"]
gdb_continue_to_breakpoint "After value assignment"
gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?"
@@ -71,5 +76,48 @@ gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\( <.*>\)?"
gdb_test "print *charap" "= 'abc'"
gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) $hex\( <.*>\)?"
gdb_test "print *intp" "= 10"
+set test_name "print intap, associated"
+gdb_test_multiple "print intap" $test_name {
+ -re "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ -re "= \\(PTR TO -> \\( $int \\(10,2\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" {
+ gdb_test "print *intap" "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)"
+ pass $test_name
+ }
+}
+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 $" {
+ gdb_test "print *intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)"
+ pass $test_name
+ }
+}
gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) $hex\( <.*>\)?"
gdb_test "print *realp" "= 3\\.14000\\d+"
+gdb_test "print arrayOfPtr(2)%p" "= \\(PTR TO -> \\( Type two \\)\\) $hex\( <.*>\)?"
+gdb_test "print *(arrayOfPtr(2)%p)" "= \\( \\(11, 12, 13\\), \\(\\( 211, 221\\) \\( 212, 222\\) \\) \\)"
+set test_name "print arrayOfPtr(3)%p"
+gdb_test_multiple $test_name $test_name {
+ -re "= <not associated>\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ -re "= \\(PTR TO -> \\( Type two \\)\\) 0x0\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+}
+set test_name "print *(arrayOfPtr(3)%p), associated"
+gdb_test_multiple "print *(arrayOfPtr(3)%p)" $test_name {
+ -re "Location address is not set.\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ -re "Attempt to take contents of a not associated pointer.\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+}
+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 9ebbaa9..000193c 100644
--- a/gdb/testsuite/gdb.fortran/pointers.f90
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -20,14 +20,20 @@ program pointers
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, dimension (10,2) :: inta
+ integer, target, allocatable, dimension (:) :: intvla
real, target :: realv
type(two), target :: twov
+ type(twoPtr) :: arrayOfPtr (3)
logical, pointer :: logp
complex, pointer :: comp
@@ -35,6 +41,7 @@ program pointers
character (len=3), pointer:: charap
integer, pointer :: intp
integer, pointer, dimension (:,:) :: intap
+ integer, pointer, dimension (:) :: intvlap
real, pointer :: realp
type(two), pointer :: twop
@@ -44,8 +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
@@ -53,8 +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)
@@ -63,6 +76,10 @@ program pointers
intv = 10
inta(:,:) = 1
inta(3,1) = 3
+ allocate (intvla(10))
+ intvla(:) = 2
+ intvla(4) = 4
+ intvlap => intvla
realv = 3.14
allocate (twov%ivla1(3))
diff --git a/gdb/testsuite/gdb.fortran/print_type.exp b/gdb/testsuite/gdb.fortran/print_type.exp
index 37e19ec..1b23af3 100755
--- a/gdb/testsuite/gdb.fortran/print_type.exp
+++ b/gdb/testsuite/gdb.fortran/print_type.exp
@@ -62,6 +62,16 @@ gdb_test "ptype two" \
" $int :: ivla2\\(:,:\\)" \
"End Type two"]
+
+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\\(:\\)" \
+ " $int :: ivla2\\(:,:\\)" \
+ "End Type two \\)"]
+
+
gdb_breakpoint [gdb_get_line_number "After value assignment"]
gdb_continue_to_breakpoint "After value assignment"
gdb_test "ptype logv" "type = $logical"
diff --git a/gdb/valops.c b/gdb/valops.c
index 71fb1b3..5ef0c65 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -1554,6 +1554,9 @@ value_ind (struct value *arg1)
{
struct type *enc_type;
+ if (type_not_associated (base_type))
+ error (_("Attempt to take contents of a not associated pointer."));
+
/* We may be pointing to something embedded in a larger object.
Get the real type of the enclosing object. */
enc_type = check_typedef (value_enclosing_type (arg1));
--
2.7.1.339.g0233b80
More information about the Gdb-patches
mailing list