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, <repeats 5 times>) (-1) = ((-2) = 2, <repeats 5 times>) (0) = ((-2) = 2, (-1) = 2, ...) ...)
(gdb)

for a 5-element vector and a 5 by 5 array filled with the value of 2.
This commit is contained in:
Maciej W. Rozycki 2022-01-19 21:55:10 +00:00
parent 6b4338c868
commit 5d4c63a635
5 changed files with 279 additions and 27 deletions

View File

@ -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);
}
}

View File

@ -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

View File

@ -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;

View File

@ -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);
}

View File

@ -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"