From b6e668ccd356ea3e75d30f20314334b1203c22de Mon Sep 17 00:00:00 2001

From: Bernhard Heckel <bernhard.heckel@intel.com>

Date: Tue, 12 Jul 2016 08:19:34 +0200

Subject: [PATCH 5/7] Resolve dynamic target types of pointers.

When dereferencing pointers to dynamic target types,

resolve the target type.

2016-06-30  Bernhard Heckel  <bernhard.heckel@intel.com>

gdb/Changelog:

	* NEWS: Added entry.

	* c-valprint.c (c_print_val): Resolve dynamic target types.

	* valops.c (value_ind): Resolve dynamic target types.

	* valprint.c (check_printable): Don't shortcut not associated

	  pointers.

gdb/Testsuite/Changelog:

	* pointers.f90: Added pointer to dynamic types.

	* gdb.fortran/pointers.exp: New.

Change-Id: I998d4da4a5ba4899b8cb2115576f44efa741e698

---

 gdb/NEWS                               |   2 +

 gdb/c-valprint.c                       |  22 ++++++

 gdb/testsuite/gdb.cp/vla-cxx.exp       |   4 ++

 gdb/testsuite/gdb.fortran/pointers.exp | 123 +++++++++++++++++++++++++++++++++

 gdb/testsuite/gdb.fortran/pointers.f90 |  17 +++++

 gdb/valops.c                           |  16 ++++-

 gdb/valprint.c                         |   6 --

 7 files changed, 182 insertions(+), 8 deletions(-)

 create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp

Index: gdb-7.11.90.20160807/gdb/NEWS

===================================================================

--- gdb-7.11.90.20160807.orig/gdb/NEWS	2016-08-07 21:18:44.032409065 +0200

+++ gdb-7.11.90.20160807/gdb/NEWS	2016-08-07 21:19:17.178715116 +0200

@@ -1,6 +1,8 @@

 		What has changed in GDB?

 	     (Organized release by release)

+* Fortran: Support pointers to dynamic types.

+

 *** Changes in GDB 7.12

 * GDB and GDBserver now build with a C++ compiler by default.

Index: gdb-7.11.90.20160807/gdb/c-valprint.c

===================================================================

--- gdb-7.11.90.20160807.orig/gdb/c-valprint.c	2016-08-07 21:18:44.032409065 +0200

+++ gdb-7.11.90.20160807/gdb/c-valprint.c	2016-08-07 21:18:51.087474207 +0200

@@ -645,6 +645,28 @@

       else

 	{

 	  /* normal case */

+	  if (TYPE_CODE (type) == TYPE_CODE_PTR

+	      && 1 == is_dynamic_type (type))

+	    {

+	      CORE_ADDR addr;

+	      if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type)))

+		addr = value_address (val);

+	      else

+		addr = value_as_address (val);

+

+	      /* We resolve the target-type only when the

+	         pointer is associated.  */

+	      if ((addr != 0)

+		  && (0 == type_not_associated (type)))

+		  TYPE_TARGET_TYPE (type) =

+		      resolve_dynamic_type (TYPE_TARGET_TYPE (type),

+					    NULL, addr);

+	    }

+	  else

+	    {

+	      /* Do nothing. References are already resolved from the beginning,

+	         only pointers are resolved when we actual need the target.  */

+	    }

 	  fprintf_filtered (stream, "(");

 	  type_print (value_type (val), "", stream, -1);

 	  fprintf_filtered (stream, ") ");

Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.cp/vla-cxx.exp

===================================================================

--- gdb-7.11.90.20160807.orig/gdb/testsuite/gdb.cp/vla-cxx.exp	2016-08-07 21:18:44.033409074 +0200

+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.cp/vla-cxx.exp	2016-08-07 21:18:51.088474216 +0200

@@ -26,6 +26,8 @@

 gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]

 gdb_continue_to_breakpoint "Before pointer assignment"

 gdb_test "ptype ptr" "int \\(\\*\\)\\\[variable length\\\]" "ptype ptr, Before pointer assignment"

+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" "print ptr, Before pointer assignment"

+gdb_test "print *ptr" "Cannot access memory at address 0x0" "print *ptr, Before pointer assignment"

 gdb_breakpoint [gdb_get_line_number "vlas_filled"]

 gdb_continue_to_breakpoint "vlas_filled"

@@ -38,3 +40,5 @@

 gdb_test "print vlaref2" " = \\(.*\\) @$hex: \\{5, 7, 9\\}"

 gdb_test "print c" " = \\{e = \\{c = @$hex\\}\\}"

 gdb_test "ptype ptr" "int \\(\\*\\)\\\[3\\\]"

+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[3\\\]\\) $hex"

+gdb_test "print *ptr" " = \\{5, 7, 9\\}"

Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.exp

===================================================================

--- /dev/null	1970-01-01 00:00:00.000000000 +0000

+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.exp	2016-08-07 21:18:51.088474216 +0200

@@ -0,0 +1,123 @@

+# Copyright 2016 Free Software Foundation, Inc.

+

+# This program is free software; you can redistribute it and/or modify

+# it under the terms of the GNU General Public License as published by

+# the Free Software Foundation; either version 3 of the License, or

+# (at your option) any later version.

+#

+# This program is distributed in the hope that it will be useful,

+# but WITHOUT ANY WARRANTY; without even the implied warranty of

+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

+# GNU General Public License for more details.

+#

+# You should have received a copy of the GNU General Public License

+# along with this program.  If not, see <http://www.gnu.org/licenses/>.

+

+standard_testfile "pointers.f90"

+load_lib fortran.exp

+

+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \

+    {debug f90 quiet}] } {

+    return -1

+}

+

+if ![runto_main] {

+    untested "could not run to main"

+    return -1

+}

+

+# Depending on the compiler being used, the type names can be printed differently.

+set logical [fortran_logical4]

+set real [fortran_real4]

+set int [fortran_int4]

+set complex [fortran_complex4]

+

+

+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]

+gdb_continue_to_breakpoint "Before pointer assignment"

+gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) 0x0" "print logp, not associated"

+gdb_test "print *logp" "Cannot access memory at address 0x0" "print *logp, not associated"

+gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) 0x0" "print comp, not associated"

+gdb_test "print *comp" "Cannot access memory at address 0x0" "print *comp, not associated"

+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) 0x0" "print charp, not associated"

+gdb_test "print *charp" "Cannot access memory at address 0x0" "print *charp, not associated"

+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) 0x0" "print charap, not associated"

+gdb_test "print *charap" "Cannot access memory at address 0x0" "print *charap, not associated"

+gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0" "print intp, not associated"

+gdb_test "print *intp" "Cannot access memory at address 0x0" "print *intp, not associated"

+set test "print intap, not associated"

+gdb_test_multiple "print intap" $test {

+  -re " = \\(PTR TO -> \\( $int \\(:,:\\)\\)\\) <not associated>\r\n$gdb_prompt $" {

+    pass $test

+  }

+  -re " = <not associated>\r\n$gdb_prompt $" {

+    pass $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"

+

+

+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\( <.*>\)?"

+gdb_test "print *logp" "= \\.TRUE\\."

+gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) $hex\( <.*>\)?"

+gdb_test "print *comp" "= \\(1,2\\)"

+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) $hex\( <.*>\)?"

+gdb_test "print *charp" "= 'a'"

+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)" "= \\( ivla1 = \\(11, 12, 13\\), ivla2 = \\(\\( 211, 221\\) \\( 212, 222\\) \\) \\)"

+set test_name "print arrayOfPtr(3)%p"

+gdb_test_multiple $test_name $test_name {

+  -re "= \\(PTR TO -> \\( Type two \\)\\) <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 "Cannot access memory at address 0x0\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"

Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.f90

===================================================================

--- gdb-7.11.90.20160807.orig/gdb/testsuite/gdb.fortran/pointers.f90	2016-08-07 21:18:44.033409074 +0200

+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.f90	2016-08-07 21:18:51.088474216 +0200

@@ -20,14 +20,20 @@

     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 @@

   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 @@

   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 @@

   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 @@

   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))

Index: gdb-7.11.90.20160807/gdb/valops.c

===================================================================

--- gdb-7.11.90.20160807.orig/gdb/valops.c	2016-08-07 21:18:44.035409093 +0200

+++ gdb-7.11.90.20160807/gdb/valops.c	2016-08-07 21:18:51.089474225 +0200

@@ -1562,6 +1562,19 @@

   if (TYPE_CODE (base_type) == TYPE_CODE_PTR)

     {

       struct type *enc_type;

+      CORE_ADDR addr;

+

+      if (type_not_associated (base_type))

+        error (_("Attempt to take contents of a not associated pointer."));

+

+      if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (base_type)))

+	addr = value_address (arg1);

+      else

+	addr = value_as_address (arg1);

+

+      if (addr != 0)

+	TYPE_TARGET_TYPE (base_type) =

+	    resolve_dynamic_type (TYPE_TARGET_TYPE (base_type), NULL, addr);

       /* We may be pointing to something embedded in a larger object.

          Get the real type of the enclosing object.  */

@@ -1577,8 +1590,7 @@

       else

 	/* Retrieve the enclosing object pointed to.  */

 	arg2 = value_at_lazy (enc_type, 

-			      (value_as_address (arg1)

-			       - value_pointed_to_offset (arg1)));

+			      (addr - value_pointed_to_offset (arg1)));

       enc_type = value_type (arg2);

       return readjust_indirect_value_type (arg2, enc_type, base_type, arg1);

Index: gdb-7.11.90.20160807/gdb/valprint.c

===================================================================

--- gdb-7.11.90.20160807.orig/gdb/valprint.c	2016-08-07 04:00:01.000000000 +0200

+++ gdb-7.11.90.20160807/gdb/valprint.c	2016-08-07 21:18:51.090474235 +0200

@@ -1141,12 +1141,6 @@

       return 0;

     }

-  if (type_not_associated (value_type (val)))

-    {

-      val_print_not_associated (stream);

-      return 0;

-    }

-

   if (type_not_allocated (value_type (val)))

     {

       val_print_not_allocated (stream);