[binutils-gdb] gdb/fortran: fix fetching assumed rank array content

[binutils-gdb] gdb/fortran: fix fetching assumed rank array content

[Andrew Burgess]

https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=3fb842cea15503ed101c2d5adb77068206d3d684

commit 3fb842cea15503ed101c2d5adb77068206d3d684
Author: Andrew Burgess <aburgess@redhat.com>
Date:   Thu Apr 7 14:46:18 2022 +0100

    gdb/fortran: fix fetching assumed rank array content
    
    Commit:
    
      commit df7a7bdd9766adebc6b117c31bc617d81c1efd43
      Date:   Thu Mar 17 18:56:23 2022 +0000
    
          gdb: add support for Fortran's ASSUMED RANK arrays
    
    Added support for Fortran assumed rank arrays.  Unfortunately, this
    commit contained a bug that means though GDB can correctly calculate
    the rank of an assumed rank array, GDB can't fetch the contents of an
    assumed rank array.
    
    The history of this patch can be seen on the mailing list here:
    
      https://sourceware.org/pipermail/gdb-patches/2022-January/185306.html
    
    The patches that were finally committed can be found here:
    
      https://sourceware.org/pipermail/gdb-patches/2022-March/186906.html
    
    The original patches did support fetching the array contents, it was
    only the later series that introduced the regression.
    
    The problem is that when calculating the array rank the result is a
    count of the number of ranks, i.e. this is a 1 based result, 1, 2, 3,
    etc.
    
    In contrast, when computing the details of any particular rank the
    value passed to the DWARF expression evaluator should be a 0 based
    rank offset, i.e. a 0 based number, 0, 1, 2, etc.
    
    In the patches that were originally merged, this was not the case, and
    we were passing the 1 based rank number to the expression evaluator,
    e.g. passing 1 when we should pass 0, 2 when we should pass 1, etc.
    As a result the DWARF expression evaluator was reading the
    wrong (undefined) memory, and returning garbage results.
    
    In this commit I have extended the test case to cover checking the
    array contents, I've then ensured we make use of the correct rank
    value, and extended some comments, and added or adjusted some asserts
    as appropriate.

Diff:
---
 gdb/gdbtypes.c                            | 38 +++++++++++++++++++++----------
 gdb/testsuite/gdb.fortran/assumedrank.exp | 29 ++++++++++++++---------
 gdb/testsuite/gdb.fortran/assumedrank.f90 |  5 ++++
 3 files changed, 49 insertions(+), 23 deletions(-)

diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 26232787da3..49ecb199b07 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2194,7 +2194,11 @@ static struct type *resolve_dynamic_type_internal
    and stride information set to undefined.  The RESOLVE_P set to false
    case will be used when evaluating a dynamic array that is not
    allocated, or not associated, i.e. the bounds information might not be
-   initialized yet.  */
+   initialized yet.
+
+   RANK is the array rank for which we are resolving this range, and is a
+   zero based count.  The rank should never be negative.
+*/
 
 static struct type *
 resolve_dynamic_range (struct type *dyn_range_type,
@@ -2206,6 +2210,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
   struct dynamic_prop low_bound, high_bound, stride;
 
   gdb_assert (dyn_range_type->code () == TYPE_CODE_RANGE);
+  gdb_assert (rank >= 0);
 
   const struct dynamic_prop *prop = &dyn_range_type->bounds ()->low;
   if (resolve_p && dwarf2_evaluate_property (prop, NULL, addr_stack, &value,
@@ -2263,11 +2268,11 @@ resolve_dynamic_range (struct type *dyn_range_type,
 
 /* Helper function for resolve_dynamic_array_or_string.  This function
    resolves the properties for a single array at RANK within a nested array
-   of arrays structure.  The RANK value is always greater than 0, and
+   of arrays structure.  The RANK value is greater than or equal to 0, and
    starts at it's maximum value and goes down by 1 for each recursive call
    to this function.  So, for a 3-dimensional array, the first call to this
-   function has RANK == 3, then we call ourselves recursively with RANK ==
-   2, than again with RANK == 1, and at that point we should return.
+   function has RANK == 2, then we call ourselves recursively with RANK ==
+   1, than again with RANK == 0, and at that point we should return.
 
    TYPE is updated as the dynamic properties are resolved, and so, should
    be a copy of the dynamic type, rather than the original dynamic type
@@ -2297,9 +2302,9 @@ resolve_dynamic_array_or_string_1 (struct type *type,
   gdb_assert (type->code () == TYPE_CODE_ARRAY
 	      || type->code () == TYPE_CODE_STRING);
 
-  /* The outer resolve_dynamic_array_or_string should ensure we always have
-     a rank of at least 1 when we get here.  */
-  gdb_assert (rank > 0);
+  /* As the rank is a zero based count we expect this to never be
+     negative.  */
+  gdb_assert (rank >= 0);
 
   /* Resolve the allocated and associated properties before doing anything
      else.  If an array is not allocated or not associated then (at least
@@ -2435,6 +2440,14 @@ resolve_dynamic_array_or_string (struct type *type,
 	++rank;
     }
 
+  /* The rank that we calculated above is actually a count of the number of
+     ranks.  However, when we resolve the type of each individual array
+     rank we should actually use a rank "offset", e.g. an array with a rank
+     count of 1 (calculated above) will use the rank offset 0 in order to
+     resolve the details of the first array dimension.  As a result, we
+     reduce the rank by 1 here.  */
+  --rank;
+
   return resolve_dynamic_array_or_string_1 (type, addr_stack, rank, true);
 }
 
@@ -2823,11 +2836,12 @@ resolve_dynamic_type_internal (struct type *type,
 	  break;
 
 	case TYPE_CODE_RANGE:
-	  /* Pass 1 for the rank value here.  The assumption is that this
-	     rank value is not actually required for the resolution of the
-	     dynamic range, otherwise, we'd be resolving this range within
-	     the context of a dynamic array.  */
-	  resolved_type = resolve_dynamic_range (type, addr_stack, 1);
+	  /* Pass 0 for the rank value here, which indicates this is a
+	     range for the first rank of an array.  The assumption is that
+	     this rank value is not actually required for the resolution of
+	     the dynamic range, otherwise, we'd be resolving this range
+	     within the context of a dynamic array.  */
+	  resolved_type = resolve_dynamic_range (type, addr_stack, 0);
 	  break;
 
 	case TYPE_CODE_UNION:
diff --git a/gdb/testsuite/gdb.fortran/assumedrank.exp b/gdb/testsuite/gdb.fortran/assumedrank.exp
index ac5159cb90c..69cd168125f 100644
--- a/gdb/testsuite/gdb.fortran/assumedrank.exp
+++ b/gdb/testsuite/gdb.fortran/assumedrank.exp
@@ -62,21 +62,28 @@ while { $test_count < 500 } {
 	    break
 	}
 
-	# First grab the expected answer.
-	set answer [get_valueof "" "rank(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_rank (\[^\r\n\]+)" {
-		set command $expect_out(1,string)
+	# First grab the information from the assumed rank array.
+	set answer_rank [get_valueof "" "rank(answer)" "**unknown**"]
+	set answer_content [get_valueof "" "answer" "**unknown**"]
+
+	# Now move up a frame and find the name of a non-assumed rank array
+	# which we can use to check the values we got above.
+	set test_array ""
+	gdb_test_multiple "up" "" {
+	    -re -wrap "\r\n\[0-9\]+\[ \t\]+call test_rank \\((\[^\r\n\]+)\\)" {
+		set test_array $expect_out(1,string)
 	    }
 	}
+	gdb_assert { ![string equal $test_array ""] } \
+	    "found the name of a test array to check against"
 
-	gdb_assert { ![string equal $command ""] } "found a command to run"
+	# Check we got the correct array rank.
+	gdb_test "p rank($test_array)" " = $answer_rank"
 
-	gdb_test "p rank($command)" " = ($answer)"
+	# Check we got the correct array content.
+	set content [get_valueof "" "$test_array" "**unknown**"]
+	gdb_assert { [string equal $content $answer_content] } \
+	    "answer array contains the expected contents"
     }
 }
 
diff --git a/gdb/testsuite/gdb.fortran/assumedrank.f90 b/gdb/testsuite/gdb.fortran/assumedrank.f90
index 16f2ee718ca..7f077c3f014 100644
--- a/gdb/testsuite/gdb.fortran/assumedrank.f90
+++ b/gdb/testsuite/gdb.fortran/assumedrank.f90
@@ -24,6 +24,11 @@ PROGRAM  arank
   REAL :: array3(3, 4, 5)
   REAL :: array4(4, 5, 6, 7)
 
+  array1 = 1.0
+  array2 = 2.0
+  array3 = 3.0
+  array4 = 4.0
+
   call test_rank (array1)
   call test_rank (array2)
   call test_rank (array3)