[PATCH 3/3] Fortran: Handle cyclic pointers.
Bernhard Heckel
bernhard.heckel@intel.com
Mon Jun 6 13:37:00 GMT 2016
In order to avoid endless resolving of pointers pointing to itself,
only the outermost level of dynamic types are resolved. We do this
already for reference types as well.
2016-05-25 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog:
* gdbtypes.c (is_dynamic_type_internal): Resolve pointers only
at the outermost level.
gdb/testsuite/Changelog:
* pointers.f90: Add cylic pointers.
* pointers.exp: Add print of cyclic pointers.
---
gdb/gdbtypes.c | 14 ++++++++------
gdb/testsuite/gdb.fortran/pointers.exp | 5 ++++-
gdb/testsuite/gdb.fortran/pointers.f90 | 12 ++++++++++++
3 files changed, 24 insertions(+), 7 deletions(-)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 061785e..6156806 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2036,7 +2036,8 @@ resolve_dynamic_union (struct type *type,
static struct type *
resolve_dynamic_struct (struct type *type,
- struct property_addr_info *addr_stack)
+ struct property_addr_info *addr_stack,
+ int top_level)
{
struct type *resolved_type;
int i;
@@ -2081,7 +2082,7 @@ resolve_dynamic_struct (struct type *type,
TYPE_FIELD_TYPE (resolved_type, i)
= resolve_dynamic_type_internal (TYPE_FIELD_TYPE (resolved_type, i),
- &pinfo, 0);
+ &pinfo, top_level);
gdb_assert (TYPE_FIELD_LOC_KIND (resolved_type, i)
== FIELD_LOC_KIND_BITPOS);
@@ -2121,7 +2122,8 @@ resolve_dynamic_struct (struct type *type,
static struct type *
resolve_dynamic_pointer (struct type *type,
- struct property_addr_info *addr_stack)
+ struct property_addr_info *addr_stack,
+ int top_level)
{
struct property_addr_info pinfo;
@@ -2166,7 +2168,7 @@ resolve_dynamic_pointer (struct type *type,
}
/* Don't resolve not associated pointers. */
- if (type_not_associated (type))
+ if (type_not_associated (type) || 1 != top_level)
return type;
pinfo.type = check_typedef (TYPE_TARGET_TYPE (type));
@@ -2235,7 +2237,7 @@ resolve_dynamic_type_internal (struct type *type,
}
case TYPE_CODE_PTR:
- resolved_type = resolve_dynamic_pointer (type, addr_stack);
+ resolved_type = resolve_dynamic_pointer (type, addr_stack, top_level);
break;
case TYPE_CODE_ARRAY:
@@ -2251,7 +2253,7 @@ resolve_dynamic_type_internal (struct type *type,
break;
case TYPE_CODE_STRUCT:
- resolved_type = resolve_dynamic_struct (type, addr_stack);
+ resolved_type = resolve_dynamic_struct (type, addr_stack, top_level);
break;
}
}
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
index ebb04a7..3260c25 100644
--- a/gdb/testsuite/gdb.fortran/pointers.exp
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -44,6 +44,8 @@ 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_test "print cyclicp1" "= \\( -?\\d+, <not associated> \\)" "print cyclip1 = not associated"
+gdb_test "print cyclicp1%p" "= <not associated>"
gdb_breakpoint [gdb_get_line_number "Before value assignment"]
gdb_continue_to_breakpoint "Before value assignment"
@@ -82,7 +84,8 @@ gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) $hex\( <.*>\)?" "print
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 cyclicp1" "= \\( 1, $hex\( <.*>\)? \\)"
+gdb_test "print cyclicp1%p" "= \\(PTR TO -> \\( Type typewithpointer \\)\\) $hex\( <.*>\)?"
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 8b26959..548dd61 100644
--- a/gdb/testsuite/gdb.fortran/pointers.f90
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -19,6 +19,11 @@ program pointers
integer, allocatable :: ivla1 (:)
integer, allocatable :: ivla2 (:, :)
end type two
+
+ type :: typeWithPointer
+ integer i
+ type(typeWithPointer), pointer:: p
+ end type typeWithPointer
type :: twoPtr
type (two), pointer :: p
@@ -34,6 +39,7 @@ program pointers
real, target :: realv
type(two), target :: twov
type(twoPtr) :: arrayOfPtr (3)
+ type(typeWithPointer), target:: cyclicp1,cyclicp2
logical, pointer :: logp
complex, pointer :: comp
@@ -57,6 +63,8 @@ program pointers
nullify (arrayOfPtr(1)%p)
nullify (arrayOfPtr(2)%p)
nullify (arrayOfPtr(3)%p)
+ nullify (cyclicp1%p)
+ nullify (cyclicp2%p)
logp => logv ! Before pointer assignment
comp => comv
@@ -68,6 +76,10 @@ program pointers
realp => realv
twop => twov
arrayOfPtr(2)%p => twov
+ cyclicp1%i = 1
+ cyclicp1%p => cyclicp2
+ cyclicp2%i = 2
+ cyclicp2%p => cyclicp1
logv = associated(logp) ! Before value assignment
comv = cmplx(1,2)
--
2.7.1.339.g0233b80
More information about the Gdb-patches
mailing list