From b6e668ccd356ea3e75d30f20314334b1203c22de Mon Sep 17 00:00:00 2001 From: Bernhard Heckel 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 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 . + +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 \\(:,:\\)\\)\\) \r\n$gdb_prompt $" { + pass $test + } + -re " = \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" "= " + + +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 \\)\\) \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 " "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);