[07/11] Resolve dynamic target types of pointers.

Message ID 20181127183139.71170-8-sbasierski@pl.sii.eu
State New
Headers show
Series
  • Adds functionality and fixes some code
Related show

Commit Message

Sebastian Basierski Nov. 27, 2018, 6:31 p.m.
From: Bernhard Heckel <bernhard.heckel@intel.com>


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.
---
 gdb/NEWS                               |   2 +
 gdb/c-valprint.c                       |  22 ++++
 gdb/testsuite/gdb.cp/vla-cxx.exp       |   6 ++
 gdb/testsuite/gdb.fortran/pointers.exp | 137 +++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/pointers.f90 |  17 +++
 gdb/valops.c                           |  16 ++-
 gdb/valprint.c                         |   6 --
 7 files changed, 198 insertions(+), 8 deletions(-)
 create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp

-- 
2.17.1

Comments

Eli Zaretskii Nov. 28, 2018, 6:07 a.m. | #1
> From: Sebastian Basierski <sbasierski@pl.sii.eu>

> Date: Tue, 27 Nov 2018 19:31:35 +0100

> 

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

> 

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


OK for the NEWS part.

Thanks.

Patch

diff --git a/gdb/NEWS b/gdb/NEWS
index ff9b192a38..8fe8faecb6 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -650,6 +650,8 @@  show disassembler-options
 * GDBserver now supports recording btrace without maintaining an active
   GDB connection.
 
+* Fortran: Support pointers to dynamic types.
+
 * GDB now supports a negative repeat count in the 'x' command to examine
   memory backward from the given address.  For example:
 
diff --git a/gdb/c-valprint.c b/gdb/c-valprint.c
index c4c0918e26..254ebd1ee6 100644
--- a/gdb/c-valprint.c
+++ b/gdb/c-valprint.c
@@ -653,6 +653,28 @@  c_value_print (struct value *val, struct ui_file *stream,
       else
 	{
 	  /* normal case */
+	  if (TYPE_CODE (type) == TYPE_CODE_PTR
+	      && 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)
+		  && !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, ") ");
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp
index 2cf2d9868f..32e4329f93 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.exp
+++ b/gdb/testsuite/gdb.cp/vla-cxx.exp
@@ -26,6 +26,10 @@  if ![runto_main] {
 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 +42,5 @@  gdb_test "print vlaref" " = \\(int \\(&\\)\\\[3\\\]\\) @$hex: \\{5, 7, 9\\}"
 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\\}"
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
new file mode 100644
index 0000000000..0f6c9d3cdf
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -0,0 +1,137 @@ 
+# Copyright 2018 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"
diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
index dd4fe811be..c36398d76a 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/valops.c b/gdb/valops.c
index a34e74b2be..90dc2fec0c 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -1558,6 +1558,19 @@  value_ind (struct value *arg1)
   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.  */
@@ -1573,8 +1586,7 @@  value_ind (struct value *arg1)
       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);
diff --git a/gdb/valprint.c b/gdb/valprint.c
index b2236f8931..35f22b6d43 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -1108,12 +1108,6 @@  value_check_printable (struct value *val, struct ui_file *stream,
       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);