diff mbox series

[v2,2/4] gdb/types: Resolve pointer types dynamically

Message ID 20221005204039.575255-3-nils-christian.kempke@intel.com
State New
Headers
Series Dynamic properties of pointers |

Commit Message

Kempke, Nils-Christian Oct. 5, 2022, 8:40 p.m. UTC 
  From: Bernhard Heckel <bernhard.heckel@intel.com>

This commit allows pointers to be dynamic types (on the outmost
level).  Similar to references, a pointer is considered a dynamic type
if its target type is a dynamic type and it is on the outmost level.

The pointer resolution follows the one of references.

This generally makes the GDB output more verbose.  We are able to print
more details about a pointer's target like the dimension of an array.

In Fortran, if we have a pointer to a dynamic type

  type buffer
    real, dimension(:), pointer :: ptr
  end type buffer
  type(buffer), pointer :: buffer_ptr
  allocate (buffer_ptr)
  allocate (buffer_ptr%ptr (5))

which then gets allocated, we now resolve the dynamic type before
printing the pointer's type:

Before:

  (gdb) ptype buffer_ptr
  type = PTR TO -> ( Type buffer
    real(kind=4) :: alpha(:)
  End Type buffer )

After:

  (gdb) ptype buffer_ptr
  type = PTR TO -> ( Type buffer
    real(kind=4) :: alpha(5)
  End Type buffer )

Similarly in C++ we can dynamically resolve e.g. pointers to arrays:

  int len = 3;
  int arr[len];
  int (*ptr)[len];
  int ptr = &arr;

Once the pointer is assigned one gets:

Before:

  (gdb) p ptr
  $1 = (int (*)[variable length]) 0x123456
  (gdb) ptype ptr
  type = int (*)[variable length]

After:

  (gdb) p ptr
  $1 = (int (*)[3]) 0x123456
  (gdb) ptype ptr
  type = int (*)[3]

For more examples see the modified/added test cases.
---
 gdb/gdbtypes.c                                |  16 ++-
 gdb/testsuite/gdb.cp/vla-cxx.cc               |   4 +
 gdb/testsuite/gdb.cp/vla-cxx.exp              |  15 +++
 gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp       |  16 +--
 .../gdb.fortran/pointer-to-pointer.exp        |   2 +-
 gdb/testsuite/gdb.fortran/pointers.exp        | 114 ++++++++++++++++++
 gdb/testsuite/gdb.fortran/pointers.f90        |  29 +++++
 gdb/valprint.c                                |   6 -
 8 files changed, 182 insertions(+), 20 deletions(-)
 create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp

Comments

Tom Tromey Jan. 5, 2023, 7:35 p.m. UTC | #1 
>>>>> Nils-Christian Kempke via Gdb-patches <gdb-patches@sourceware.org> writes:

> -  if (type_not_associated (value_type (val)))
> -    {
> -      val_print_not_associated (stream);
> -      return 0;
> -    }
> -

I don't really understand the importance of this hunk, but I do see what
appear to be tests for this output, so if those still pass I suppose
this code is redundant and therefore the patch is ok.

Tom
diff mbox series

Patch

diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 643bb0a14a3..5eb4b649d5c 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2085,8 +2085,10 @@  is_dynamic_type_internal (struct type *type, int top_level)
 {
   type = check_typedef (type);
 
-  /* We only want to recognize references at the outermost level.  */
-  if (top_level && type->code () == TYPE_CODE_REF)
+  /* We only want to recognize references and pointers at the outermost
+     level.  */
+  if (top_level
+      && (type->code () == TYPE_CODE_REF || type->code () == TYPE_CODE_PTR))
     type = check_typedef (type->target_type ());
 
   /* Types that have a dynamic TYPE_DATA_LOCATION are considered
@@ -2825,6 +2827,7 @@  resolve_dynamic_type_internal (struct type *type,
       switch (type->code ())
 	{
 	case TYPE_CODE_REF:
+	case TYPE_CODE_PTR:
 	  {
 	    struct property_addr_info pinfo;
 
@@ -2838,9 +2841,12 @@  resolve_dynamic_type_internal (struct type *type,
 	    pinfo.next = addr_stack;
 
 	    resolved_type = copy_type (type);
-	    resolved_type->set_target_type
-	      (resolve_dynamic_type_internal (type->target_type (),
-					      &pinfo, top_level));
+
+	    /* For pointers the target address might not be set yet.  */
+	    if (pinfo.addr != 0)
+	      resolved_type->set_target_type
+		(resolve_dynamic_type_internal (type->target_type (),
+						&pinfo, top_level));
 	    break;
 	  }
 
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.cc b/gdb/testsuite/gdb.cp/vla-cxx.cc
index 9795f8cc39b..c03d1a80ac8 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.cc
+++ b/gdb/testsuite/gdb.cp/vla-cxx.cc
@@ -40,6 +40,10 @@  int main(int argc, char **argv)
   typedef typeof (vla) &vlareftypedef;
   vlareftypedef vlaref2 (vla);
   container c;
+  typeof (vla) *ptr = nullptr;
+
+  // Before pointer assignment
+  ptr = &vla;
 
   for (int i = 0; i < z; ++i)
     vla[i] = 5 + 2 * i;
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp
index 3494b5e8b77..bb94bce4e6a 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.exp
+++ b/gdb/testsuite/gdb.cp/vla-cxx.exp
@@ -23,6 +23,18 @@  if ![runto_main] {
     return -1
 }
 
+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"
 
@@ -33,3 +45,6 @@  gdb_test "print vlaref" " = \\(int \\(&\\)\\\[3\\\]\\) @$hex: \\{5, 7, 9\\}"
 # bug being tested, it's better not to depend on the exact spelling.
 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.dwarf2/dynarr-ptr.exp b/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp
index 83a5fccd831..7c7cf12c4eb 100644
--- a/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp
+++ b/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp
@@ -156,7 +156,7 @@  gdb_test "print foo.three_ptr.all'length" \
          " = 3"
 
 gdb_test "ptype foo.three_ptr.all" \
-         " = array \\(<>\\) of integer"
+         " = array \\(1 \\.\\. 3\\) of integer"
 
 # foo.three_ptr
 
@@ -179,7 +179,7 @@  gdb_test "print foo.three_ptr'length" \
          " = 3"
 
 gdb_test "ptype foo.three_ptr" \
-         " = access array \\(<>\\) of integer"
+         " = access array \\(1 \\.\\. 3\\) of integer"
 
 # foo.three_ptr_tdef.all
 
@@ -205,7 +205,7 @@  gdb_test "print foo.three_ptr_tdef.all'length" \
          " = 3"
 
 gdb_test "ptype foo.three_ptr_tdef.all" \
-         " = array \\(<>\\) of integer"
+         " = array \\(1 \\.\\. 3\\) of integer"
 
 # foo.three_ptr_tdef
 
@@ -228,7 +228,7 @@  gdb_test "print foo.three_ptr_tdef'length" \
          " = 3"
 
 gdb_test "ptype foo.three_ptr_tdef" \
-         " = access array \\(<>\\) of integer"
+         " = access array \\(1 \\.\\. 3\\) of integer"
 
 # foo.five_ptr.all
 
@@ -260,7 +260,7 @@  gdb_test "print foo.five_ptr.all'length" \
          " = 5"
 
 gdb_test "ptype foo.five_ptr.all" \
-         " = array \\(<>\\) of integer"
+         " = array \\(2 \\.\\. 6\\) of integer"
 
 # foo.five_ptr
 
@@ -289,7 +289,7 @@  gdb_test "print foo.five_ptr'length" \
          " = 5"
 
 gdb_test "ptype foo.five_ptr" \
-         " = access array \\(<>\\) of integer"
+         " = access array \\(2 \\.\\. 6\\) of integer"
 
 # foo.five_ptr_tdef.all
 
@@ -321,7 +321,7 @@  gdb_test "print foo.five_ptr_tdef.all'length" \
          " = 5"
 
 gdb_test "ptype foo.five_ptr_tdef.all" \
-         " = array \\(<>\\) of integer"
+         " = array \\(2 \\.\\. 6\\) of integer"
 
 # foo.five_ptr_tdef
 
@@ -350,4 +350,4 @@  gdb_test "print foo.five_ptr_tdef'length" \
          " = 5"
 
 gdb_test "ptype foo.five_ptr_tdef" \
-         " = access array \\(<>\\) of integer"
+         " = access array \\(2 \\.\\. 6\\) of integer"
diff --git a/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
index 8c43d177295..fcaa4bc9708 100644
--- a/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
+++ b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
@@ -41,7 +41,7 @@  gdb_test "print buffer" \
 gdb_test "ptype buffer" \
     [multi_line \
 	 "type = PTR TO -> \\( Type l_buffer" \
-	 "    $real4 :: alpha\\(:\\)" \
+	 "    $real4 :: alpha\\(5\\)" \
 	 "End Type l_buffer \\)" ]
 gdb_test "ptype buffer%alpha" "type = $real4 \\(5\\)"
 
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
new file mode 100644
index 00000000000..c7a60fec6b6
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -0,0 +1,114 @@ 
+# Copyright 2022 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 {![fortran_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"
+gdb_test "print intap" " = <not associated>" "print intap, not associated"
+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_test "print cyclicp1" "= \\( i = -?\\d+, p = 0x0 \\)" \
+    "print cyclicp1, not associated"
+gdb_test "print cyclicp1%p" \
+    "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0" \
+    "print cyclicp1%p, not associated"
+
+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"
+gdb_test "print intap" "= \\(\\(1, 1, 3(, 1){7}\\) \\(1(, 1){9}\\)\\)" \
+    "print intap, associated"
+gdb_test "print intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)" \
+    "print intvlap, associated"
+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\\)\\) \\)"
+gdb_test "print arrayOfPtr(3)%p" "= \\(PTR TO -> \\( Type two \\)\\) 0x0" \
+    "print arrayOfPtr(3)%p"
+
+gdb_test_multiple "print *(arrayOfPtr(3)%p)" \
+    "print *(arrayOfPtr(3)%p), associated" {
+    # gfortran
+    -re -wrap "Cannot access memory at address 0x0" {
+	pass $gdb_test_name
+    }
+    # ifx
+    -re -wrap "Location address is not set." {
+	pass $gdb_test_name
+    }
+}
+
+gdb_test "print cyclicp1" "= \\( i = 1, p = $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 7f628662546..e480bdc7fbb 100644
--- a/gdb/testsuite/gdb.fortran/pointers.f90
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -20,14 +20,26 @@  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
+
   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)
+  type(typeWithPointer), target:: cyclicp1,cyclicp2
 
   logical, pointer :: logp
   complex, pointer :: comp
@@ -35,6 +47,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 +57,14 @@  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)
+  nullify (cyclicp1%p)
+  nullify (cyclicp2%p)
 
   logp => logv    ! Before pointer assignment
   comp => comv
@@ -53,8 +72,14 @@  program pointers
   charap => chara
   intp => intv
   intap => inta
+  intvlap => intvla
   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)
@@ -63,6 +88,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/valprint.c b/gdb/valprint.c
index 91a59419c4e..258885b4471 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -1137,12 +1137,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);