From patchwork Fri Oct 25 14:37:46 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Abdul Basit Ijaz X-Patchwork-Id: 99582 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 57F093858C48 for ; Fri, 25 Oct 2024 14:38:46 +0000 (GMT) X-Original-To: gdb-patches@sourceware.org Delivered-To: gdb-patches@sourceware.org Received: from mgamail.intel.com (mgamail.intel.com [198.175.65.19]) by sourceware.org (Postfix) with ESMTPS id 5E1A13858CDA for ; Fri, 25 Oct 2024 14:38:15 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 5E1A13858CDA 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 5E1A13858CDA Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=198.175.65.19 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1729867099; cv=none; b=diKwWlHIzn3N/B9kM8am/A6ddImf3p3SzsU0J+WSmBJPDUOeCrDjMgfONdKjBmYeQuqH6btuxGOo+93UG7v5OdEOMEWLCcaNFhxNb6U4oMOvfTS5M0sOhukY9Rho2uFqtYq6KC4n5Vu6CG/KKY7wtbROUVv8Ca7aos2TW70WjvM= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1729867099; c=relaxed/simple; bh=1TTgIa+Y7awdMPJ/rCYIKE2+hxf+hHz5mEN0N4q9fw8=; h=DKIM-Signature:From:To:Subject:Date:Message-Id:MIME-Version; b=lFEv689pUOb64PM/iyx9iF6lByo8F4zYVgycT5KmbPCe94kMn239Y82uOabE2iYrEQ/u9HmeHt+XwOTXCLNLdy92MGeYpXAn/+Iom17gYAbaFhAJBYG/+qUROdhPuLT9TNsPGThj32kAtcVYdcMs6EUDb0N4yu3rW5R7E9fzxtk= 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=1729867095; x=1761403095; h=from:to:cc:subject:date:message-id:in-reply-to: references:mime-version:content-transfer-encoding; bh=1TTgIa+Y7awdMPJ/rCYIKE2+hxf+hHz5mEN0N4q9fw8=; b=EVf2a5blZsRCYIf+tncr0EX3oSHReXDlzQ8zFseU9eC30rqlFfR7H5eS Ubsk202/oqIT0B6z7mXwPCewjT0YV5xIDzVS5vcqmPHHASnTj1NuK6Yqz tUnizn7F/ND1uyycXpNqrgiSf8GE8p+ZrMwOWtgP/jCfO8l+tSiTPeLWQ jEKfLspN1+2+3Tr44qgP5QwYuVa0uetsX7XvMOhNsm7oe9YpHx0iTjpB1 xoo4BjZSc58gPMxXExjXUZces81don6GNj8vdytYpnDglWFh0bpkSOxhH q7jogKYahmeuJKYX+Kb42LzGSd2qM012zhRDoIciyptNh3TY4NPHV9OBh Q==; X-CSE-ConnectionGUID: xYkOUfCkRNa3Yx5Ayg+o0g== X-CSE-MsgGUID: Tp6wMLcHRiGfBixi4R/tjA== X-IronPort-AV: E=McAfee;i="6700,10204,11222"; a="29402469" X-IronPort-AV: E=Sophos;i="6.11,199,1725346800"; d="scan'208";a="29402469" Received: from fmviesa008.fm.intel.com ([10.60.135.148]) by orvoesa111.jf.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 25 Oct 2024 07:38:14 -0700 X-CSE-ConnectionGUID: GgLpnQPeSFC6dPVuRIC8bQ== X-CSE-MsgGUID: uTB56zWjRJ+qyEz7uV0Vng== X-ExtLoop1: 1 X-IronPort-AV: E=Sophos;i="6.11,232,1725346800"; d="scan'208";a="81040313" Received: from abijaz-mobl2.ger.corp.intel.com (HELO localhost) ([10.245.130.219]) by fmviesa008-auth.fm.intel.com with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 25 Oct 2024 07:38:12 -0700 From: Abdul Basit Ijaz To: gdb-patches@sourceware.org Cc: abdul.b.ijaz@intel.com, tom@tromey.com, aburgess@redhat.com Subject: [PATCH v8 1/1] fortran: Fix arrays of variable length strings for FORTRAN Date: Fri, 25 Oct 2024 16:37:46 +0200 Message-Id: <20241025143746.1974-2-abdul.b.ijaz@intel.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20241025143746.1974-1-abdul.b.ijaz@intel.com> References: <20241025143746.1974-1-abdul.b.ijaz@intel.com> MIME-Version: 1.0 X-Spam-Status: No, score=-10.9 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 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" Before this change resolve_dynamic_array_or_string was called for all TYPE_CODE_ARRAY and TYPE_CODE_STRING types, but, in the end, this function always called create_array_type_with_stride, which creates a TYPE_CODE_ARRAY type. Suppose we have subroutine vla_array (arr1, arr2) character (len=*):: arr1 (:) character (len=5):: arr2 (:) print *, arr1 ! break-here print *, arr2 end subroutine vla_array The "print arr1" and "print arr2" command at the "break-here" line gives the following output: (gdb) print arr1 $1 = (gdb) print arr2 $2 = ('abcde', 'abcde', 'abcde') (gdb) ptype arr1 type = Type End Type (gdb) ptype arr2 type = character*5 (3) Dwarf info using Intel® Fortran Compiler for such case contains following: <1>: Abbrev Number: 12 (DW_TAG_string_type) DW_AT_name : (indirect string, offset: 0xd2): .str.ARR1 <102> DW_AT_string_length: 3 byte block: 97 23 8 (DW_OP_push_object_address; DW_OP_plus_uconst: 8) After this change resolve_dynamic_array_or_string now calls create_array_type_with_stride or create_string_type, so if the incoming dynamic type is a TYPE_CODE_STRING then we'll get back a TYPE_CODE_STRING type. Now gdb shows following: (gdb) p arr1 $1 = ('abddefghij', 'abddefghij', 'abddefghij', 'abddefghij', 'abddefghij') (gdb) p arr2 $2 = ('abcde', 'abcde', 'abcde') (gdb) ptype arr1 type = character*10 (5) (gdb) ptype arr2 type = character*5 (3) In case of GFortran, compiler emits DW_TAG_structure_type for string type arguments of the subroutine and it has only DW_AT_declaration tag. This results in in gdb. So, following issue is raised in gcc bugzilla "https://gcc.gnu.org/bugzilla/show_bug.cgi?id=101826". Fixing above issue introduce regression in gdb.fortran/mixed-lang-stack.exp, i.e. the test forces the language to C/C++ and print a Fortran string value. The string value is a dynamic type with code TYPE_CODE_STRING. Before this commit the dynamic type resolution would always convert this to a TYPE_CODE_ARRAY of characters, which the C value printing could handle. But now after this commit we get a TYPE_CODE_STRING, which neither the C value printing, or the generic value printing code can support. And so, I've added support for TYPE_CODE_STRING to the generic value printing, all characters of strings are printed together till the first null character. Lastly, in gdb.opt/fortran-string.exp and gdb.fortran/string-types.exp tests it expects type of character array in 'character (3)' format but now after this change we get 'character*3', so tests are updated accordingly. --- gdb/gdbtypes.c | 39 +++++++++++- gdb/testsuite/gdb.fortran/string-types.exp | 4 +- gdb/testsuite/gdb.fortran/vla-array.exp | 60 ++++++++++++++++++ gdb/testsuite/gdb.fortran/vla-array.f90 | 45 +++++++++++++ gdb/testsuite/gdb.opt/fortran-string.exp | 2 +- gdb/valprint.c | 74 ++++++++++++++++++++++ 6 files changed, 219 insertions(+), 5 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/vla-array.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-array.f90 diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 323f15ddaa2..2a3aea229cb 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -2327,10 +2327,42 @@ resolve_dynamic_array_or_string_1 (struct type *type, frame, rank - 1, resolve_p); } + else if (ary_dim != nullptr && ary_dim->code () == TYPE_CODE_STRING) + { + /* The following special case for TYPE_CODE_STRING should not be + needed, ideally we would defer resolving the dynamic type of the + array elements until needed later, and indeed, the resolved type + of each array element might be different, so attempting to resolve + the type here makes no sense. + + However, in Fortran, for arrays of strings, each element must be + the same type, as such, the DWARF for the string length relies on + the object address of the array itself. + + The problem here is that, when we create values from the dynamic + array type, we resolve the data location, and use that as the + value address, this completely discards the original value + address, and it is this original value address that is the + descriptor for the dynamic array, the very address that the DWARF + needs us to push in order to resolve the dynamic string length. + + What this means then, is that, given the current state of GDB, if + we don't resolve the string length now, then we will have lost + access to the address of the dynamic object descriptor, and so we + will not be able to resolve the dynamic string later. + + For now then, we handle special case TYPE_CODE_STRING on behalf of + Fortran, and hope that this doesn't cause problems for anyone + else. */ + elt_type = resolve_dynamic_type_internal (type->target_type (), + addr_stack, frame, 0); + } else elt_type = type->target_type (); prop = type->dyn_prop (DYN_PROP_BYTE_STRIDE); + if (prop != nullptr && type->code () == TYPE_CODE_STRING) + prop = nullptr; if (prop != NULL && resolve_p) { if (dwarf2_evaluate_property (prop, frame, addr_stack, &value)) @@ -2351,8 +2383,11 @@ resolve_dynamic_array_or_string_1 (struct type *type, bit_stride = type->field (0).bitsize (); type_allocator alloc (type, type_allocator::SMASH); - return create_array_type_with_stride (alloc, elt_type, range_type, NULL, - bit_stride); + if (type->code () == TYPE_CODE_STRING) + return create_string_type (alloc, elt_type, range_type); + else + return create_array_type_with_stride (alloc, elt_type, range_type, NULL, + bit_stride); } /* Resolve an array or string type with dynamic properties, return a new diff --git a/gdb/testsuite/gdb.fortran/string-types.exp b/gdb/testsuite/gdb.fortran/string-types.exp index 102eaa9688d..35b8654b1f3 100644 --- a/gdb/testsuite/gdb.fortran/string-types.exp +++ b/gdb/testsuite/gdb.fortran/string-types.exp @@ -52,7 +52,7 @@ with_test_prefix "third breakpoint, first time" { # Continue to the third breakpoint. gdb_continue_to_breakpoint "continue" gdb_test "print s" " = 'foo'" - gdb_test "ptype s" "type = character \\(3\\)" + gdb_test "ptype s" "type = character\\*3" } with_test_prefix "third breakpoint, second time" { @@ -65,5 +65,5 @@ with_test_prefix "third breakpoint, second time" { # by most users, so seems good enough. gdb_continue_to_breakpoint "continue" gdb_test "print s" " = 'foo\\\\n\\\\t\\\\r\\\\000bar'" - gdb_test "ptype s" "type = character \\(10\\)" + gdb_test "ptype s" "type = character\\*10" } diff --git a/gdb/testsuite/gdb.fortran/vla-array.exp b/gdb/testsuite/gdb.fortran/vla-array.exp new file mode 100644 index 00000000000..4ed2de79280 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-array.exp @@ -0,0 +1,60 @@ +# 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 ".f90" +load_lib "fortran.exp" + +require allow_fortran_tests + +if {[prepare_for_testing "failed to prepare" ${testfile} ${srcfile} \ + {debug f90 quiet}]} { + return -1 +} + +if ![fortran_runto_main] { + untested "could not run to main" + return -1 +} + +# Try to access vla string / vla string array / string array values. +gdb_breakpoint [gdb_get_line_number "arr_vla1-print"] +gdb_continue_to_breakpoint "arr_vla1-print" + +# GFortran emits DW_TAG_structure_type for strings and it has only +# DW_AT_declaration tag. This results in in gdb. +if [test_compiler_info "gfortran*" f90] { setup_xfail *-*-* gcc/101826 } +gdb_test "print arr_vla1" \ + " = \\\('vlaaryvlaary', 'vlaaryvlaary', 'vlaaryvlaary', 'vlaaryvlaary', 'vlaaryvlaary'\\\)" \ + "print vla string array" + +if [test_compiler_info "gfortran*" f90] { setup_xfail *-*-* gcc/101826 } +gdb_test "ptype arr_vla1" \ + "type = character\\*12 \\(5\\)" \ + "print variable length string array type" +gdb_test "print arr_vla2" \ + " = 'vlaary'" \ + "print variable length string" +gdb_test "ptype arr_vla2" \ + "type = character\\*6" \ + "print variable length string type" +gdb_test "print arr2" \ + " = \\\('vlaaryvla', 'vlaaryvla', 'vlaaryvla'\\\)" \ + "print string array" +gdb_test "ptype arr2" \ + "type = character\\*9 \\(3\\)" \ + "print string array type" +gdb_test "print rank(arr_vla1)" \ + "$decimal" \ + "print string array rank" diff --git a/gdb/testsuite/gdb.fortran/vla-array.f90 b/gdb/testsuite/gdb.fortran/vla-array.f90 new file mode 100644 index 00000000000..56dd85b1551 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-array.f90 @@ -0,0 +1,45 @@ +! 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 . + +subroutine vla_array_func (arr_vla1, arr_vla2, arr2) + character (len=*):: arr_vla1 (:) + character (len=*):: arr_vla2 + character (len=9):: arr2 (:) + + print *, arr_vla1 ! arr_vla1-print + print *, arr_vla2 + print *, arr2 + print *, rank(arr_vla1) +end subroutine vla_array_func + +program vla_array_main +interface + subroutine vla_array_func (arr_vla1, arr_vla2, arr2) + character (len=*):: arr_vla1 (:) + character (len=*):: arr_vla2 + character (len=9):: arr2 (:) + end subroutine vla_array_func +end interface + character (len=9) :: arr1 (3) + character (len=6) :: arr2 + character (len=12) :: arr3 (5) + + arr1 = 'vlaaryvla' + arr2 = 'vlaary' + arr3 = 'vlaaryvlaary' + + call vla_array_func (arr3, arr2, arr1) + +end program vla_array_main diff --git a/gdb/testsuite/gdb.opt/fortran-string.exp b/gdb/testsuite/gdb.opt/fortran-string.exp index 9122ed1097a..87f42d80774 100644 --- a/gdb/testsuite/gdb.opt/fortran-string.exp +++ b/gdb/testsuite/gdb.opt/fortran-string.exp @@ -33,5 +33,5 @@ if {![runto f]} { gdb_test_no_output "set print frame-arguments all" gdb_test "frame" ".*s='foo'.*" -gdb_test "ptype s" "type = character \\(3\\)" +gdb_test "ptype s" "type = character\\*3" gdb_test "p s" "\\$\[0-9\]* = 'foo'" diff --git a/gdb/valprint.c b/gdb/valprint.c index db8affeb47a..ce1ac753aa4 100644 --- a/gdb/valprint.c +++ b/gdb/valprint.c @@ -500,6 +500,76 @@ generic_val_print_array (struct value *val, } +/* generic_val_print helper for TYPE_CODE_STRING. */ + +static void +generic_val_print_string (struct value *val, + struct ui_file *stream, int recurse, + const struct value_print_options *options, + const struct generic_val_print_decorations + *decorations) +{ + struct type *type = check_typedef (val->type ()); + struct type *unresolved_elttype = type->target_type (); + struct type *elttype = check_typedef (unresolved_elttype); + + if (type->length () > 0 && unresolved_elttype->length () > 0) + { + LONGEST low_bound, high_bound; + + if (!get_array_bounds (type, &low_bound, &high_bound)) + error (_("Could not determine the array high bound")); + + const gdb_byte *valaddr = val->contents_for_printing ().data (); + int force_ellipses = 0; + enum bfd_endian byte_order = type_byte_order (type); + int eltlen, len; + + eltlen = elttype->length (); + len = high_bound - low_bound + 1; + + /* If requested, look for the first null char and only + print elements up to it. */ + if (options->stop_print_at_null) + { + unsigned int print_max_chars = get_print_max_chars (options); + unsigned int temp_len; + + for (temp_len = 0; + (temp_len < len + && temp_len < print_max_chars + && extract_unsigned_integer (valaddr + temp_len * eltlen, + eltlen, byte_order) != 0); + ++temp_len) + ; + + /* Force printstr to print ellipses if + we've printed the maximum characters and + the next character is not \000. */ + if (temp_len == print_max_chars && temp_len < len) + { + ULONGEST ival + = extract_unsigned_integer (valaddr + temp_len * eltlen, + eltlen, byte_order); + if (ival != 0) + force_ellipses = 1; + } + + len = temp_len; + } + + current_language->printstr (stream, unresolved_elttype, valaddr, len, + nullptr, force_ellipses, options); + } + else + { + /* Array of unspecified length: treat like pointer to first elt. */ + print_unpacked_pointer (type, elttype, val->address (), + stream, options); + } + +} + /* generic_value_print helper for TYPE_CODE_PTR. */ static void @@ -930,6 +1000,10 @@ generic_value_print (struct value *val, struct ui_file *stream, int recurse, generic_val_print_array (val, stream, recurse, options, decorations); break; + case TYPE_CODE_STRING: + generic_val_print_string (val, stream, recurse, options, decorations); + break; + case TYPE_CODE_MEMBERPTR: generic_value_print_memberptr (val, stream, recurse, options, decorations);