From patchwork Mon Jan 15 13:16:52 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Abdul Basit Ijaz X-Patchwork-Id: 84117 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 11CD33858281 for ; Mon, 15 Jan 2024 13:17:49 +0000 (GMT) X-Original-To: gdb-patches@sourceware.org Delivered-To: gdb-patches@sourceware.org Received: from mgamail.intel.com (mgamail.intel.com [192.55.52.43]) by sourceware.org (Postfix) with ESMTPS id 7B9F8385843E for ; Mon, 15 Jan 2024 13:17:13 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 7B9F8385843E Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=intel.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=intel.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 7B9F8385843E Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=192.55.52.43 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1705324637; cv=none; b=lDvNlzPar+2/81t4sK2tSHbiurHIEPyDWg8jxf1vN2Yz7inJEDWRDwVa9+qEFS2Dq7kH+ufbv7YUo4l8HcwAsaPBY6KM+o/YdQpVM/RKaXKhABNYo1BlZPxG56IiHVXsRLwmZqXNJs+jAQ4S0+ymOeEFfeYrRHe+God5J53+eRY= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1705324637; c=relaxed/simple; bh=NVGXWJXJFX4qfwl4HSBGFTS4lODxkGjI48H2s5taM3E=; h=DKIM-Signature:From:To:Subject:Date:Message-Id:MIME-Version; b=cUEoz0gVMz4oKGPwhMhHSbToV8RX/5dDXUottqV+r0Xn/a8iP572aZtrWNw2QO29gSPx7P3zAMX32oFYI5cYtwGHOUMTHhiD/e5BV24sjiwWbJgZOyUNlVbkS/cktVTehAKJMTfd/CzzShVW2UBkpMX8kQnqaxEj0++QnptuOc8= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=intel.com; i=@intel.com; q=dns/txt; s=Intel; t=1705324633; x=1736860633; h=from:to:cc:subject:date:message-id:in-reply-to: references:mime-version:content-transfer-encoding; bh=NVGXWJXJFX4qfwl4HSBGFTS4lODxkGjI48H2s5taM3E=; b=dChcXIFrusGXJup8ll4wQb0WPywsupoivPvmfbEo+Q+LXAmIOe6aJKqC Fif0vBWk/zgeiTPrWOcEOP2BiCPuUkZPUtuae/pUCK1VmCkkknrAW2gJE hiqL7ia3G+NsNzHkIk+LY1aM0uyVp8WWlpiZqknLW3E7iyUlhlvPi6JpV aSnPC6e2R1OZhnbIb7etdDunY5dE1awdFrY8psTf+ktQ2hP/SDZ0pfMzP i1KwhIzKrvSiQP6d9FBLxWJn23BOCQK43q7FaoU84srMv1ofFY+9zHIu9 e/mrso5y88n/nRG3tBBBmISVpADzRMzRM38JsuFaHqM+Y0Y/If3cp8aGe Q==; X-IronPort-AV: E=McAfee;i="6600,9927,10953"; a="485773956" X-IronPort-AV: E=Sophos;i="6.04,196,1695711600"; d="scan'208";a="485773956" Received: from fmviesa002.fm.intel.com ([10.60.135.142]) by fmsmga105.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 15 Jan 2024 05:17:12 -0800 X-ExtLoop1: 1 X-IronPort-AV: E=Sophos;i="6.04,196,1695711600"; d="scan'208";a="18138935" Received: from abijaz-mobl2.ger.corp.intel.com (HELO localhost) ([10.94.253.153]) by fmviesa002-auth.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 15 Jan 2024 05:17:10 -0800 From: Abdul Basit Ijaz To: gdb-patches@sourceware.org Cc: abdul.b.ijaz@intel.com, thiago.bauermann@linaro.org, tom@tromey.com, simark@simark.ca Subject: [PATCH v5 1/3] gdb/testsuite: Fix indentation issues in gdb.dwarf2/dynarr-ptr.exp Date: Mon, 15 Jan 2024 14:16:52 +0100 Message-Id: <20240115131654.19374-2-abdul.b.ijaz@intel.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240115131654.19374-1-abdul.b.ijaz@intel.com> References: <20240115131654.19374-1-abdul.b.ijaz@intel.com> MIME-Version: 1.0 X-Spam-Status: No, score=-11.1 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, SPF_HELO_NONE, SPF_NONE, TXREP, T_SCC_BODY_TEXT_LINE 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.30 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gdb-patches-bounces+patchwork=sourceware.org@sourceware.org From: "Ijaz, Abdul B" --- gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp | 136 ++++++++++++------------ 1 file changed, 68 insertions(+), 68 deletions(-) diff --git a/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp b/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp index d4a496c82f0..232f4e273ad 100644 --- a/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp +++ b/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp @@ -133,219 +133,219 @@ gdb_test_no_output "set language ada" # foo.three_ptr.all gdb_test "print foo.three_ptr.all" \ - " = \\(1, 2, 3\\)" + " = \\(1, 2, 3\\)" gdb_test "print foo.three_ptr.all(1)" \ - " = 1" + " = 1" gdb_test "print foo.three_ptr.all(2)" \ - " = 2" + " = 2" gdb_test "print foo.three_ptr.all(3)" \ - " = 3" + " = 3" gdb_test "print foo.three_ptr.all'first" \ - " = 1" + " = 1" gdb_test "print foo.three_ptr.all'last" \ - " = 3" + " = 3" gdb_test "print foo.three_ptr.all'length" \ - " = 3" + " = 3" gdb_test "ptype foo.three_ptr.all" \ - " = array \\(<>\\) of integer" + " = array \\(<>\\) of integer" # foo.three_ptr gdb_test "print foo.three_ptr(1)" \ - " = 1" + " = 1" gdb_test "print foo.three_ptr(2)" \ - " = 2" + " = 2" gdb_test "print foo.three_ptr(3)" \ - " = 3" + " = 3" gdb_test "print foo.three_ptr'first" \ - " = 1" + " = 1" gdb_test "print foo.three_ptr'last" \ - " = 3" + " = 3" gdb_test "print foo.three_ptr'length" \ - " = 3" + " = 3" gdb_test "ptype foo.three_ptr" \ - " = access array \\(<>\\) of integer" + " = access array \\(<>\\) of integer" # foo.three_ptr_tdef.all gdb_test "print foo.three_ptr_tdef.all" \ - " = \\(1, 2, 3\\)" + " = \\(1, 2, 3\\)" gdb_test "print foo.three_ptr_tdef.all(1)" \ - " = 1" + " = 1" gdb_test "print foo.three_ptr_tdef.all(2)" \ - " = 2" + " = 2" gdb_test "print foo.three_ptr_tdef.all(3)" \ - " = 3" + " = 3" gdb_test "print foo.three_ptr_tdef.all'first" \ - " = 1" + " = 1" gdb_test "print foo.three_ptr_tdef.all'last" \ - " = 3" + " = 3" gdb_test "print foo.three_ptr_tdef.all'length" \ - " = 3" + " = 3" gdb_test "ptype foo.three_ptr_tdef.all" \ - " = array \\(<>\\) of integer" + " = array \\(<>\\) of integer" # foo.three_ptr_tdef gdb_test "print foo.three_ptr_tdef(1)" \ - " = 1" + " = 1" gdb_test "print foo.three_ptr_tdef(2)" \ - " = 2" + " = 2" gdb_test "print foo.three_ptr_tdef(3)" \ - " = 3" + " = 3" gdb_test "print foo.three_ptr_tdef'first" \ - " = 1" + " = 1" gdb_test "print foo.three_ptr_tdef'last" \ - " = 3" + " = 3" gdb_test "print foo.three_ptr_tdef'length" \ - " = 3" + " = 3" gdb_test "ptype foo.three_ptr_tdef" \ - " = access array \\(<>\\) of integer" + " = access array \\(<>\\) of integer" # foo.five_ptr.all gdb_test "print foo.five_ptr.all" \ - " = \\(2 => 5, 8, 13, 21, 34\\)" + " = \\(2 => 5, 8, 13, 21, 34\\)" gdb_test "print foo.five_ptr.all(2)" \ - " = 5" + " = 5" gdb_test "print foo.five_ptr.all(3)" \ - " = 8" + " = 8" gdb_test "print foo.five_ptr.all(4)" \ - " = 13" + " = 13" gdb_test "print foo.five_ptr.all(5)" \ - " = 21" + " = 21" gdb_test "print foo.five_ptr.all(6)" \ - " = 34" + " = 34" gdb_test "print foo.five_ptr.all'first" \ - " = 2" + " = 2" gdb_test "print foo.five_ptr.all'last" \ - " = 6" + " = 6" gdb_test "print foo.five_ptr.all'length" \ - " = 5" + " = 5" gdb_test "ptype foo.five_ptr.all" \ - " = array \\(<>\\) of integer" + " = array \\(<>\\) of integer" # foo.five_ptr gdb_test "print foo.five_ptr(2)" \ - " = 5" + " = 5" gdb_test "print foo.five_ptr(3)" \ - " = 8" + " = 8" gdb_test "print foo.five_ptr(4)" \ - " = 13" + " = 13" gdb_test "print foo.five_ptr(5)" \ - " = 21" + " = 21" gdb_test "print foo.five_ptr(6)" \ - " = 34" + " = 34" gdb_test "print foo.five_ptr'first" \ - " = 2" + " = 2" gdb_test "print foo.five_ptr'last" \ - " = 6" + " = 6" gdb_test "print foo.five_ptr'length" \ - " = 5" + " = 5" gdb_test "ptype foo.five_ptr" \ - " = access array \\(<>\\) of integer" + " = access array \\(<>\\) of integer" # foo.five_ptr_tdef.all gdb_test "print foo.five_ptr_tdef.all" \ - " = \\(2 => 5, 8, 13, 21, 34\\)" + " = \\(2 => 5, 8, 13, 21, 34\\)" gdb_test "print foo.five_ptr_tdef.all(2)" \ - " = 5" + " = 5" gdb_test "print foo.five_ptr_tdef.all(3)" \ - " = 8" + " = 8" gdb_test "print foo.five_ptr_tdef.all(4)" \ - " = 13" + " = 13" gdb_test "print foo.five_ptr_tdef.all(5)" \ - " = 21" + " = 21" gdb_test "print foo.five_ptr_tdef.all(6)" \ - " = 34" + " = 34" gdb_test "print foo.five_ptr_tdef.all'first" \ - " = 2" + " = 2" gdb_test "print foo.five_ptr_tdef.all'last" \ - " = 6" + " = 6" gdb_test "print foo.five_ptr_tdef.all'length" \ - " = 5" + " = 5" gdb_test "ptype foo.five_ptr_tdef.all" \ - " = array \\(<>\\) of integer" + " = array \\(<>\\) of integer" # foo.five_ptr_tdef gdb_test "print foo.five_ptr_tdef(2)" \ - " = 5" + " = 5" gdb_test "print foo.five_ptr_tdef(3)" \ - " = 8" + " = 8" gdb_test "print foo.five_ptr_tdef(4)" \ - " = 13" + " = 13" gdb_test "print foo.five_ptr_tdef(5)" \ - " = 21" + " = 21" gdb_test "print foo.five_ptr_tdef(6)" \ - " = 34" + " = 34" gdb_test "print foo.five_ptr_tdef'first" \ - " = 2" + " = 2" gdb_test "print foo.five_ptr_tdef'last" \ - " = 6" + " = 6" gdb_test "print foo.five_ptr_tdef'length" \ - " = 5" + " = 5" gdb_test "ptype foo.five_ptr_tdef" \ - " = access array \\(<>\\) of integer" + " = access array \\(<>\\) of integer" From patchwork Mon Jan 15 13:16:53 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Abdul Basit Ijaz X-Patchwork-Id: 84118 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 588DB3858C20 for ; Mon, 15 Jan 2024 13:18:27 +0000 (GMT) X-Original-To: gdb-patches@sourceware.org Delivered-To: gdb-patches@sourceware.org Received: from mgamail.intel.com (mgamail.intel.com [192.55.52.43]) by sourceware.org (Postfix) with ESMTPS id E935F3858298 for ; Mon, 15 Jan 2024 13:17:19 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org E935F3858298 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=intel.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=intel.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org E935F3858298 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=192.55.52.43 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1705324642; cv=none; b=G6Ay34SQldQsG6iBphwtdwtjDIXikjjHasDt2NgsdUhNaRRhxF1Nyi73QVkcRqOtzxQG7s/ANKK1X8gNcaUbQa7HOWe8PKF3FuT31SC4TWa2Gps6llPxpG7dO/oGbBnCVwvVdgUBrqYjt/yIBK2ZiNSet6bCmypkQmY/TAnWgPE= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1705324642; c=relaxed/simple; bh=aaSZ3WzH9Pc3Lf0BseR7fOvUtFRo5J4t5plRdfCBmqY=; h=DKIM-Signature:From:To:Subject:Date:Message-Id:MIME-Version; b=hY+qnSSCoCXXZ9q8VsqlUaYMfv6nT+lgDeZFa+Q2QPF2u7HtQXSyWfin3ALbKX33d6HtuD/OCLCQrd+HoZd65E0u1KuPTwYS3vvFShix0ojAVOvS5edcHyZaNzL54nfdd9EXpi85rjHStg0+4abG6utIXppgJBrYDoN9hV5Tt6s= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=intel.com; i=@intel.com; q=dns/txt; s=Intel; t=1705324639; x=1736860639; h=from:to:cc:subject:date:message-id:in-reply-to: references:mime-version:content-transfer-encoding; bh=aaSZ3WzH9Pc3Lf0BseR7fOvUtFRo5J4t5plRdfCBmqY=; b=Nn2KyaFDmtGT5bLd27i9I+cYbMWZBOf0fNrJv4bIwcU7/c0Rfv+AjnB7 sHgLlHRY0OJMcNuUorTNYh9IqFEjrZezrK3zck2G4jEYRO9tNRhRVeM+g oDicl2qQ7Up0MJfUL8pPUlwW+b+oMcY2D8nJCUkLcenHWH3uMZmW5oLCa bi+psYgp/vkaHtX/qGEqRLkJh3uY+RLHzTReGvs6YhFTnUrxw+g2ZEQip HwZM4dda8LXpGN2ak0qTL2Ku9eI97UJdwxo7ZC2t/w5oHvElqE+1isJ7n LXOQNUfVrEYDp/aw5D06NgtetBBjHowVNyueQ5TNeKFaN8vapU3OCNRbe g==; X-IronPort-AV: E=McAfee;i="6600,9927,10953"; a="485773977" X-IronPort-AV: E=Sophos;i="6.04,196,1695711600"; d="scan'208";a="485773977" Received: from fmviesa002.fm.intel.com ([10.60.135.142]) by fmsmga105.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 15 Jan 2024 05:17:19 -0800 X-ExtLoop1: 1 X-IronPort-AV: E=Sophos;i="6.04,196,1695711600"; d="scan'208";a="18138958" Received: from abijaz-mobl2.ger.corp.intel.com (HELO localhost) ([10.94.253.153]) by fmviesa002-auth.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 15 Jan 2024 05:17:18 -0800 From: Abdul Basit Ijaz To: gdb-patches@sourceware.org Cc: abdul.b.ijaz@intel.com, thiago.bauermann@linaro.org, tom@tromey.com, simark@simark.ca, Bernhard Heckel Subject: [PATCH v5 2/3] gdb, types: Resolve pointer types dynamically Date: Mon, 15 Jan 2024 14:16:53 +0100 Message-Id: <20240115131654.19374-3-abdul.b.ijaz@intel.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240115131654.19374-1-abdul.b.ijaz@intel.com> References: <20240115131654.19374-1-abdul.b.ijaz@intel.com> MIME-Version: 1.0 X-Spam-Status: No, score=-11.1 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_NONE, SPF_NONE, TXREP, T_SCC_BODY_TEXT_LINE 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.30 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gdb-patches-bounces+patchwork=sourceware.org@sourceware.org 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. Also this commit removes the redundant code inside function "value_check_printable" for handling of DW_AT_associated type. The pointer resolution follows the one of references. This change 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. Tested-by: Thiago Jung Bauermann --- gdb/gdbtypes.c | 7 +- 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 | 115 ++++++++++++++++++ gdb/testsuite/gdb.fortran/pointers.f90 | 29 +++++ gdb/valprint.c | 6 - 8 files changed, 177 insertions(+), 17 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 1dc68a99104..213b9dc0654 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -2042,8 +2042,9 @@ 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->is_pointer_or_reference ()) type = check_typedef (type->target_type ()); /* Types that have a dynamic TYPE_DATA_LOCATION are considered @@ -2779,6 +2780,8 @@ resolve_dynamic_type_internal (struct type *type, switch (type->code ()) { case TYPE_CODE_REF: + case TYPE_CODE_PTR: + case TYPE_CODE_RVALUE_REF: { struct property_addr_info pinfo; diff --git a/gdb/testsuite/gdb.cp/vla-cxx.cc b/gdb/testsuite/gdb.cp/vla-cxx.cc index 6fc888515ad..7603b4bd1fb 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 6e307ef816e..0033a968268 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 \\(\\*\\)\\\[3\\\]" \ + "ptype ptr, before pointer assignment" + +gdb_test "print ptr" "= \\(int \\(\\*\\)\\\[3\\\]\\) 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 232f4e273ad..3b7fb72a927 100644 --- a/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp +++ b/gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp @@ -154,7 +154,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 @@ -177,7 +177,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 @@ -203,7 +203,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 @@ -226,7 +226,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 @@ -258,7 +258,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 @@ -287,7 +287,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 @@ -319,7 +319,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 @@ -348,4 +348,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 da1be8bbcec..dfff5196f8a 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..dafea392799 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/pointers.exp @@ -0,0 +1,115 @@ +# Copyright 2024 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" +gdb_test "print intap" " = " "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" "= " + +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 " \ + "Print program counter" diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90 index cc4c3be9b04..2b55c6a1f09 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 7a2065f7d2e..7b3ffc884f1 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -1156,12 +1156,6 @@ value_check_printable (struct value *val, struct ui_file *stream, return 0; } - if (type_not_associated (val->type ())) - { - val_print_not_associated (stream); - return 0; - } - if (type_not_allocated (val->type ())) { val_print_not_allocated (stream); From patchwork Mon Jan 15 13:16:54 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Abdul Basit Ijaz X-Patchwork-Id: 84119 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 B7A943858292 for ; Mon, 15 Jan 2024 13:18:28 +0000 (GMT) X-Original-To: gdb-patches@sourceware.org Delivered-To: gdb-patches@sourceware.org Received: from mgamail.intel.com (mgamail.intel.com [192.55.52.43]) by sourceware.org (Postfix) with ESMTPS id 4A9D73858C50 for ; Mon, 15 Jan 2024 13:17:27 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 4A9D73858C50 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=intel.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=intel.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 4A9D73858C50 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=192.55.52.43 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1705324652; cv=none; b=raBkcWwXpHUUOsMWux3ezVE0YkfIRp2iLORaP49q2PMADWDGKjboGjk6M8Q4Qax+5CDIL7DuqtBLpvXgoTD9KLPKvSOaFYTcQNWPV18lwd0/E2V3+5VSTGnPoE6uidywh/m7UUW+06u4iXf/eTJt4LRqSTbLW8qgWoJQXSdnFiM= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1705324652; c=relaxed/simple; bh=D3jYE76uxLb49wgdhJEAcMK62s/Fwzz1OfKPH3JV3r4=; h=DKIM-Signature:From:To:Subject:Date:Message-Id:MIME-Version; b=PPP9LI4+rNvr6vljZ7Dcq5uKmebX/ElAlo6RAtTfD14enyTsNjZt4suoSddeXCqqjfydXggSGnWgrlzJ+n9qLCTDjNU381i287DjSRS54WJsnQwJACHI6cXYaSUXbMYywjR1CdUBFZ0zCatL4JWOKYLwzzMntLZHtZnkENotBH0= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=intel.com; i=@intel.com; q=dns/txt; s=Intel; t=1705324647; x=1736860647; h=from:to:cc:subject:date:message-id:in-reply-to: references:mime-version:content-transfer-encoding; bh=D3jYE76uxLb49wgdhJEAcMK62s/Fwzz1OfKPH3JV3r4=; b=WL8Hy73g6OlxzWSHcjwMoS+BsA3aJwQXl/hqdixbE2NtkrolsNnVYJqe RdoLecxg76by+rt5W943OS7Q9PSGi+6/TVU/yMnt+SyX+5ViJ51vrSRvk b28bv3jDOXjdZIVk8RmmIIC/9BRbeUG1N4FRFuUt1L5MAs19GK3pCMKu3 ZzDVn4x8Pr46kJy13wukQZzhG5snSAydnM6HbVpfBi5dMrsdM9WtVUOgr m68Z6uN/BJQ6Zvw0d7RZQcSIvFTMBEXInHz8snteJZi1HdLUIeARedRbf vg5lhiXk10hh2ci5Cl1p1cXbF2JSp+BMLbSG2YmPGKt4FN0xvWwSwcuF/ w==; X-IronPort-AV: E=McAfee;i="6600,9927,10953"; a="485774000" X-IronPort-AV: E=Sophos;i="6.04,196,1695711600"; d="scan'208";a="485774000" Received: from fmviesa002.fm.intel.com ([10.60.135.142]) by fmsmga105.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 15 Jan 2024 05:17:26 -0800 X-ExtLoop1: 1 X-IronPort-AV: E=Sophos;i="6.04,196,1695711600"; d="scan'208";a="18138976" Received: from abijaz-mobl2.ger.corp.intel.com (HELO localhost) ([10.94.253.153]) by fmviesa002-auth.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 15 Jan 2024 05:17:25 -0800 From: Abdul Basit Ijaz To: gdb-patches@sourceware.org Cc: abdul.b.ijaz@intel.com, thiago.bauermann@linaro.org, tom@tromey.com, simark@simark.ca, Nils-Christian Kempke Subject: [PATCH v5 3/3] gdb, testsuite, fortran: Fix sizeof intrinsic for Fortran pointers Date: Mon, 15 Jan 2024 14:16:54 +0100 Message-Id: <20240115131654.19374-4-abdul.b.ijaz@intel.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240115131654.19374-1-abdul.b.ijaz@intel.com> References: <20240115131654.19374-1-abdul.b.ijaz@intel.com> MIME-Version: 1.0 X-Spam-Status: No, score=-11.1 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_NONE, SPF_NONE, TXREP, T_SCC_BODY_TEXT_LINE 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.30 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gdb-patches-bounces+patchwork=sourceware.org@sourceware.org From: Nils-Christian Kempke For Fortran pointers gfortran/ifx emits DW_TAG_pointer_types like <2><17d>: Abbrev Number: 22 (DW_TAG_variable) <180> DW_AT_name : (indirect string, offset: 0x1f1): fptr <184> DW_AT_type : <0x214> ... <1><219>: Abbrev Number: 27 (DW_TAG_array_type) <21a> DW_AT_type : <0x10e> <216> DW_AT_associated : ... The 'pointer property' in Fortran is implicitly modeled by adding a DW_AT_associated to the type of the variable (see also the DW_AT_associated description in DWARF 5). A Fortran pointer is more than an address and thus different from a C pointer. It is a self contained type having additional fields such as, e.g., the rank of its underlying array. This motivates the intended DWARF modeling of Fortran pointers via the DW_AT_associated attribute. This patch adds support for the sizeof intrinsic by simply dereferencing pointer types when encountered during a sizeof evaluation. The patch also adds a test for the sizeof intrinsic which was not tested before. Tested-by: Thiago Jung Bauermann --- gdb/eval.c | 7 ++ gdb/testsuite/gdb.fortran/sizeof.exp | 115 +++++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/sizeof.f90 | 108 +++++++++++++++++++++++++ 3 files changed, 230 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 495effe2d03..1a1c46a1c72 100644 --- a/gdb/eval.c +++ b/gdb/eval.c @@ -2706,6 +2706,13 @@ 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 ()); + else if (exp->language_defn->la_language == language_fortran + && type->code () == TYPE_CODE_PTR) + { + /* Dereference Fortran pointer types to allow them for the Fortran + sizeof intrinsic. */ + type = check_typedef (type->target_type ()); + } return value_from_longest (size_type, (LONGEST) type->length ()); } diff --git a/gdb/testsuite/gdb.fortran/sizeof.exp b/gdb/testsuite/gdb.fortran/sizeof.exp new file mode 100644 index 00000000000..be59a37f1a6 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/sizeof.exp @@ -0,0 +1,115 @@ +# Copyright 2024 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. + +require allow_fortran_tests + +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 + +# We are running tests defined in the executable here. So, in the .exp file +# we do not know when the 'Final breakpoint' will be hit exactly. We place a +# limit on the number of tests that can be run, just in case something goes +# wrong, and GDB gets stuck in an loop here. +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 and ifx have slightly different behavior for unassigned + # pointers to arrays. While ifx will print 0 as the sizeof result, + # gfortran will print the size of the base type of the pointer or + # 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..b8490a1cdb1 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/sizeof.f90 @@ -0,0 +1,108 @@ +! Copyright 2024 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