From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mga12.intel.com (mga12.intel.com [192.55.52.136]) by sourceware.org (Postfix) with ESMTPS id C167B3858020 for ; Tue, 18 Jan 2022 13:27:07 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org C167B3858020 X-IronPort-AV: E=McAfee;i="6200,9189,10230"; a="224791696" X-IronPort-AV: E=Sophos;i="5.88,297,1635231600"; d="scan'208";a="224791696" Received: from orsmga005.jf.intel.com ([10.7.209.41]) by fmsmga106.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 18 Jan 2022 05:27:06 -0800 X-IronPort-AV: E=Sophos;i="5.88,297,1635231600"; d="scan'208";a="693385217" Received: from labpcdell3650-003.iul.intel.com (HELO localhost) ([172.28.49.87]) by orsmga005-auth.jf.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 18 Jan 2022 05:27:05 -0800 From: Nils-Christian Kempke To: gdb-patches@sourceware.org Subject: [PATCH 2/2] gdb: Resolve dynamic target types of pointers. Date: Tue, 18 Jan 2022 14:26:26 +0100 Message-Id: <20220118132626.3786176-3-nils-christian.kempke@intel.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220118132626.3786176-1-nils-christian.kempke@intel.com> References: <20220118132626.3786176-1-nils-christian.kempke@intel.com> MIME-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit X-Spam-Status: No, score=-10.8 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, SPF_HELO_PASS, SPF_NONE, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 18 Jan 2022 13:27:11 -0000 Resolve the dynamic target type of a pointer as we might want to print more details of the target like the dimension of an array. When dereferencing pointers to dynamic target types we resolve the target type. 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 pointers 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/c-valprint.c | 19 +- gdb/testsuite/gdb.cp/vla-cxx.cc | 4 + gdb/testsuite/gdb.cp/vla-cxx.exp | 33 ++++ gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp | 4 +- .../gdb.fortran/pointer-to-pointer.exp | 2 +- gdb/testsuite/gdb.fortran/pointers.exp | 181 ++++++++++++++++++ gdb/testsuite/gdb.fortran/pointers.f90 | 29 +++ gdb/typeprint.c | 17 ++ gdb/valops.c | 11 ++ gdb/valprint.c | 6 - 10 files changed, 296 insertions(+), 10 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp diff --git a/gdb/c-valprint.c b/gdb/c-valprint.c index 461763075e..3eb0a72228 100644 --- a/gdb/c-valprint.c +++ b/gdb/c-valprint.c @@ -545,7 +545,24 @@ c_value_print (struct value *val, struct ui_file *stream, } else { - /* normal case */ + /* Normal case. */ + if (type->code () == TYPE_CODE_PTR && is_dynamic_type (type)) + { + CORE_ADDR addr; + if (nullptr != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type))) + addr = value_address (val); + else + addr = value_as_address (val); + + /* Resolve 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), {}, addr); + } + else + { + /* Do nothing. References are already resolved. */ + } fprintf_filtered (stream, "("); type_print (value_type (val), "", stream, -1); fprintf_filtered (stream, ") "); diff --git a/gdb/testsuite/gdb.cp/vla-cxx.cc b/gdb/testsuite/gdb.cp/vla-cxx.cc index 9795f8cc39..c03d1a80ac 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 3494b5e8b7..9c81b1700d 100644 --- a/gdb/testsuite/gdb.cp/vla-cxx.exp +++ b/gdb/testsuite/gdb.cp/vla-cxx.exp @@ -23,6 +23,36 @@ if ![runto_main] { return -1 } +gdb_breakpoint [gdb_get_line_number "Before pointer assignment"] +gdb_continue_to_breakpoint "Before pointer assignment" + +set test_name "ptype ptr, Before pointer assignment" +gdb_test_multiple "ptype ptr" $test_name { + # gfortran + -re "= int \\(\\*\\)\\\[variable length\\\]\r\n$gdb_prompt $" { + pass $test_name + } + # ifort/ifx + -re "= int \\(\\*\\)\\\[3\\\]\r\n$gdb_prompt $" { + pass $test_name + } +} + +set test_name "print ptr, Before pointer assignment" +gdb_test_multiple "print ptr" $test_name { + # gfortran + -re "= \\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0\r\n$gdb_prompt $" { + pass $test_name + } + # ifort/ifx + -re "= \\(int \\(\\*\\)\\\[3\\\]\\) 0x0\r\n$gdb_prompt $" { + pass $test_name + } +} + +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 +63,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 83a5fccd83..ce28868d60 100644 --- a/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp +++ b/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp @@ -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 @@ -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 diff --git a/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp index 8c43d17729..fcaa4bc970 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 0000000000..b093ce72bd --- /dev/null +++ b/gdb/testsuite/gdb.fortran/pointers.exp @@ -0,0 +1,181 @@ +# 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 { + # gfortran + -re " = \r\n$gdb_prompt $" { + pass $test + } + # ifort/ifx + -re " = \\(PTR TO -> \\( $int \\(:,:\\) \\)\\) \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" +set test "print cyclicp1, not associated" +gdb_test_multiple "print cyclicp1" $test { + # gfortran + -re "= \\( i = -?\\d+, p = 0x0 \\)\r\n$gdb_prompt $" { + pass $test + } + # ifort/ifx + -re "= \\( i = -?\\d+, p = \\)\r\n$gdb_prompt $" { + pass $test + } +} + +set test "print cyclicp1%p, not associated" +gdb_test_multiple "print cyclicp1%p" $test { + # gfortran + -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0\r\n$gdb_prompt $" { + pass $test + } + # ifort/ifx + -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) \r\n$gdb_prompt $" { + pass $test + } +} + + +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 { + # gfortran + -re "= \\(\\(1, 1, 3(, 1){7}\\) \\(1(, 1){9}\\)\\)\r\n$gdb_prompt $" { + pass $test_name + } + # ifort/ifx + -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 { + # gfortran + -re "= \\(2, 2, 2, 4(, 2){6}\\)\r\n$gdb_prompt $" { + pass $test_name + } + # ifort/ifx + -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 { + # gfortran + -re "= \\(PTR TO -> \\( Type two \\)\\) 0x0\r\n$gdb_prompt $" { + pass $test_name + } + # ifort/ifx + -re "= \\(PTR TO -> \\( Type two \\)\\) \r\n$gdb_prompt $" { + pass $test_name + } +} + +set test "print *(arrayOfPtr(3)%p)" +set test_name "print *(arrayOfPtr(3)%p), associated" +gdb_test_multiple $test $test_name { + # gfortran + -re "Cannot access memory at address 0x0\r\n$gdb_prompt $" { + pass $test_name + } + # ifort/ifx + -re "Location address is not set.\r\n$gdb_prompt $" { + pass $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 " \ + "Print program counter" diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90 index 7f62866254..e480bdc7fb 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/typeprint.c b/gdb/typeprint.c index 2428aa2244..c07dede118 100644 --- a/gdb/typeprint.c +++ b/gdb/typeprint.c @@ -578,6 +578,23 @@ whatis_exp (const char *exp, int show) printf_filtered (" */\n"); } + /* Resolve any dynamic target type, as we might print additional information + about the target. For example, in Fortran and C we are printing the + dimension of the dynamic array the pointer is pointing to. */ + if (type->code () == TYPE_CODE_PTR && is_dynamic_type (type)) + { + CORE_ADDR addr; + + if (nullptr != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type))) + addr = value_address (val); + else + addr = value_as_address (val); + + if (addr != 0 && !type_not_associated (type)) + TYPE_TARGET_TYPE (type) = resolve_dynamic_type (TYPE_TARGET_TYPE (type), + {}, addr); + } + LA_PRINT_TYPE (type, "", gdb_stdout, show, 0, &flags); printf_filtered ("\n"); } diff --git a/gdb/valops.c b/gdb/valops.c index e091c445e7..08d3f3f3fa 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -1644,6 +1644,16 @@ value_ind (struct value *arg1) if (base_type->code () == TYPE_CODE_PTR) { struct type *enc_type; + CORE_ADDR addr; + + if (nullptr != 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), {}, addr); /* We may be pointing to something embedded in a larger object. Get the real type of the enclosing object. */ @@ -1664,6 +1674,7 @@ value_ind (struct value *arg1) base_addr = (value_as_address (arg1) - value_pointed_to_offset (arg1)); } + /* Retrieve the enclosing object pointed to. */ arg2 = value_at_lazy (enc_type, base_addr); enc_type = value_type (arg2); return readjust_indirect_value_type (arg2, enc_type, base_type, diff --git a/gdb/valprint.c b/gdb/valprint.c index 0bc739cf2e..041f544c3d 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -1112,12 +1112,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); -- 2.25.1 Intel Deutschland GmbH Registered Address: Am Campeon 10, 85579 Neubiberg, Germany Tel: +49 89 99 8853-0, www.intel.de Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva Chairperson of the Supervisory Board: Nicole Lau Registered Office: Munich Commercial Register: Amtsgericht Muenchen HRB 186928