[PATCH V2 5/5] Fortran: Handle cyclic pointers.

[Bernhard Heckel <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                         | 17 ++++++++++++-----
 gdb/testsuite/gdb.fortran/pointers.exp | 22 ++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/pointers.f90 | 12 ++++++++++++
 3 files changed, 46 insertions(+), 5 deletions(-)

diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 76ae406..5c22ef0 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;
   int is_associated;
@@ -2167,6 +2169,11 @@ resolve_dynamic_pointer (struct type *type,
   if (0 == is_associated)
     return type;
 
+  /* To avoid endless resolving of cylic pointers, we only resolve the
+     outermost pointer type.  */
+  if (!top_level)
+    return type;
+
   pinfo.type = check_typedef (TYPE_TARGET_TYPE (type));
   pinfo.valaddr = NULL;
   /* Data location attr. refers to the "address of the variable".
@@ -2233,7 +2240,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:
@@ -2249,7 +2256,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 df74743..0d2e4f6 100644
--- a/gdb/testsuite/gdb.fortran/pointers.exp
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -57,6 +57,26 @@ gdb_test_multiple "print intap" $test {
 gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) 0x0" "print realp, not associated"
 gdb_test "print *realp" "Cannot access memory at address 0x0" "print *realp, not associated"
 gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0"
+set test "print cyclicp1, not associated"
+gdb_test_multiple "print cyclicp1" $test {
+  -re "= \\( -?\\d+, 0x0 \\)\r\n$gdb_prompt $" {
+    pass $test
+  }
+  -re "= \\( -?\\d+, <not associated> \\)\r\n$gdb_prompt $" {
+    pass $test
+  }
+  timeout { fail "$test (timeout)" }
+}
+set test "print cyclicp1%p, not associated"
+gdb_test_multiple "print cyclicp1%p" $test {
+  -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0\r\n$gdb_prompt $" {
+    pass $test
+  }
+  -re "= <not associated>\r\n$gdb_prompt $" {
+    pass $test
+  }
+  timeout { fail "$test (timeout)" }
+}
 
 
 gdb_breakpoint [gdb_get_line_number "Before value assignment"]
@@ -120,6 +140,8 @@ gdb_test_multiple "print *(arrayOfPtr(3)%p)" $test_name {
     pass $test_name
   }
 }
+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 000193c..6240c87 100644
--- a/gdb/testsuite/gdb.fortran/pointers.f90
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -20,6 +20,11 @@ program pointers
     integer, allocatable :: ivla2 (:, :)
   end type two
 
+  type :: typeWithPointer
+    integer i
+    type(typeWithPointer), pointer:: p
+  end type typeWithPointer
+
   type :: twoPtr
     type (two), pointer :: p
   end type twoPtr
@@ -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