[PATCH 1/1] gdb: Fix arrays of variable length strings for FORTRAN

["abdul.b.ijaz via Gdb-patches" <gdb-patches@sourceware.org>]

GDB is not able to print arrays of FORTRAN variable length strings
when dwarf info contains DW_AT_string_length only regarding the string
length information.  So handing of dynamic array is updated to handle
such cases.

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 = (<error reading variable>
(gdb) print arr2
$2 = ('abcde', 'abcde', 'abcde')
(gdb) ptype arr1
type = character*(*) (5)
(gdb) ptype arr2
type = character*5 (3)

So GDB is able to print the array of string with static length but for
variable length it fail to do so.  For this case now improve handling of
the TYPE_CODE_STRING code in dynamic array length resolving function to set
the static length of strings as well when only DW_AT_string_length is given
in the dwarf info.

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 fixing it and compiling using Intel® Fortran Compiler 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)

gdb/ChangeLog:
2021-08-20  Abdul Basit Ijaz  <abdul.b.ijaz@intel.com>

	* gdbtypes.c (resolve_dynamic_array_or_string): Improve handling
	of TYPE_CODE_STRING code to use return value of create_string_type
	outcome for this case.
	* c-valprint.c (c_value_print_inner): Handle String type code
	in the same way as the Array type code.

gdb/testsuite/ChangeLog:
2021-08-20  Abdul Basit Ijaz  <abdul.b.ijaz@intel.com>

	* gdb.fortran/vla-array.f90: New fie.
	* gdb.fortran/vla-array.exp: New fie.

2021-08-20 Abdul Basit Ijaz <abdul.b.ijaz@intel.com>
---
 gdb/c-valprint.c                        |  1 +
 gdb/gdbtypes.c                          | 12 ++++--
 gdb/testsuite/gdb.fortran/vla-array.exp | 57 +++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/vla-array.f90 | 44 +++++++++++++++++++
 4 files changed, 110 insertions(+), 4 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/c-valprint.c b/gdb/c-valprint.c
index 9c82869525f..e5a8e122676 100644
--- a/gdb/c-valprint.c
+++ b/gdb/c-valprint.c
@@ -426,6 +426,7 @@ c_value_print_inner (struct value *val, struct ui_file *stream, int recurse,
   switch (type->code ())
     {
     case TYPE_CODE_ARRAY:
+    case TYPE_CODE_STRING:
       c_value_print_array (val, stream, recurse, options);
       break;
 
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 74ad5d6f7fe..1444c5feb6c 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2312,8 +2312,9 @@ resolve_dynamic_array_or_string (struct type *type,
   range_type = resolve_dynamic_range (range_type, addr_stack, resolve_p);
 
   ary_dim = check_typedef (TYPE_TARGET_TYPE (type));
-  if (ary_dim != NULL && ary_dim->code () == TYPE_CODE_ARRAY)
-    elt_type = resolve_dynamic_array_or_string (ary_dim, addr_stack, resolve_p);
+  if (ary_dim != NULL && (ary_dim->code () == TYPE_CODE_ARRAY
+      || ary_dim->code () == TYPE_CODE_STRING))
+    elt_type = resolve_dynamic_array_or_string (ary_dim, addr_stack);
   else
     elt_type = TYPE_TARGET_TYPE (type);
 
@@ -2337,8 +2338,11 @@ resolve_dynamic_array_or_string (struct type *type,
   else
     bit_stride = TYPE_FIELD_BITSIZE (type, 0);
 
-  return create_array_type_with_stride (type, elt_type, range_type, NULL,
-					bit_stride);
+  if (type->code () == TYPE_CODE_STRING)
+    return create_string_type (type, elt_type, range_type);
+  else
+    return create_array_type_with_stride (type, elt_type, range_type, NULL,
+                                        bit_stride);
 }
 
 /* Resolve dynamic bounds of members of the union TYPE to static
diff --git a/gdb/testsuite/gdb.fortran/vla-array.exp b/gdb/testsuite/gdb.fortran/vla-array.exp
new file mode 100644
index 00000000000..a9223576bbd
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-array.exp
@@ -0,0 +1,57 @@
+# Copyright 2021 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"
+
+if {[skip_fortran_tests]} { return -1 }
+
+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 does not emit DW_TAG_string_type for array of variable length
+# string.
+if [test_compiler_info "gcc*"] { setup_xfail *-*-* gcc/101826 }
+gdb_test "print arr_vla1"  \
+    " = \\\('vlaaryvlaary', 'vlaaryvlaary', 'vlaaryvlaary', 'vlaaryvlaary', 'vlaaryvlaary'\\\)"  \
+    "print vla string array"
+
+if [test_compiler_info "gcc*"] { 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"
diff --git a/gdb/testsuite/gdb.fortran/vla-array.f90 b/gdb/testsuite/gdb.fortran/vla-array.f90
new file mode 100644
index 00000000000..612e84fe213
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-array.f90
@@ -0,0 +1,44 @@
+! Copyright 2021 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
+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
-- 
2.31.1