From patchwork Thu Jan 4 12:35:20 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: 83305 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 95CB6385DC07 for ; Thu, 4 Jan 2024 12:36:47 +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.115]) by sourceware.org (Postfix) with ESMTPS id 0C224385DC07 for ; Thu, 4 Jan 2024 12:36:06 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 0C224385DC07 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 0C224385DC07 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=192.55.52.115 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704371769; cv=none; b=P5DMYB2Xn0lQT6qjxPFIIeWnOFMO801nKB4sb8lpJivO5OKejmmPuFJr1B4bGAJdHTTfYlUc6TL9BLk9X8J2CFxUiHQJ/N0rUdhfKxvzu/nNqAiefjruo5x0ZYoj8lraDgHilnaDDdWEO7chSTf8IiZzUoOowCz8ROjFaxHxZ1I= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704371769; c=relaxed/simple; bh=hxmLhNvwG6zDpr9CSujpYIslXVn2y6PNcdH3VJLuYco=; h=DKIM-Signature:From:To:Subject:Date:Message-Id:MIME-Version; b=IK0v9BtME5u3nnKrRE8r5hATyAIzJyASQn8T1EjH7owVK33RE0IAg6ilZgDp5na+NncMkwcgO+3QzA2Nzu3lU8xvozPWd114f2X24yXwT4zlDhXXZXS/57EbsuNbKMoPuN1EEHjpm7SvYwx56+YdTyGcOK1UvQAa3HlCRKJ9ero= 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=1704371767; x=1735907767; h=from:to:cc:subject:date:message-id:in-reply-to: references:mime-version:content-transfer-encoding; bh=hxmLhNvwG6zDpr9CSujpYIslXVn2y6PNcdH3VJLuYco=; b=e6sIf916epmoBEd1E4Qg40UB7X274ix8JhkVtgEiATFtOWspxn2fsrFg +nWCl5fPg8rixxmXZqq+OD+DkPmnoRVMoKZtKBeOy9Eqf8raIjyF1ga4S ZTTbfKAGAn3GEO70REWyTqy+JOOIMr3jIYNg2GqYYrC2n00i/Did1lSfB 87G1PEj6+u+eKNi2MWQUpclo3K25BR+TJpgZYipDkv7zBHc9Gfma+eejg ZM4KGEV3FbTmuaBydil3tz5l8Wop5Nqvtt0zR8ofH/DlI6dkZdNBVjxeM 4d8JycELDIv9Vw5F/sinBsjMLrhKD12HG5mJ4iRrMoGVuVMtIIImfNhX6 Q==; X-IronPort-AV: E=McAfee;i="6600,9927,10942"; a="396956161" X-IronPort-AV: E=Sophos;i="6.04,330,1695711600"; d="scan'208";a="396956161" Received: from fmviesa001.fm.intel.com ([10.60.135.141]) by fmsmga103.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 04 Jan 2024 04:36:05 -0800 X-ExtLoop1: 1 X-IronPort-AV: E=Sophos;i="6.04,330,1695711600"; d="scan'208";a="22476218" Received: from abijaz-mobl2.ger.corp.intel.com (HELO localhost) ([10.246.48.20]) by smtpauth.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 04 Jan 2024 04:36:04 -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 v4 3/3] gdb, testsuite, fortran: Fix sizeof intrinsic for Fortran pointers Date: Thu, 4 Jan 2024 13:35:20 +0100 Message-Id: <20240104123520.7706-4-abdul.b.ijaz@intel.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240104123520.7706-1-abdul.b.ijaz@intel.com> References: <20240104123520.7706-1-abdul.b.ijaz@intel.com> MIME-Version: 1.0 X-Spam-Status: No, score=-11.6 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 e075cc3138d..b7c6aa8ed69 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