This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[PATCH 3/3] Fortran: Handle cyclic 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:13 +0200
- Subject: [PATCH 3/3] Fortran: Handle cyclic pointers.
- Authentication-results: sourceware.org; auth=none
- References: <1465220233-32286-1-git-send-email-bernhard dot heckel at intel dot com>
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