From 5d4c63a635546c77bfa7ebabf944cb1d93f5c6fe Mon Sep 17 00:00:00 2001 From: "Maciej W. Rozycki" Date: Wed, 19 Jan 2022 21:55:10 +0000 Subject: [PATCH] Respect `set print array-indexes' with Fortran arrays Add `set print array-indexes' handling for Fortran arrays. Currently the setting is ignored and indices are never shown. Keep track of the most recent index handled so that any outstanding repeated elements printed when the limit set by `set print elements' is hit have the correct index shown. Output now looks like: (gdb) set print array-indexes on (gdb) print array_1d $1 = ((-2) = 1, (-1) = 1, (0) = 1, (1) = 1, (2) = 1) (gdb) set print repeats 4 (gdb) set print elements 12 (gdb) print array_2d $2 = ((-2) = ((-2) = 2, ) (-1) = ((-2) = 2, ) (0) = ((-2) = 2, (-1) = 2, ...) ...) (gdb) for a 5-element vector and a 5 by 5 array filled with the value of 2. --- gdb/f-array-walker.h | 39 ++-- gdb/f-lang.c | 22 ++- gdb/f-lang.h | 6 + gdb/f-valprint.c | 39 +++- gdb/testsuite/gdb.fortran/array-indices.exp | 200 ++++++++++++++++++++ 5 files changed, 279 insertions(+), 27 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/array-indices.exp diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h index a929dccead4..ad97dd51cd3 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 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 d181f385753..eaeda884aef 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)); @@ -1532,6 +1534,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 26b2c093095..11debd5569f 100644 --- a/gdb/f-lang.h +++ b/gdb/f-lang.h @@ -58,6 +58,12 @@ public: return extensions; } + /* 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 4b1aaae3c64..3d13eb11fb0 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 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 00000000000..2740b81e038 --- /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 . + +# 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 "" +set rep6 "" + +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" -- 2.30.2