From: "Ijaz, Abdul B" <abdul.b.ijaz@intel.com>
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 = <incomplete type>
(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><fd>: Abbrev Number: 12 (DW_TAG_string_type)
<fe> 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 <incomplete type> 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
@@ -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
@@ -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"
}
new file mode 100644
@@ -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 <http://www.gnu.org/licenses/>.
+
+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 <incomplete type> 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"
new file mode 100644
@@ -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 <http://www.gnu.org/licenses/>.
+
+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
@@ -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'"
@@ -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);