[PATCH] gdb/fortran: Handle dynamic string types when printing types

[Andrew Burgess <andrew.burgess@embecosm.com>]

After commit:

  commit 8c2e4e0689ea244d0ed979171a3d09c9176b8175
  Date:   Sun Jul 12 22:58:51 2020 -0400

      gdb: add accessors to struct dynamic_prop

An existing bug was exposed in the Fortran type printing code.  When
GDB is asked to print the type of a function that takes a dynamic
string argument GDB will try to read the upper bound of the string.

The read of the upper bound is written as:

    if (type->bounds ()->high.kind () == PROP_UNDEFINED)
      // Treat the upper bound as unknown.
    else
      // Treat the upper bound as known and constant.

However, this is not good enough.  When printing a function type the
dynamic argument types will not have been resolved.  As a result the
dynamic property is not PROP_UNDEFINED, but nor is it constant.

By rewriting this code to specifically check for the PROP_CONST case,
and treating all other cases as the upper bound being unknown we avoid
incorrectly treating the dynamic property as being constant.

gdb/ChangeLog:

	* f-typeprint.c (f_type_print_base): Allow for dynamic types not
	being resolved.

gdb/testsuite/ChangeLog:

	* gdb.fortran/ptype-on-functions.exp: Add more tests.
	* gdb.fortran/ptype-on-functions.f90: Likewise.
---
 gdb/ChangeLog                                 |  5 ++++
 gdb/f-typeprint.c                             | 12 ++++++----
 gdb/testsuite/ChangeLog                       |  5 ++++
 .../gdb.fortran/ptype-on-functions.exp        |  6 +++++
 .../gdb.fortran/ptype-on-functions.f90        | 23 +++++++++++++++++++
 5 files changed, 47 insertions(+), 4 deletions(-)

diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 80dbfe11167..65ec93af9f4 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -406,16 +406,20 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
       break;
 
     case TYPE_CODE_STRING:
-      /* Strings may have dynamic upperbounds (lengths) like arrays.  */
+      /* Strings may have dynamic upperbounds (lengths) like arrays.  We
+	 check specifically for the PROP_CONST case to indicate that the
+	 dynamic type has been resolved.  If we arrive here having been
+	 asked to print the type of a value with a dynamic type then the
+	 bounds will not have been resolved.  */
 
-      if (type->bounds ()->high.kind () == PROP_UNDEFINED)
-	fprintfi_filtered (level, stream, "character*(*)");
-      else
+      if (type->bounds ()->high.kind () == PROP_CONST)
 	{
 	  LONGEST upper_bound = f77_get_upperbound (type);
 
 	  fprintf_filtered (stream, "character*%s", pulongest (upper_bound));
 	}
+      else
+	fprintfi_filtered (level, stream, "character*(*)");
       break;
 
     case TYPE_CODE_STRUCT:
diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
index 8dc5f76d93a..dde6f48b853 100644
--- a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
@@ -43,3 +43,9 @@ gdb_test "ptype say_numbers" \
 
 gdb_test "ptype fun_ptr" \
     "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\) \\(REF TO -> \\( integer\\(kind=4\\) \\)\\) \\)"
+
+gdb_test "ptype say_string" \
+    "type = void \\(character\\*\\(\\*\\), integer\\(kind=8\\)\\)"
+
+gdb_test "ptype say_array" \
+    "type = void \\(integer\\(kind=4\\) \\(:,:\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.f90 b/gdb/testsuite/gdb.fortran/ptype-on-functions.f90
index a43dd3820d8..adf79e32591 100644
--- a/gdb/testsuite/gdb.fortran/ptype-on-functions.f90
+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.f90
@@ -63,6 +63,10 @@ program test
      integer function fun2 (x)
        integer :: x
      end function fun2
+
+     subroutine say_array (arr)
+       integer, dimension (:,:) :: arr
+     end subroutine say_array
   end interface
 
   type (Number) :: n1
@@ -70,7 +74,12 @@ program test
 
   procedure(fun1), pointer:: fun_ptr => NULL()
 
+  integer, dimension (5,5) :: array
+  array = 0
+
   call say_numbers (1,2,3)	! stop here
+  call say_string ('hello world')
+  call say_array (array (2:3, 2:4))
   print *, fun_ptr (3)
 
 end program test
@@ -87,3 +96,17 @@ integer function fun2 (x)
   fun2 = x + 2
 end function fun2
 
+subroutine say_string (str)
+  character(len=*) :: str
+  print *, str
+end subroutine say_string
+
+subroutine say_array (arr)
+  integer, dimension (:,:) :: arr
+  do i=LBOUND (arr, 2), UBOUND (arr, 2), 1
+     do j=LBOUND (arr, 1), UBOUND (arr, 1), 1
+        write(*, fmt="(i4)", advance="no") arr (j, i)
+     end do
+     print *, ""
+  end do
+end subroutine say_array
-- 
2.25.4