{ 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
/* 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);
}
/* 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. */ }
};
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)
{
this->walk_1 (w_type, w_offset, w_last_p);
},
- subarray_type, new_offset, i == upperbound);
+ subarray_type, new_offset, i, i == upperbound);
}
}
else
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);
}
}
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)
{
/* 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));
}
/* 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));
/* 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
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;
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;
};
/* 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++;
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;
}
/* 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;
}
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)
{
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++;
}
}
/* 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
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)
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);
}
--- /dev/null
+# 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"
projects / binutils-gdb.git / commitdiff