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.

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"