From patchwork Tue Sep 20 07:26:26 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "Kempke, Nils-Christian" X-Patchwork-Id: 57785 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 43E39385803D for ; Tue, 20 Sep 2022 07:27:36 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 43E39385803D DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=sourceware.org; s=default; t=1663658856; bh=9/e9LkDFMKqkVGi2dG5TijnFdKTV7MJWz/9liBEk9b4=; h=To:Subject:Date:In-Reply-To:References:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To:Cc: From; b=q7Av8S1ZysLMZ296F3NHHrWO6tbmKgNoIAbjO9egUed8yhIsM8I5Lm+0dG572jjhe BrYpuZDludvO49/XLyA/MS8TtYYzunOuBcpD24QQ47TDkzZFQ70/XYN54xbKuvQDQp q/Tz7dNC9Qw8mIxpaTo/TNXN09mKUy6Y6uasUN3s= X-Original-To: gdb-patches@sourceware.org Delivered-To: gdb-patches@sourceware.org Received: from mga09.intel.com (mga09.intel.com [134.134.136.24]) by sourceware.org (Postfix) with ESMTPS id ED5B23858D38 for ; Tue, 20 Sep 2022 07:26:42 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org ED5B23858D38 X-IronPort-AV: E=McAfee;i="6500,9779,10475"; a="300440975" X-IronPort-AV: E=Sophos;i="5.93,329,1654585200"; d="scan'208";a="300440975" Received: from fmsmga007.fm.intel.com ([10.253.24.52]) by orsmga102.jf.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 20 Sep 2022 00:26:41 -0700 X-IronPort-AV: E=Sophos;i="5.93,329,1654585200"; d="scan'208";a="621158625" Received: from labpcdell3650-003.iul.intel.com (HELO localhost) ([172.28.49.87]) by fmsmga007-auth.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 20 Sep 2022 00:26:40 -0700 To: gdb-patches@sourceware.org Subject: [PATCH 1/4] gdb, testsuite: handle icc and icpc deprecated remarks Date: Tue, 20 Sep 2022 09:26:26 +0200 Message-Id: <20220920072629.2736207-2-nils-christian.kempke@intel.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220920072629.2736207-1-nils-christian.kempke@intel.com> References: <20220920072629.2736207-1-nils-christian.kempke@intel.com> MIME-Version: 1.0 X-Spam-Status: No, score=-10.3 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_NONE, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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-Patchwork-Original-From: Nils-Christian Kempke via Gdb-patches From: "Kempke, Nils-Christian" Reply-To: Nils-Christian Kempke Cc: tom@tromey.com Errors-To: gdb-patches-bounces+patchwork=sourceware.org@sourceware.org Sender: "Gdb-patches" Starting with icc/icpc version 2021.7.0 and higher both compilers emit a deprecation remark when used. E.g. >> icc --version icc: remark #10441: The Intel(R) C++ Compiler Classic (ICC) is deprecated and will be removed from product release in the second half of 2023. The Intel(R) oneAPI DPC++/C++ Compiler (ICX) is the recommended compiler moving forward. Please transition to use this compiler. Use '-diag-disable=10441' to disable this message. icc (ICC) 2021.7.0 20220713 Copyright (C) 1985-2022 Intel Corporation. All rights reserved. >> icpc --version icpc: remark #10441: The Intel(R) C++ Compiler Classic (ICC) is deprecated ... icpc (ICC) 2021.7.0 20220720 Copyright (C) 1985-2022 Intel Corporation. All rights reserved. As the testsuite compile fails when unexpected output by the compiler is seen this change in the compiler breaks all existing icc and icpc tests. This patch makes the gdb testsuite more forgiving by a) allowing the output of the remark when trying to figure out the compiler version and by b) adding '-diag-disable=10441' to the compile command whenever gdb_compile is called without the intention to detect the compiler. gdb/testsuite/ChangeLog: 2022-07-20 Nils-Christian Kempke * lib/gdb.exp: Handle icc/icpc deprecation warnings. Signed-off-by: Nils-Christian Kempke --- gdb/testsuite/lib/gdb.exp | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 0f6bb20b49c..e6053d7dc4e 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -4493,6 +4493,13 @@ proc gdb_compile {source dest type options} { } } + # Starting with 2021.7.0 (recognized as icc-20-21-7 by GDB) icc and icpc + # are marked as deprecated and both compilers emit the remark #10441. To + # let GDB still compile successfully, we disable these warnings here. + if {!$getting_compiler_info && [test_compiler_info {icc-20-21-[7-9]}]} { + lappend new_options "additional_flags=-diag-disable=10441" + } + # Treating .c input files as C++ is deprecated in Clang, so # explicitly force C++ language. if { !$getting_compiler_info @@ -4749,6 +4756,17 @@ proc gdb_compile {source dest type options} { # Prune uninteresting compiler (and linker) output. regsub "Creating library file: \[^\r\n\]*\[\r\n\]+" $result "" result + # Starting with 2021.7.0 icc and icpc are marked as deprecated and both + # compilers emit a remark #10441. To let GDB still compile successfully, + # we disable these warnings. When $getting_compiler_info is true however, + # we do not yet know the compiler (nor its version) and instead prune these + # lines from the compiler output to let the get_compiler_info pass. + if {$getting_compiler_info} { + regsub \ + "(icc|icpc): remark #10441: The Intel\\(R\\) C\\+\\+ Compiler Classic \\(ICC\\) is deprecated\[^\r\n\]*" \ + "$result" "" result + } + regsub "\[\r\n\]*$" "$result" "" result regsub "^\[\r\n\]*" "$result" "" result From patchwork Tue Sep 20 07:26:27 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "Kempke, Nils-Christian" X-Patchwork-Id: 57786 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 94E283858C2F for ; Tue, 20 Sep 2022 07:28:04 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 94E283858C2F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=sourceware.org; s=default; t=1663658884; bh=DH+8KDz6Z6RCL7Ay8wtm7LPfDMYpaBbeElK3csuVFA4=; h=To:Subject:Date:In-Reply-To:References:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To:Cc: From; b=mBRlzvlkEa28Cf9cI6390Gt47JvuFG8CGUdFOjh7+57M3KlxFOOtJKS5Gnf167G8P lKBJhRVuqlIwQf8xhP3AhCly7yzstoMpJWj5t27RloYjuFHsGhsrMGEX/0YfNhrISp bdcp3a7KVNRLqyPpJyhwicxkPpZMOwq1xBs6dyi8= X-Original-To: gdb-patches@sourceware.org Delivered-To: gdb-patches@sourceware.org Received: from mga09.intel.com (mga09.intel.com [134.134.136.24]) by sourceware.org (Postfix) with ESMTPS id DB4CB3858283 for ; Tue, 20 Sep 2022 07:26:45 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org DB4CB3858283 X-IronPort-AV: E=McAfee;i="6500,9779,10475"; a="300440985" X-IronPort-AV: E=Sophos;i="5.93,329,1654585200"; d="scan'208";a="300440985" Received: from fmsmga007.fm.intel.com ([10.253.24.52]) by orsmga102.jf.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 20 Sep 2022 00:26:45 -0700 X-IronPort-AV: E=Sophos;i="5.93,329,1654585200"; d="scan'208";a="621158643" Received: from labpcdell3650-003.iul.intel.com (HELO localhost) ([172.28.49.87]) by fmsmga007-auth.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 20 Sep 2022 00:26:44 -0700 To: gdb-patches@sourceware.org Subject: [PATCH 2/4] gdb/types: Resolve pointer types dynamically Date: Tue, 20 Sep 2022 09:26:27 +0200 Message-Id: <20220920072629.2736207-3-nils-christian.kempke@intel.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220920072629.2736207-1-nils-christian.kempke@intel.com> References: <20220920072629.2736207-1-nils-christian.kempke@intel.com> MIME-Version: 1.0 X-Spam-Status: No, score=-10.3 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_NONE, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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-Patchwork-Original-From: Nils-Christian Kempke via Gdb-patches From: "Kempke, Nils-Christian" Reply-To: Nils-Christian Kempke Cc: tom@tromey.com, Bernhard Heckel Errors-To: gdb-patches-bounces+patchwork=sourceware.org@sourceware.org Sender: "Gdb-patches" From: Bernhard Heckel 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. When resolving a dynamic pointer in resolve_dynamic_pointer we a) try and resolve its target type (in a similar fashion as it is done for references) and b) resolve the dynamic DW_AT_associated property, which is emitted by ifx and ifort for pointers. 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 | 53 +++++- gdb/testsuite/gdb.cp/vla-cxx.cc | 4 + gdb/testsuite/gdb.cp/vla-cxx.exp | 33 ++++ gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp | 16 +- .../gdb.fortran/pointer-to-pointer.exp | 2 +- gdb/testsuite/gdb.fortran/pointers.exp | 178 ++++++++++++++++++ gdb/testsuite/gdb.fortran/pointers.f90 | 29 +++ gdb/valprint.c | 6 - 8 files changed, 303 insertions(+), 18 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index c458b204157..a4d79a64e95 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -2083,9 +2083,15 @@ 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) - type = check_typedef (TYPE_TARGET_TYPE (type)); + /* We only want to recognize references and pointers at the outermost + level. */ + if (type->code () == TYPE_CODE_REF || type->code () == TYPE_CODE_PTR) + { + if (top_level != 0) + type = check_typedef (TYPE_TARGET_TYPE (type)); + else + return 0; + } /* Types that have a dynamic TYPE_DATA_LOCATION are considered dynamic, even if the type itself is statically defined. @@ -2787,6 +2793,43 @@ resolve_dynamic_struct (struct type *type, return resolved_type; } +/* Worker for pointer types. */ + +static struct type * +resolve_dynamic_pointer (struct type *type, + struct property_addr_info *addr_stack) +{ + struct dynamic_prop *prop; + CORE_ADDR value; + + /* Resolve the target type of this type. */ + struct property_addr_info pinfo; + pinfo.type = check_typedef (TYPE_TARGET_TYPE (type)); + pinfo.valaddr = {}; + if (addr_stack->valaddr.data () != NULL) + pinfo.addr = extract_typed_address (addr_stack->valaddr.data (), + type); + else + pinfo.addr = read_memory_typed_address (addr_stack->addr, type); + pinfo.next = addr_stack; + + struct type* resolved_type = copy_type (type); + + /* Resolve associated property. */ + prop = TYPE_ASSOCIATED_PROP (resolved_type); + if (prop != nullptr + && dwarf2_evaluate_property (prop, nullptr, addr_stack, &value)) + prop->set_const_val (value); + + if (pinfo.addr != 0x0 && !type_not_associated (resolved_type)) + TYPE_TARGET_TYPE (resolved_type) + = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (type), + &pinfo, 0); + + + return resolved_type; +} + /* Worker for resolved_dynamic_type. */ static struct type * @@ -2842,6 +2885,10 @@ resolve_dynamic_type_internal (struct type *type, break; } + case TYPE_CODE_PTR: + resolved_type = resolve_dynamic_pointer (type, addr_stack); + break; + case TYPE_CODE_STRING: /* Strings are very much like an array of characters, and can be treated as one here. */ 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..e2bb8989212 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 { + # gcc/icx + -re -wrap "= int \\(\\*\\)\\\[variable length\\\]" { + pass $test_name + } + # icc + -re -wrap "= int \\(\\*\\)\\\[3\\\]" { + pass $test_name + } +} + +set test_name "print ptr, Before pointer assignment" +gdb_test_multiple "print ptr" $test_name { + # gcc/icx + -re -wrap "= \\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" { + pass $test_name + } + # icc + -re -wrap "= \\(int \\(\\*\\)\\\[3\\\]\\) 0x0" { + 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 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..3e9e6d26f3b --- /dev/null +++ b/gdb/testsuite/gdb.fortran/pointers.exp @@ -0,0 +1,178 @@ +# 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 . + +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" + +set test "print intap, not associated" +gdb_test_multiple "print intap" $test { + # gfortran/ifx + -re -wrap " = " { + pass $test + } + # ifort + -re -wrap " = \\(PTR TO -> \\( $int \\(:,:\\) \\)\\) " { + 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/ifx + -re -wrap "= \\( i = -?\\d+, p = 0x0 \\)" { + pass $test + } + # ifort + -re -wrap "= \\( i = -?\\d+, p = \\)" { + pass $test + } +} + +set test "print cyclicp1%p, not associated" +gdb_test_multiple "print cyclicp1%p" $test { + # gfortran/ifx + -re -wrap "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0" { + pass $test + } + # ifort + -re -wrap "= \\(PTR TO -> \\( Type typewithpointer \\)\\) " { + 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/ifx + -re -wrap "= \\(\\(1, 1, 3(, 1){7}\\) \\(1(, 1){9}\\)\\)" { + pass $test_name + } + # ifort + -re -wrap "= \\(PTR TO -> \\( $int \\(10,2\\) \\)\\) $hex\( <.*>\)?" { + 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/ifx + -re -wrap "= \\(2, 2, 2, 4(, 2){6}\\)" { + pass $test_name + } + # ifort + -re -wrap "= \\(PTR TO -> \\( $int \\(10\\) \\)\\) $hex\( <.*>\)?" { + 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/ifx + -re -wrap "= \\(PTR TO -> \\( Type two \\)\\) 0x0" { + pass $test_name + } + # ifort + -re -wrap "= \\(PTR TO -> \\( Type two \\)\\) " { + pass $test_name + } +} + +set test "print *(arrayOfPtr(3)%p)" +set test_name "print *(arrayOfPtr(3)%p), associated" +gdb_test_multiple $test $test_name { + # gfortran/ifx + -re -wrap "Cannot access memory at address 0x0" { + pass $test_name + } + # ifort + -re -wrap "Location address is not set." { + 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 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 3ad4c0cd357..0c3066602fe 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); From patchwork Tue Sep 20 07:26:28 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "Kempke, Nils-Christian" X-Patchwork-Id: 57783 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id DFD1438582A6 for ; Tue, 20 Sep 2022 07:27:18 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org DFD1438582A6 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=sourceware.org; s=default; t=1663658838; bh=AbA7+iKdavuf1vIT7M7Z4KPolm6pj8qO73CneOpqKWM=; h=To:Subject:Date:In-Reply-To:References:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To:Cc: From; b=pD0TWk+QtIuLMaLbghjK284mrO/iwoyE4gpF/b5b7DlJapYD7NfH//zuE3ga7TW5S nI/X9/8kg+THaXCWYvgtG/AndIXEZd1GILbFACUxCOWogF17pF9XPV/+w+OYO6ltGT PnjSeeiZhmCpwOgtGfjuJ6Fu4oOYCQgly5BDTzmM= X-Original-To: gdb-patches@sourceware.org Delivered-To: gdb-patches@sourceware.org Received: from mga09.intel.com (mga09.intel.com [134.134.136.24]) by sourceware.org (Postfix) with ESMTPS id 404423858297 for ; Tue, 20 Sep 2022 07:26:50 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 404423858297 X-IronPort-AV: E=McAfee;i="6500,9779,10475"; a="300440998" X-IronPort-AV: E=Sophos;i="5.93,329,1654585200"; d="scan'208";a="300440998" Received: from fmsmga007.fm.intel.com ([10.253.24.52]) by orsmga102.jf.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 20 Sep 2022 00:26:49 -0700 X-IronPort-AV: E=Sophos;i="5.93,329,1654585200"; d="scan'208";a="621158653" Received: from labpcdell3650-003.iul.intel.com (HELO localhost) ([172.28.49.87]) by fmsmga007-auth.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 20 Sep 2022 00:26:48 -0700 To: gdb-patches@sourceware.org Subject: [PATCH 3/4] gdb, typeprint: fix pointer/reference typeprint for icc/ifort Date: Tue, 20 Sep 2022 09:26:28 +0200 Message-Id: <20220920072629.2736207-4-nils-christian.kempke@intel.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220920072629.2736207-1-nils-christian.kempke@intel.com> References: <20220920072629.2736207-1-nils-christian.kempke@intel.com> MIME-Version: 1.0 X-Spam-Status: No, score=-10.3 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_NONE, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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-Patchwork-Original-From: Nils-Christian Kempke via Gdb-patches From: "Kempke, Nils-Christian" Reply-To: Nils-Christian Kempke Cc: tom@tromey.com Errors-To: gdb-patches-bounces+patchwork=sourceware.org@sourceware.org Sender: "Gdb-patches" Intel classic compilers (icc/icpc/ifort) for references and pointers to arrays generate DWARF that looks like <2><17d>: Abbrev Number: 22 (DW_TAG_variable) <17e> DW_AT_decl_line : 41 <17f> DW_AT_decl_file : 1 <180> DW_AT_name : (indirect string, offset: 0x1f1): vlaref <184> DW_AT_type : <0x214> <188> DW_AT_location : 2 byte block: 76 50 (DW_OP_breg6 (rbp): -48) ... <1><214>: Abbrev Number: 12 (DW_TAG_reference_type) <215> DW_AT_type : <0x219> <1><219>: Abbrev Number: 27 (DW_TAG_array_type) <21a> DW_AT_type : <0x10e> <21e> DW_AT_data_location: 2 byte block: 97 6 (DW_OP_push_object_address; DW_OP_deref) <2><221>: Abbrev Number: 28 (DW_TAG_subrange_type) <222> DW_AT_upper_bound : <0x154> <2><226>: Abbrev Number: 0 (for pointers replace the DW_TAG_reference_type with a DW_TAG_pointer_type). This is, to my knowledge, allowed and corret DWARF but posed a problem in GDB. Usually, GDB would deal with gcc references (or pointers) that look like <2><96>: Abbrev Number: 8 (DW_TAG_variable) <97> DW_AT_location : 2 byte block: 91 50 (DW_OP_fbreg: -48) <9a> DW_AT_name : (indirect string, offset: 0x2aa): vlaref <9e> DW_AT_decl_file : 3 <9f> DW_AT_decl_line : 41 DW_AT_type : <0x1de> ... <1><1de>: Abbrev Number: 17 (DW_TAG_reference_type) <1df> DW_AT_type : <0x1e3> <1><1e3>: Abbrev Number: 22 (DW_TAG_array_type) <1e4> DW_AT_type : <0x1bf> <2><1e8>: Abbrev Number: 23 (DW_TAG_subrange_type) <1e9> DW_AT_type : <0x1f2> <1ed> DW_AT_count : <0x8a> <2><1f1>: Abbrev Number: 0 The DWARF above describes a reference with an address. At the address of this reference, so evaluating what lies at the DW_AT_location of the DW_TAG_variable, we find the address we need to use to resolve the array under the reference and print the array's values. This is also exactly what GDB does per default when printing a reference-to-array type. It evaluates the reference, and then takes that address to resolve the array (implicitly assuming that the value of the reference coincides with the address of the array). The difference to the icc output is icc's usage of DW_AT_data_location. This attribute can be used to specify a location for the actual data of an array that is different from the object's address. If it is present in addition to a DW_AT_location (as is the case above) the array values are actually located at whatever DW_AT_data_location is evaluated to and not at the address DW_AT_location of the variable points to. When dealing with the icc output this posed a problem in GDB. It would still evaluate the reference. It would then forget all about the reference and use the address obtained that way to resolve the array type (which, as mentioned, works fine with the gcc output). It would then discover the DW_AT_data_location attribute in the array's DIE and it would try to resolve it. Here is where GDB ran into a problem: according to DWARF5 and as seen in this example as well, DW_AT_data_location usually starts with a DW_OP_push_object_address. This operation pushes the address of the object currently being evaluated on the stack. The object currently being evaluated however in this case is the reference, not the array. But as GDB already evaluated the reference and as it would only know about the array's address anymore it would use that address in order to resolve the DW_AT_data_location. This failed and GDB could not print any references emitted that way, as it would usually try to access illegal memory addresses. GDB would usually display (gdb) print vlaref $1 = (int (&)[3]) (in rare cases the memory address might even be valid and GDB would print random output for the array. The problem is the exact same when dealing with pointers emitted by the Intel classic compilers. For resolving this problem, we make GDB check whether the pointer's underlying type shows a DW_AT_data_location, and, if so, we assume that, in order to resolve the type, not the value of the pointer (so the value at DW_AT_location of the pointer) but the address of the pointer (so the acutal value of DW_AT_location) is be required. This patch implements the the fix for references and pointers. With this patch the above example prints as (gdb) print vlaref $1 = (int (&)[3]) @0x7fffffffc4e0: {5, 7, 9} --- gdb/gdbtypes.c | 24 ++++++++++++++++++++++++ gdb/valprint.c | 18 ++++++++++++++++-- 2 files changed, 40 insertions(+), 2 deletions(-) diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index a4d79a64e95..ce48b968f4b 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -2809,6 +2809,18 @@ resolve_dynamic_pointer (struct type *type, if (addr_stack->valaddr.data () != NULL) pinfo.addr = extract_typed_address (addr_stack->valaddr.data (), type); + else if (TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type)) != nullptr) + { + /* If the underlying type has a DW_AT_data_location attribute + we assume that we need to take the reference's address (the + value of its DW_AT_location) to resolve the type instead + of the reference's value (the dereferenced DW_AT_location). + This is because DW_AT_data_location usually uses + DW_OP_push_obj_address which pushes the address of the + currently observed object on the stack. Here, this is the + reference itself and not its underlying type. */ + pinfo.addr = addr_stack->addr; + } else pinfo.addr = read_memory_typed_address (addr_stack->addr, type); pinfo.next = addr_stack; @@ -2874,6 +2886,18 @@ resolve_dynamic_type_internal (struct type *type, if (addr_stack->valaddr.data () != NULL) pinfo.addr = extract_typed_address (addr_stack->valaddr.data (), type); + else if (TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type)) != nullptr) + { + /* If the underlying type has a DW_AT_data_location attribute + we assume that we need to take the reference's address (the + value of its DW_AT_location) to resolve the type instead + of the reference's value (the dereferenced DW_AT_location). + This is because DW_AT_data_location usually uses + DW_OP_push_obj_address which pushes the address of the + currently observed object on the stack. Here, this is the + reference itself and not its underlying type. */ + pinfo.addr = addr_stack->addr; + } else pinfo.addr = read_memory_typed_address (addr_stack->addr, type); pinfo.next = addr_stack; diff --git a/gdb/valprint.c b/gdb/valprint.c index 0c3066602fe..7fee691cae0 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -565,8 +565,22 @@ generic_val_print_ref (struct type *type, gdb_assert (embedded_offset == 0); } else - deref_val = value_at (TYPE_TARGET_TYPE (type), - unpack_pointer (type, valaddr + embedded_offset)); + { + /* If the underlying type has a DW_AT_data_location attribute we need + to take the reference's address (so the value of its DW_AT_location) + to resolve the type instead of the references value (the + dereferenced DW_AT_location). This is because + DW_AT_data_location uses DW_OP_push_obj_address which pushes the + address of the currently observed object on the stack, which is the + reference itself here and not its underlying type. */ + if (TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type)) != nullptr) + deref_val = value_at (TYPE_TARGET_TYPE (type), + value_address (original_value)); + else + deref_val = value_at (TYPE_TARGET_TYPE (type), + unpack_pointer (type, + valaddr + embedded_offset)); + } } /* Else, original_value isn't a synthetic reference or we don't have to print the reference's contents. From patchwork Tue Sep 20 07:26:29 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "Kempke, Nils-Christian" X-Patchwork-Id: 57784 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C07233857C6F for ; Tue, 20 Sep 2022 07:27:25 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C07233857C6F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=sourceware.org; s=default; t=1663658845; bh=ZzFO2RqIOusDZrYZ58n6aB8sMYyQcePW778iG+s10WA=; h=To:Subject:Date:In-Reply-To:References:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To:Cc: From; b=vIoiXkNsPZS1tSNz6gL6uI+Fl1D1Zb4aAlvsRy/C9NOPaJGU0vO+aEnmh7wbfae4v ZcQsL8pCv2sh5SpVDV8lmyw1H4tQFQqPIO7foSViwUYx1YoAhVHKXGgmZBZKXZhTOh 4uwgr/gU+RaJ//pzT532oNdEHiqy5ckrKMs4DNOI= X-Original-To: gdb-patches@sourceware.org Delivered-To: gdb-patches@sourceware.org Received: from mga12.intel.com (mga12.intel.com [192.55.52.136]) by sourceware.org (Postfix) with ESMTPS id 856D53858427 for ; Tue, 20 Sep 2022 07:26:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 856D53858427 X-IronPort-AV: E=McAfee;i="6500,9779,10475"; a="279348894" X-IronPort-AV: E=Sophos;i="5.93,329,1654585200"; d="scan'208";a="279348894" Received: from orsmga002.jf.intel.com ([10.7.209.21]) by fmsmga106.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 20 Sep 2022 00:26:53 -0700 X-IronPort-AV: E=Sophos;i="5.93,329,1654585200"; d="scan'208";a="618810781" Received: from labpcdell3650-003.iul.intel.com (HELO localhost) ([172.28.49.87]) by orsmga002-auth.jf.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 20 Sep 2022 00:26:52 -0700 To: gdb-patches@sourceware.org Subject: [PATCH 4/4] gdb/fortran: Fix sizeof intrinsic for Fortran Date: Tue, 20 Sep 2022 09:26:29 +0200 Message-Id: <20220920072629.2736207-5-nils-christian.kempke@intel.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220920072629.2736207-1-nils-christian.kempke@intel.com> References: <20220920072629.2736207-1-nils-christian.kempke@intel.com> MIME-Version: 1.0 X-Spam-Status: No, score=-10.3 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.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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-Patchwork-Original-From: Nils-Christian Kempke via Gdb-patches From: "Kempke, Nils-Christian" Reply-To: Nils-Christian Kempke Cc: tom@tromey.com Errors-To: gdb-patches-bounces+patchwork=sourceware.org@sourceware.org Sender: "Gdb-patches" The sizeof operator in Fortran behaves differently from e.g. C/Cpp in that it can be applied to pointers. We thus dereference pointers before evaluating their size. A test has been added for the Fortran sizeof operator. --- gdb/eval.c | 3 + gdb/testsuite/gdb.fortran/sizeof.exp | 110 +++++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/sizeof.f90 | 108 ++++++++++++++++++++++++++ 3 files changed, 221 insertions(+) create mode 100644 gdb/testsuite/gdb.fortran/sizeof.exp create mode 100644 gdb/testsuite/gdb.fortran/sizeof.f90 diff --git a/gdb/eval.c b/gdb/eval.c index ce1d883aa86..bb6b757d452 100644 --- a/gdb/eval.c +++ b/gdb/eval.c @@ -2730,6 +2730,9 @@ evaluate_subexp_for_sizeof_base (struct expression *exp, struct type *type) if (exp->language_defn->la_language == language_cplus && (TYPE_IS_REFERENCE (type))) type = check_typedef (TYPE_TARGET_TYPE (type)); + else if (exp->language_defn->la_language == language_fortran + && type->code () == TYPE_CODE_PTR) + type = check_typedef (TYPE_TARGET_TYPE (type)); return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type)); } diff --git a/gdb/testsuite/gdb.fortran/sizeof.exp b/gdb/testsuite/gdb.fortran/sizeof.exp new file mode 100644 index 00000000000..f353e8c4dd9 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/sizeof.exp @@ -0,0 +1,110 @@ +# 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 . + +# Testing GDB's implementation of SIZE keyword. + +if {[skip_fortran_tests]} { return -1 } + +standard_testfile ".f90" +load_lib fortran.exp + +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90}]} { + return -1 +} + +if ![fortran_runto_main] { + return -1 +} + +gdb_breakpoint [gdb_get_line_number "Test breakpoint"] +gdb_breakpoint [gdb_get_line_number "Past unassigned pointers"] +gdb_breakpoint [gdb_get_line_number "Final breakpoint"] + +set done_unassigned 0 +set found_final_breakpoint 0 +set test_count 0 +while { $test_count < 200 } { + with_test_prefix "test $test_count" { + incr test_count + + gdb_test_multiple "continue" "continue" { + -re -wrap "! Test breakpoint" { + # We can run a test from here. + } + -re -wrap "! Past unassigned pointers" { + # Done with testing unassigned pointers. + set done_unassigned 1 + continue + } + -re -wrap "! Final breakpoint" { + # We're done with the tests. + set found_final_breakpoint 1 + } + } + + if ($found_final_breakpoint) { + break + } + + # First grab the expected answer. + set answer [get_valueof "" "answer" "**unknown**"] + + # Now move up a frame and figure out a command for us to run + # as a test. + set command "" + gdb_test_multiple "up" "up" { + -re -wrap "\r\n\[0-9\]+\[ \t\]+call test_sizeof \\((\[^\r\n\]+)\\)" { + set command $expect_out(1,string) + } + } + + gdb_assert { ![string equal $command ""] } "found a command to run" + + set is_pointer_to_array [string match "sizeof (*a_p)*" $command] + + if {$done_unassigned || !$is_pointer_to_array} { + gdb_test "p $command" " = $answer" + } else { + # Gfortran, ifx and ifort have slightly differnt behavior for + # unassigned pointers to arrays. While ifx and ifort will print 0 + # as the sizeof result, gfortran will print the size of the base + # type of the pointer/array. Since the default behavior in GDB was + # to print 0 we keep this and make an exception for gfortran here. + gdb_test_multiple "p $command" "p $command" { + -re -wrap " = $answer" { + pass $gdb_test_name + } + -re -wrap " = 0" { + pass $gdb_test_name + } + } + } + } +} + +gdb_assert {$found_final_breakpoint} "ran all compiled in tests" + +# Here some more GDB specific tests that might fail with compilers. +# GDB will print sizeof(1.4) = 8 while gfortran will probably print 4 but +# GDB says ptype 1.4 is real*8 so the output is expected. + +gdb_test "ptype 1" "type = int" +gdb_test "p sizeof(1)" "= 4" + +gdb_test "ptype 1.3" "type = real\\*8" +gdb_test "p sizeof(1.3)" "= 8" + +gdb_test "p sizeof ('asdsasd')" "= 7" diff --git a/gdb/testsuite/gdb.fortran/sizeof.f90 b/gdb/testsuite/gdb.fortran/sizeof.f90 new file mode 100644 index 00000000000..60107e958e8 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/sizeof.f90 @@ -0,0 +1,108 @@ +! 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 . + +module data + use, intrinsic :: iso_c_binding, only : C_SIZE_T + implicit none + + character, target :: char_v + character (len=3), target :: char_a + integer, target :: int_v + integer, target, dimension(:,:) :: int_2da (3,2) + real*4, target :: real_v + real*4, target :: real_a(4) + real*4, target, dimension (:), allocatable :: real_a_alloc + + character, pointer :: char_v_p + character (len=3), pointer :: char_a_p + integer, pointer :: int_v_p + integer, pointer, dimension (:,:) :: int_2da_p + real*4, pointer :: real_v_p + real*4, pointer, dimension(:) :: real_a_p + real*4, dimension(:), pointer :: real_alloc_a_p + +contains +subroutine test_sizeof (answer) + integer(C_SIZE_T) :: answer + + print *, answer ! Test breakpoint +end subroutine test_sizeof + +subroutine run_tests () + call test_sizeof (sizeof (char_v)) + call test_sizeof (sizeof (char_a)) + call test_sizeof (sizeof (int_v)) + call test_sizeof (sizeof (int_2da)) + call test_sizeof (sizeof (real_v)) + call test_sizeof (sizeof (real_a)) + call test_sizeof (sizeof (real_a_alloc)) + + call test_sizeof (sizeof (char_v_p)) + call test_sizeof (sizeof (char_a_p)) + call test_sizeof (sizeof (int_v_p)) + call test_sizeof (sizeof (int_2da_p)) + call test_sizeof (sizeof (real_v_p)) + call test_sizeof (sizeof (real_a_p)) + call test_sizeof (sizeof (real_alloc_a_p)) +end subroutine run_tests + +end module data + +program sizeof_tests + use iso_c_binding + use data + + implicit none + + allocate (real_a_alloc(5)) + + nullify (char_v_p) + nullify (char_a_p) + nullify (int_v_p) + nullify (int_2da_p) + nullify (real_v_p) + nullify (real_a_p) + nullify (real_alloc_a_p) + + ! Test nullified + call run_tests () + + char_v_p => char_v ! Past unassigned pointers + char_a_p => char_a + int_v_p => int_v + int_2da_p => int_2da + real_v_p => real_v + real_a_p => real_a + real_alloc_a_p => real_a_alloc + + ! Test pointer assignment + call run_tests () + + char_v = 'a' + char_a = "aaa" + int_v = 10 + int_2da = reshape((/1, 2, 3, 4, 5, 6/), shape(int_2da)) + real_v = 123.123 + real_a_p = (/-1.1, -1.2, -1.3, -1.4/) + real_a_alloc = (/1.1, 2.2, 3.3, 4.4, 5.5/) + + ! After allocate/value assignment + call run_tests () + + deallocate (real_a_alloc) + + print *, "done" ! Final breakpoint + +end program sizeof_tests