From 3fb842cea15503ed101c2d5adb77068206d3d684 Mon Sep 17 00:00:00 2001 From: Andrew Burgess Date: Thu, 7 Apr 2022 14:46:18 +0100 Subject: [PATCH] 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. --- 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) -- 2.30.2