diff options
-rw-r--r-- | gdb/f-array-walker.h | 39 | ||||
-rw-r--r-- | gdb/f-lang.c | 22 | ||||
-rw-r--r-- | gdb/f-lang.h | 6 | ||||
-rw-r--r-- | gdb/f-valprint.c | 39 | ||||
-rw-r--r-- | gdb/testsuite/gdb.fortran/array-indices.exp | 200 |
5 files changed, 279 insertions, 27 deletions
diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h index a929dcc..ad97dd5 100644 --- a/gdb/f-array-walker.h +++ b/gdb/f-array-walker.h @@ -115,12 +115,13 @@ struct fortran_array_walker_base_impl { return should_continue; } /* Called when GDB starts iterating over a dimension of the array. The - argument NELTS holds the number of the elements in the dimension and + argument INDEX_TYPE is the type of the index used to address elements + in the dimension, NELTS holds the number of the elements there, and INNER_P is true for the inner most dimension (the dimension containing the actual elements of the array), and false for more outer dimensions. For a concrete example of how this function is called see the comment on process_element below. */ - void start_dimension (LONGEST nelts, bool inner_p) + void start_dimension (struct type *index_type, LONGEST nelts, bool inner_p) { /* Nothing. */ } /* Called when GDB finishes iterating over a dimension of the array. The @@ -135,12 +136,14 @@ struct fortran_array_walker_base_impl /* Called when processing dimensions of the array other than the innermost one. WALK_1 is the walker to normally call, ELT_TYPE is the type of the element being extracted, and ELT_OFF is the offset - of the element from the start of array being walked, and LAST_P is - true only when this is the last element that will be processed in - this dimension. */ + of the element from the start of array being walked. INDEX is the + value of the index the current element is at in the upper dimension. + Finally LAST_P is true only when this is the last element that will + be processed in this dimension. */ void process_dimension (gdb::function_view<void (struct type *, int, bool)> walk_1, - struct type *elt_type, LONGEST elt_off, bool last_p) + struct type *elt_type, LONGEST elt_off, + LONGEST index, bool last_p) { walk_1 (elt_type, elt_off, last_p); } @@ -148,27 +151,29 @@ struct fortran_array_walker_base_impl /* Called when processing the inner most dimension of the array, for every element in the array. ELT_TYPE is the type of the element being extracted, and ELT_OFF is the offset of the element from the start of - array being walked, and LAST_P is true only when this is the last - element that will be processed in this dimension. + array being walked. INDEX is the value of the index the current + element is at in the upper dimension. Finally LAST_P is true only + when this is the last element that will be processed in this dimension. Given this two dimensional array ((1, 2) (3, 4) (5, 6)), the calls to start_dimension, process_element, and finish_dimension look like this: - start_dimension (3, false); - start_dimension (2, true); + start_dimension (INDEX_TYPE, 3, false); + start_dimension (INDEX_TYPE, 2, true); process_element (TYPE, OFFSET, false); process_element (TYPE, OFFSET, true); finish_dimension (true, false); - start_dimension (2, true); + start_dimension (INDEX_TYPE, 2, true); process_element (TYPE, OFFSET, false); process_element (TYPE, OFFSET, true); finish_dimension (true, true); - start_dimension (2, true); + start_dimension (INDEX_TYPE, 2, true); process_element (TYPE, OFFSET, false); process_element (TYPE, OFFSET, true); finish_dimension (true, true); finish_dimension (false, true); */ - void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) + void process_element (struct type *elt_type, LONGEST elt_off, + LONGEST index, bool last_p) { /* Nothing. */ } }; @@ -224,7 +229,9 @@ private: fortran_array_offset_calculator calc (type); m_nss++; - m_impl.start_dimension (upperbound - lowerbound + 1, + gdb_assert (range_type->code () == TYPE_CODE_RANGE); + m_impl.start_dimension (TYPE_TARGET_TYPE (range_type), + upperbound - lowerbound + 1, m_nss == m_ndimensions); if (m_nss != m_ndimensions) @@ -246,7 +253,7 @@ private: { this->walk_1 (w_type, w_offset, w_last_p); }, - subarray_type, new_offset, i == upperbound); + subarray_type, new_offset, i, i == upperbound); } } else @@ -267,7 +274,7 @@ private: elt_type = resolve_dynamic_type (elt_type, {}, e_address); } - m_impl.process_element (elt_type, elt_off, (i == upperbound)); + m_impl.process_element (elt_type, elt_off, i, i == upperbound); } } diff --git a/gdb/f-lang.c b/gdb/f-lang.c index d181f38..eaeda88 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -263,7 +263,7 @@ public: will be creating values for each element as we load them and then copy them into the M_DEST value. Set a value mark so we can free these temporary values. */ - void start_dimension (LONGEST nelts, bool inner_p) + void start_dimension (struct type *index_type, LONGEST nelts, bool inner_p) { if (inner_p) { @@ -330,7 +330,8 @@ public: /* Create a lazy value in target memory representing a single element, then load the element into GDB's memory and copy the contents into the destination value. */ - void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) + void process_element (struct type *elt_type, LONGEST elt_off, + LONGEST index, bool last_p) { copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off)); } @@ -368,7 +369,8 @@ public: /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF) from the content buffer of M_VAL then copy this extracted value into the repacked destination value. */ - void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) + void process_element (struct type *elt_type, LONGEST elt_off, + LONGEST index, bool last_p) { struct value *elt = value_from_component (m_val, elt_type, (elt_off + m_base_offset)); @@ -1533,6 +1535,20 @@ fortran_structop_operation::evaluate (struct type *expect_type, /* See language.h. */ void +f_language::print_array_index (struct type *index_type, LONGEST index, + struct ui_file *stream, + const value_print_options *options) const +{ + struct value *index_value = value_from_longest (index_type, index); + + fprintf_filtered (stream, "("); + value_print (index_value, stream, options); + fprintf_filtered (stream, ") = "); +} + +/* See language.h. */ + +void f_language::language_arch_info (struct gdbarch *gdbarch, struct language_arch_info *lai) const { diff --git a/gdb/f-lang.h b/gdb/f-lang.h index 26b2c09..11debd5 100644 --- a/gdb/f-lang.h +++ b/gdb/f-lang.h @@ -59,6 +59,12 @@ public: } /* See language.h. */ + void print_array_index (struct type *index_type, + LONGEST index, + struct ui_file *stream, + const value_print_options *options) const override; + + /* See language.h. */ void language_arch_info (struct gdbarch *gdbarch, struct language_arch_info *lai) const override; diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c index 4b1aaae..3d13eb1 100644 --- a/gdb/f-valprint.c +++ b/gdb/f-valprint.c @@ -101,6 +101,9 @@ f77_get_dynamic_length_of_aggregate (struct type *type) struct dimension_stats { + /* The type of the index used to address elements in the dimension. */ + struct type *index_type; + /* Total number of elements in the dimension, counted as we go. */ int nelts; }; @@ -147,7 +150,7 @@ public: /* Called when we start iterating over a dimension. If it's not the inner most dimension then print an opening '(' character. */ - void start_dimension (LONGEST nelts, bool inner_p) + void start_dimension (struct type *index_type, LONGEST nelts, bool inner_p) { size_t dim_indx = m_dimension++; @@ -155,6 +158,7 @@ public: if (m_stats.size () < m_dimension) { m_stats.resize (m_dimension); + m_stats[dim_indx].index_type = index_type; m_stats[dim_indx].nelts = nelts; } @@ -177,12 +181,15 @@ public: /* Called when processing dimensions of the array other than the innermost one. WALK_1 is the walker to normally call, ELT_TYPE is the type of the element being extracted, and ELT_OFF is the offset - of the element from the start of array being walked, and LAST_P is - true only when this is the last element that will be processed in - this dimension. */ + of the element from the start of array being walked, INDEX_TYPE + and INDEX is the type and the value respectively of the element's + index in the dimension currently being walked and LAST_P is true + only when this is the last element that will be processed in this + dimension. */ void process_dimension (gdb::function_view<void (struct type *, int, bool)> walk_1, - struct type *elt_type, LONGEST elt_off, bool last_p) + struct type *elt_type, LONGEST elt_off, + LONGEST index, bool last_p) { size_t dim_indx = m_dimension - 1; struct type *elt_type_prev = m_elt_type_prev; @@ -216,7 +223,12 @@ public: } else for (LONGEST i = nrepeats; i > 0; i--) - walk_1 (elt_type_prev, elt_off_prev, repeated && i == 1); + { + maybe_print_array_index (m_stats[dim_indx].index_type, + index - nrepeats + repeated, + m_stream, m_options); + walk_1 (elt_type_prev, elt_off_prev, repeated && i == 1); + } if (!repeated) { @@ -227,6 +239,8 @@ public: to `continue_walking' from our caller won't do that. */ if (m_elts < m_options->print_max) { + maybe_print_array_index (m_stats[dim_indx].index_type, index, + m_stream, m_options); walk_1 (elt_type, elt_off, last_p); nrepeats++; } @@ -240,9 +254,13 @@ public: } /* Called to process an element of ELT_TYPE at offset ELT_OFF from the - start of the parent object. */ - void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) + start of the parent object, where INDEX is the value of the element's + index in the dimension currently being walked and LAST_P is true only + when this is the last element to be processed in this dimension. */ + void process_element (struct type *elt_type, LONGEST elt_off, + LONGEST index, bool last_p) { + size_t dim_indx = m_dimension - 1; struct type *elt_type_prev = m_elt_type_prev; LONGEST elt_off_prev = m_elt_off_prev; bool repeated = (m_options->repeat_count_threshold < UINT_MAX @@ -277,6 +295,9 @@ public: for (LONGEST i = nrepeats; i > 0; i--) { + maybe_print_array_index (m_stats[dim_indx].index_type, + index - i + 1, + m_stream, m_options); common_val_print (e_val, m_stream, m_recurse, m_options, current_language); if (i > 1) @@ -294,6 +315,8 @@ public: if (printed) fputs_filtered (", ", m_stream); + maybe_print_array_index (m_stats[dim_indx].index_type, index, + m_stream, m_options); common_val_print (e_val, m_stream, m_recurse, m_options, current_language); } diff --git a/gdb/testsuite/gdb.fortran/array-indices.exp b/gdb/testsuite/gdb.fortran/array-indices.exp new file mode 100644 index 0000000..2740b81 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/array-indices.exp @@ -0,0 +1,200 @@ +# Copyright 2022 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/>. + +# Test the printing of element indices in Fortran arrays. + +if {[skip_fortran_tests]} { return -1 } + +load_lib fortran.exp + +# Build up the expected output for each array. +set n0 {(-2)} +set n1 {(-1)} +set n2 {(0)} +set n3 {(1)} +set n4 {(2)} +set n5 {(3)} +set a9p9o "($n0 = 9, $n1 = 9, $n2 = 9, $n3 = 9, $n4 = 9, $n5 = 9)" +set a1p "($n0 = 1, $n1 = 1, $n2 = 1, $n3 = 1, $n4 = 1)" +set a1p9 "($n0 = 1, $n1 = 1, $n2 = 1, $n3 = 1, $n4 = 1, $n5 = 9)" +set a2po "($n0 = 2, $n1 = 2, $n2 = 2, $n3 = 2, $n4 = 2)" +set a2p "($n0 = ${a2po} $n1 = ${a2po} $n2 = ${a2po} $n3 = ${a2po}\ + $n4 = ${a2po})" +set a2p9o "($n0 = 2, $n1 = 2, $n2 = 2, $n3 = 2, $n4 = 2, $n5 = 9)" +set a2p9 "($n0 = ${a2p9o} $n1 = ${a2p9o} $n2 = ${a2p9o} $n3 = ${a2p9o}\ + $n4 = ${a2p9o} $n5 = ${a9p9o})" +set a3po "($n0 = 3, $n1 = 3, $n2 = 3, $n3 = 3, $n4 = 3)" +set a3p "($n0 = ${a3po} $n1 = ${a3po} $n2 = ${a3po} $n3 = ${a3po}\ + $n4 = ${a3po})" +set a3p "($n0 = ${a3p} $n1 = ${a3p} $n2 = ${a3p} $n3 = ${a3p} $n4 = ${a3p})" +set a3p9o "($n0 = 3, $n1 = 3, $n2 = 3, $n3 = 3, $n4 = 3, $n5 = 9)" +set a3p9 "($n0 = ${a3p9o} $n1 = ${a3p9o} $n2 = ${a3p9o} $n3 = ${a3p9o}\ + $n4 = ${a3p9o} $n5 = ${a9p9o})" +set a9p9 "($n0 = ${a9p9o} $n1 = ${a9p9o} $n2 = ${a9p9o} $n3 = ${a9p9o}\ + $n4 = ${a9p9o} $n5 = ${a9p9o})" +set a3p9 "($n0 = ${a3p9} $n1 = ${a3p9} $n2 = ${a3p9} $n3 = ${a3p9}\ + $n4 = ${a3p9} $n5 = ${a9p9})" + +# Convert the output into a regexp. +set r1p [string_to_regexp $a1p] +set r1p9 [string_to_regexp $a1p9] +set r2po [string_to_regexp $a2po] +set r2p9o [string_to_regexp $a2p9o] +set r2p [string_to_regexp $a2p] +set r2p9 [string_to_regexp $a2p9] +set r3po [string_to_regexp $a3po] +set r3p9o [string_to_regexp $a3p9o] +set r3p [string_to_regexp $a3p] +set r3p9 [string_to_regexp $a3p9] + +set rep5 "<repeats 5 times>" +set rep6 "<repeats 6 times>" + +proc array_repeat { variant } { + global testfile srcfile + upvar n0 n0 n1 n1 n2 n2 n5 n5 + upvar r1p r1p r1p9 r1p9 r2po r2po r2p9o r2p9o r2p r2p r2p9 r2p9 + upvar r3po r3po r3p9o r3p9o r3p r3p r3p9 r3p9 + upvar a2po a2po a2p9o a2p9o a3po a3po a3p9o a3p9o + upvar rep5 rep5 rep6 rep6 + + standard_testfile "${variant}.f90" + + if {[prepare_for_testing ${testfile}.exp ${variant} ${srcfile} \ + {debug f90}]} { + return -1 + } + + with_test_prefix "${variant}" { + gdb_test_no_output "set print array-indexes on" + } + + if {![fortran_runto_main]} { + perror "Could not run to main." + continue + } + + gdb_breakpoint [gdb_get_line_number "Break here"] + gdb_continue_to_breakpoint "${variant}" + + with_test_prefix "${variant}: repeats=unlimited, elements=unlimited" { + # Check the arrays print as expected. + gdb_test_no_output "set print repeats unlimited" + gdb_test_no_output "set print elements unlimited" + + gdb_test "print array_1d" "${r1p}" + gdb_test "print array_1d9" "${r1p9}" + gdb_test "print array_2d" "${r2p}" + gdb_test "print array_2d9" "${r2p9}" + gdb_test "print array_3d" "${r3p}" + gdb_test "print array_3d9" "${r3p9}" + } + + with_test_prefix "${variant}: repeats=4, elements=unlimited" { + # Now set the repeat limit. + gdb_test_no_output "set print repeats 4" + gdb_test_no_output "set print elements unlimited" + + gdb_test "print array_1d" \ + [string_to_regexp "($n0 = 1, ${rep5})"] + gdb_test "print array_1d9" \ + [string_to_regexp "($n0 = 1, ${rep5}, $n5 = 9)"] + gdb_test "print array_2d" \ + [string_to_regexp "($n0 = ($n0 = 2, ${rep5}) ${rep5})"] + gdb_test "print array_2d9" \ + [string_to_regexp "($n0 = ($n0 = 2, ${rep5}, $n5 = 9) ${rep5}\ + $n5 = ($n0 = 9, ${rep6}))"] + gdb_test "print array_3d" \ + [string_to_regexp "($n0 = ($n0 = ($n0 = 3, ${rep5}) ${rep5})\ + ${rep5})"] + gdb_test "print array_3d9" \ + [string_to_regexp "($n0 = ($n0 = ($n0 = 3, ${rep5}, $n5 = 9)\ + ${rep5} $n5 = ($n0 = 9, ${rep6}))\ + ${rep5}\ + $n5 = ($n0 = ($n0 = 9, ${rep6}) ${rep6}))"] + } + + with_test_prefix "${variant}: repeats=unlimited, elements=12" { + # Now set the element limit. + gdb_test_no_output "set print repeats unlimited" + gdb_test_no_output "set print elements 12" + + gdb_test "print array_1d" "${r1p}" + gdb_test "print array_1d9" "${r1p9}" + gdb_test "print array_2d" \ + [string_to_regexp "($n0 = ${a2po} $n1 = ${a2po}\ + $n2 = ($n0 = 2, $n1 = 2, ...) ...)"] + gdb_test "print array_2d9" \ + [string_to_regexp "($n0 = ${a2p9o} $n1 = ${a2p9o} ...)"] + gdb_test "print array_3d" \ + [string_to_regexp "($n0 = ($n0 = ${a3po} $n1 = ${a3po}\ + $n2 = ($n0 = 3, $n1 = 3, ...)\ + ...) ...)"] + gdb_test "print array_3d9" \ + [string_to_regexp "($n0 = ($n0 = ${a3p9o} $n1 = ${a3p9o} ...)\ + ...)"] + } + + with_test_prefix "${variant}: repeats=4, elements=12" { + # Now set both limits. + gdb_test_no_output "set print repeats 4" + gdb_test_no_output "set print elements 12" + + gdb_test "print array_1d" \ + [string_to_regexp "($n0 = 1, ${rep5})"] + gdb_test "print array_1d9" \ + [string_to_regexp "($n0 = 1, ${rep5}, $n5 = 9)"] + gdb_test "print array_2d" \ + [string_to_regexp "($n0 = ($n0 = 2, ${rep5})\ + $n1 = ($n0 = 2, ${rep5})\ + $n2 = ($n0 = 2, $n1 = 2, ...) ...)"] + gdb_test "print array_2d9" \ + [string_to_regexp "($n0 = ($n0 = 2, ${rep5}, $n5 = 9)\ + $n1 = ($n0 = 2, ${rep5}, $n5 = 9) ...)"] + gdb_test "print array_3d" \ + [string_to_regexp "($n0 = ($n0 = ($n0 = 3, ${rep5})\ + $n1 = ($n0 = 3, ${rep5})\ + $n2 = ($n0 = 3, $n1 = 3, ...) ...) ...)"] + gdb_test "print array_3d9" \ + [string_to_regexp "($n0 = ($n0 = ($n0 = 3, ${rep5}, $n5 = 9)\ + $n1 = ($n0 = 3, ${rep5}, $n5 = 9)\ + ...) ...)"] + } + + with_test_prefix "${variant}: repeats=4, elements=30" { + # Now set both limits. + gdb_test_no_output "set print repeats 4" + gdb_test_no_output "set print elements 30" + + gdb_test "print array_1d" \ + [string_to_regexp "($n0 = 1, ${rep5})"] + gdb_test "print array_1d9" \ + [string_to_regexp "($n0 = 1, ${rep5}, $n5 = 9)"] + gdb_test "print array_2d" \ + [string_to_regexp "($n0 = ($n0 = 2, ${rep5}) ${rep5})"] + gdb_test "print array_2d9" \ + [string_to_regexp "($n0 = ($n0 = 2, ${rep5}, $n5 = 9) ${rep5}\ + ...)"] + gdb_test "print array_3d" \ + [string_to_regexp "($n0 = ($n0 = ($n0 = 3, ${rep5}) ${rep5})\ + $n1 = ($n0 = ($n0 = 3, ${rep5}) ...) ...)"] + gdb_test "print array_3d9" \ + [string_to_regexp "($n0 = ($n0 = ($n0 = 3, ${rep5}, $n5 = 9)\ + ${rep5} ...) ...)"] + } +} + +array_repeat "array-repeat" +array_repeat "array-slices-repeat" |