Blame SOURCES/gdb-rhbz1964167-fortran-array-slices-at-prompt.patch

4a80f0
From FEDORA_PATCHES Mon Sep 17 00:00:00 2001
4a80f0
From: Kevin Buettner <kevinb@redhat.com>
4a80f0
Date: Mon, 24 May 2021 22:46:21 -0700
4a80f0
Subject: gdb-rhbz1964167-fortran-array-slices-at-prompt.patch
4a80f0
4a80f0
;; [fortran] Backport Andrew Burgess's commit for Fortran array
4a80f0
;; slice support
4a80f0
4a80f0
gdb/fortran: Add support for Fortran array slices at the GDB prompt
4a80f0
4a80f0
This commit brings array slice support to GDB.
4a80f0
4a80f0
WARNING: This patch contains a rather big hack which is limited to
4a80f0
Fortran arrays, this can be seen in gdbtypes.c and f-lang.c.  More
4a80f0
details on this below.
4a80f0
4a80f0
This patch rewrites two areas of GDB's Fortran support, the code to
4a80f0
extract an array slice, and the code to print an array.
4a80f0
4a80f0
After this commit a user can, from the GDB prompt, ask for a slice of
4a80f0
a Fortran array and should get the correct result back.  Slices can
4a80f0
(optionally) have the lower bound, upper bound, and a stride
4a80f0
specified.  Slices can also have a negative stride.
4a80f0
4a80f0
Fortran has the concept of repacking array slices.  Within a compiled
4a80f0
Fortran program if a user passes a non-contiguous array slice to a
4a80f0
function then the compiler may have to repack the slice, this involves
4a80f0
copying the elements of the slice to a new area of memory before the
4a80f0
call, and copying the elements back to the original array after the
4a80f0
call.  Whether repacking occurs will depend on which version of
4a80f0
Fortran is being used, and what type of function is being called.
4a80f0
4a80f0
This commit adds support for both packed, and unpacked array slicing,
4a80f0
with the default being unpacked.
4a80f0
4a80f0
With an unpacked array slice, when the user asks for a slice of an
4a80f0
array GDB creates a new type that accurately describes where the
4a80f0
elements of the slice can be found within the original array, a
4a80f0
value of this type is then returned to the user.  The address of an
4a80f0
element within the slice will be equal to the address of an element
4a80f0
within the original array.
4a80f0
4a80f0
A user can choose to select packed array slices instead using:
4a80f0
4a80f0
  (gdb) set fortran repack-array-slices on|off
4a80f0
  (gdb) show fortran repack-array-slices
4a80f0
4a80f0
With packed array slices GDB creates a new type that reflects how the
4a80f0
elements of the slice would look if they were laid out in contiguous
4a80f0
memory, allocates a value of this type, and then fetches the elements
4a80f0
from the original array and places then into the contents buffer of
4a80f0
the new value.
4a80f0
4a80f0
One benefit of using packed slices over unpacked slices is the memory
4a80f0
usage, taking a small slice of N elements from a large array will
4a80f0
require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked
4a80f0
array will also include all of the "padding" between the
4a80f0
non-contiguous elements.  There are new tests added that highlight
4a80f0
this difference.
4a80f0
4a80f0
There is also a new debugging flag added with this commit that
4a80f0
introduces these commands:
4a80f0
4a80f0
  (gdb) set debug fortran-array-slicing on|off
4a80f0
  (gdb) show debug fortran-array-slicing
4a80f0
4a80f0
This prints information about how the array slices are being built.
4a80f0
4a80f0
As both the repacking, and the array printing requires GDB to walk
4a80f0
through a multi-dimensional Fortran array visiting each element, this
4a80f0
commit adds the file f-array-walk.h, which introduces some
4a80f0
infrastructure to support this process.  This means the array printing
4a80f0
code in f-valprint.c is significantly reduced.
4a80f0
4a80f0
The only slight issue with this commit is the "rather big hack" that I
4a80f0
mentioned above.  This hack allows us to handle one specific case,
4a80f0
array slices with negative strides.  This is something that I don't
4a80f0
believe the current GDB value contents model will allow us to
4a80f0
correctly handle, and rather than rewrite the value contents code
4a80f0
right now, I'm hoping to slip this hack in as a work around.
4a80f0
4a80f0
The problem is that, as I see it, the current value contents model
4a80f0
assumes that an object base address will be the lowest address within
4a80f0
that object, and that the contents of the object start at this base
4a80f0
address and occupy the TYPE_LENGTH bytes after that.
4a80f0
4a80f0
( We do have the embedded_offset, which is used for C++ sub-classes,
4a80f0
such that an object can start at some offset from the content buffer,
4a80f0
however, the assumption that the object then occupies the next
4a80f0
TYPE_LENGTH bytes is still true within GDB. )
4a80f0
4a80f0
The problem is that Fortran arrays with a negative stride don't follow
4a80f0
this pattern.  In this case the base address of the object points to
4a80f0
the element with the highest address, the contents of the array then
4a80f0
start at some offset _before_ the base address, and proceed for one
4a80f0
element _past_ the base address.
4a80f0
4a80f0
As the stride for such an array would be negative then, in theory the
4a80f0
TYPE_LENGTH for this type would also be negative.  However, in many
4a80f0
places a value in GDB will degrade to a pointer + length, and the
4a80f0
length almost always comes from the TYPE_LENGTH.
4a80f0
4a80f0
It is my belief that in order to correctly model this case the value
4a80f0
content handling of GDB will need to be reworked to split apart the
4a80f0
value's content buffer (which is a block of memory with a length), and
4a80f0
the object's in memory base address and length, which could be
4a80f0
negative.
4a80f0
4a80f0
Things are further complicated because arrays with negative strides
4a80f0
like this are always dynamic types.  When a value has a dynamic type
4a80f0
and its base address needs resolving we actually store the address of
4a80f0
the object within the resolved dynamic type, not within the value
4a80f0
object itself.
4a80f0
4a80f0
In short I don't currently see an easy path to cleanly support this
4a80f0
situation within GDB.  And so I believe that leaves two options,
4a80f0
either add a work around, or catch cases where the user tries to make
4a80f0
use of a negative stride, or access an array with a negative stride,
4a80f0
and throw an error.
4a80f0
4a80f0
This patch currently goes with adding a work around, which is that
4a80f0
when we resolve a dynamic Fortran array type, if the stride is
4a80f0
negative, then we adjust the base address to point to the lowest
4a80f0
address required by the array.  The printing and slicing code is aware
4a80f0
of this adjustment and will correctly slice and print Fortran arrays.
4a80f0
4a80f0
Where this hack will show through to the user is if they ask for the
4a80f0
address of an array in their program with a negative array stride, the
4a80f0
address they get from GDB will not match the address that would be
4a80f0
computed within the Fortran program.
4a80f0
4a80f0
gdb/ChangeLog:
4a80f0
4a80f0
	* Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
4a80f0
	* NEWS: Mention new options.
4a80f0
	* f-array-walker.h: New file.
4a80f0
	* f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
4a80f0
	(repack_array_slices): New static global.
4a80f0
	(show_repack_array_slices): New function.
4a80f0
	(fortran_array_slicing_debug): New static global.
4a80f0
	(show_fortran_array_slicing_debug): New function.
4a80f0
	(value_f90_subarray): Delete.
4a80f0
	(skip_undetermined_arglist): Delete.
4a80f0
	(class fortran_array_repacker_base_impl): New class.
4a80f0
	(class fortran_lazy_array_repacker_impl): New class.
4a80f0
	(class fortran_array_repacker_impl): New class.
4a80f0
	(fortran_value_subarray): Complete rewrite.
4a80f0
	(set_fortran_list): New static global.
4a80f0
	(show_fortran_list): Likewise.
4a80f0
	(_initialize_f_language): Register new commands.
4a80f0
	(fortran_adjust_dynamic_array_base_address_hack): New function.
4a80f0
	* f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
4a80f0
	Declare.
4a80f0
	* f-valprint.c: Include 'f-array-walker.h'.
4a80f0
	(class fortran_array_printer_impl): New class.
4a80f0
	(f77_print_array_1): Delete.
4a80f0
	(f77_print_array): Delete.
4a80f0
	(fortran_print_array): New.
4a80f0
	(f_value_print_inner): Update to call fortran_print_array.
4a80f0
	* gdbtypes.c: Include 'f-lang.h'.
4a80f0
	(resolve_dynamic_type_internal): Call
4a80f0
	fortran_adjust_dynamic_array_base_address_hack.
4a80f0
4a80f0
gdb/testsuite/ChangeLog:
4a80f0
4a80f0
        * gdb.fortran/array-slices-bad.exp: New file.
4a80f0
        * gdb.fortran/array-slices-bad.f90: New file.
4a80f0
        * gdb.fortran/array-slices-sub-slices.exp: New file.
4a80f0
        * gdb.fortran/array-slices-sub-slices.f90: New file.
4a80f0
        * gdb.fortran/array-slices.exp: Rewrite tests.
4a80f0
        * gdb.fortran/array-slices.f90: Rewrite tests.
4a80f0
        * gdb.fortran/vla-sizeof.exp: Correct expected results.
4a80f0
4a80f0
gdb/doc/ChangeLog:
4a80f0
4a80f0
        * gdb.texinfo (Debugging Output): Document 'set/show debug
4a80f0
        fortran-array-slicing'.
4a80f0
        (Special Fortran Commands): Document 'set/show fortran
4a80f0
        repack-array-slices'.
4a80f0
4a80f0
diff --git a/gdb/Makefile.in b/gdb/Makefile.in
4a80f0
--- a/gdb/Makefile.in
4a80f0
+++ b/gdb/Makefile.in
4a80f0
@@ -1268,6 +1268,7 @@ HFILES_NO_SRCDIR = \
4a80f0
 	expression.h \
4a80f0
 	extension.h \
4a80f0
 	extension-priv.h \
4a80f0
+	f-array-walker.h \
4a80f0
 	f-lang.h \
4a80f0
 	fbsd-nat.h \
4a80f0
 	fbsd-tdep.h \
4a80f0
diff --git a/gdb/NEWS b/gdb/NEWS
4a80f0
--- a/gdb/NEWS
4a80f0
+++ b/gdb/NEWS
4a80f0
@@ -111,6 +111,19 @@ maintenance print core-file-backed-mappings
4a80f0
   Prints file-backed mappings loaded from a core file's note section.
4a80f0
   Output is expected to be similar to that of "info proc mappings".
4a80f0
 
4a80f0
+set debug fortran-array-slicing on|off
4a80f0
+show debug fortran-array-slicing
4a80f0
+  Print debugging when taking slices of Fortran arrays.
4a80f0
+
4a80f0
+set fortran repack-array-slices on|off
4a80f0
+show fortran repack-array-slices
4a80f0
+  When taking slices from Fortran arrays and strings, if the slice is
4a80f0
+  non-contiguous within the original value then, when this option is
4a80f0
+  on, the new value will be repacked into a single contiguous value.
4a80f0
+  When this option is off, then the value returned will consist of a
4a80f0
+  descriptor that describes the slice within the memory of the
4a80f0
+  original parent value.
4a80f0
+
4a80f0
 * Changed commands
4a80f0
 
4a80f0
 alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...]
4a80f0
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
4a80f0
--- a/gdb/doc/gdb.texinfo
4a80f0
+++ b/gdb/doc/gdb.texinfo
4a80f0
@@ -16919,6 +16919,29 @@ This command prints the values contained in the Fortran @code{COMMON}
4a80f0
 block whose name is @var{common-name}.  With no argument, the names of
4a80f0
 all @code{COMMON} blocks visible at the current program location are
4a80f0
 printed.
4a80f0
+@cindex arrays slices (Fortran)
4a80f0
+@kindex set fortran repack-array-slices
4a80f0
+@kindex show fortran repack-array-slices
4a80f0
+@item set fortran repack-array-slices [on|off]
4a80f0
+@item show fortran repack-array-slices
4a80f0
+When taking a slice from an array, a Fortran compiler can choose to
4a80f0
+either produce an array descriptor that describes the slice in place,
4a80f0
+or it may repack the slice, copying the elements of the slice into a
4a80f0
+new region of memory.
4a80f0
+
4a80f0
+When this setting is on, then @value{GDBN} will also repack array
4a80f0
+slices in some situations.  When this setting is off, then
4a80f0
+@value{GDBN} will create array descriptors for slices that reference
4a80f0
+the original data in place.
4a80f0
+
4a80f0
+@value{GDBN} will never repack an array slice if the data for the
4a80f0
+slice is contiguous within the original array.
4a80f0
+
4a80f0
+@value{GDBN} will always repack string slices if the data for the
4a80f0
+slice is non-contiguous within the original string as @value{GDBN}
4a80f0
+does not support printing non-contiguous strings.
4a80f0
+
4a80f0
+The default for this setting is @code{off}.
4a80f0
 @end table
4a80f0
 
4a80f0
 @node Pascal
4a80f0
@@ -26507,6 +26530,16 @@ Show the current state of FreeBSD LWP debugging messages.
4a80f0
 Turns on or off debugging messages from the FreeBSD native target.
4a80f0
 @item show debug fbsd-nat
4a80f0
 Show the current state of FreeBSD native target debugging messages.
4a80f0
+
4a80f0
+@item set debug fortran-array-slicing
4a80f0
+@cindex fortran array slicing debugging info
4a80f0
+Turns on or off display of @value{GDBN} Fortran array slicing
4a80f0
+debugging info.  The default is off.
4a80f0
+
4a80f0
+@item show debug fortran-array-slicing
4a80f0
+Displays the current state of displaying @value{GDBN} Fortran array
4a80f0
+slicing debugging info.
4a80f0
+
4a80f0
 @item set debug frame
4a80f0
 @cindex frame debugging info
4a80f0
 Turns on or off display of @value{GDBN} frame debugging info.  The
4a80f0
diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h
4a80f0
new file mode 100644
4a80f0
--- /dev/null
4a80f0
+++ b/gdb/f-array-walker.h
4a80f0
@@ -0,0 +1,265 @@
4a80f0
+/* Copyright (C) 2020 Free Software Foundation, Inc.
4a80f0
+
4a80f0
+   This file is part of GDB.
4a80f0
+
4a80f0
+   This program is free software; you can redistribute it and/or modify
4a80f0
+   it under the terms of the GNU General Public License as published by
4a80f0
+   the Free Software Foundation; either version 3 of the License, or
4a80f0
+   (at your option) any later version.
4a80f0
+
4a80f0
+   This program is distributed in the hope that it will be useful,
4a80f0
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
4a80f0
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
4a80f0
+   GNU General Public License for more details.
4a80f0
+
4a80f0
+   You should have received a copy of the GNU General Public License
4a80f0
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
4a80f0
+
4a80f0
+/* Support classes to wrap up the process of iterating over a
4a80f0
+   multi-dimensional Fortran array.  */
4a80f0
+
4a80f0
+#ifndef F_ARRAY_WALKER_H
4a80f0
+#define F_ARRAY_WALKER_H
4a80f0
+
4a80f0
+#include "defs.h"
4a80f0
+#include "gdbtypes.h"
4a80f0
+#include "f-lang.h"
4a80f0
+
4a80f0
+/* Class for calculating the byte offset for elements within a single
4a80f0
+   dimension of a Fortran array.  */
4a80f0
+class fortran_array_offset_calculator
4a80f0
+{
4a80f0
+public:
4a80f0
+  /* Create a new offset calculator for TYPE, which is either an array or a
4a80f0
+     string.  */
4a80f0
+  explicit fortran_array_offset_calculator (struct type *type)
4a80f0
+  {
4a80f0
+    /* Validate the type.  */
4a80f0
+    type = check_typedef (type);
4a80f0
+    if (type->code () != TYPE_CODE_ARRAY
4a80f0
+	&& (type->code () != TYPE_CODE_STRING))
4a80f0
+      error (_("can only compute offsets for arrays and strings"));
4a80f0
+
4a80f0
+    /* Get the range, and extract the bounds.  */
4a80f0
+    struct type *range_type = type->index_type ();
4a80f0
+    if (!get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound))
4a80f0
+      error ("unable to read array bounds");
4a80f0
+
4a80f0
+    /* Figure out the stride for this array.  */
4a80f0
+    struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
4a80f0
+    m_stride = type->index_type ()->bounds ()->bit_stride ();
4a80f0
+    if (m_stride == 0)
4a80f0
+      m_stride = type_length_units (elt_type);
4a80f0
+    else
4a80f0
+      {
4a80f0
+	struct gdbarch *arch = get_type_arch (elt_type);
4a80f0
+	int unit_size = gdbarch_addressable_memory_unit_size (arch);
4a80f0
+	m_stride /= (unit_size * 8);
4a80f0
+      }
4a80f0
+  };
4a80f0
+
4a80f0
+  /* Get the byte offset for element INDEX within the type we are working
4a80f0
+     on.  There is no bounds checking done on INDEX.  If the stride is
4a80f0
+     negative then we still assume that the base address (for the array
4a80f0
+     object) points to the element with the lowest memory address, we then
4a80f0
+     calculate an offset assuming that index 0 will be the element at the
4a80f0
+     highest address, index 1 the next highest, and so on.  This is not
4a80f0
+     quite how Fortran works in reality; in reality the base address of
4a80f0
+     the object would point at the element with the highest address, and
4a80f0
+     we would index backwards from there in the "normal" way, however,
4a80f0
+     GDB's current value contents model doesn't support having the base
4a80f0
+     address be near to the end of the value contents, so we currently
4a80f0
+     adjust the base address of Fortran arrays with negative strides so
4a80f0
+     their base address points at the lowest memory address.  This code
4a80f0
+     here is part of working around this weirdness.  */
4a80f0
+  LONGEST index_offset (LONGEST index)
4a80f0
+  {
4a80f0
+    LONGEST offset;
4a80f0
+    if (m_stride < 0)
4a80f0
+      offset = std::abs (m_stride) * (m_upperbound - index);
4a80f0
+    else
4a80f0
+      offset = std::abs (m_stride) * (index - m_lowerbound);
4a80f0
+    return offset;
4a80f0
+  }
4a80f0
+
4a80f0
+private:
4a80f0
+
4a80f0
+  /* The stride for the type we are working with.  */
4a80f0
+  LONGEST m_stride;
4a80f0
+
4a80f0
+  /* The upper bound for the type we are working with.  */
4a80f0
+  LONGEST m_upperbound;
4a80f0
+
4a80f0
+  /* The lower bound for the type we are working with.  */
4a80f0
+  LONGEST m_lowerbound;
4a80f0
+};
4a80f0
+
4a80f0
+/* A base class used by fortran_array_walker.  There's no virtual methods
4a80f0
+   here, sub-classes should just override the functions they want in order
4a80f0
+   to specialise the behaviour to their needs.  The functionality
4a80f0
+   provided in these default implementations will visit every array
4a80f0
+   element, but do nothing for each element.  */
4a80f0
+
4a80f0
+struct fortran_array_walker_base_impl
4a80f0
+{
4a80f0
+  /* Called when iterating between the lower and upper bounds of each
4a80f0
+     dimension of the array.  Return true if GDB should continue iterating,
4a80f0
+     otherwise, return false.
4a80f0
+
4a80f0
+     SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
4a80f0
+     be taken into consideration when deciding what to return.  If
4a80f0
+     SHOULD_CONTINUE is false then this function must also return false,
4a80f0
+     the function is still called though in case extra work needs to be
4a80f0
+     done as part of the stopping process.  */
4a80f0
+  bool continue_walking (bool should_continue)
4a80f0
+  { return should_continue; }
4a80f0
+
4a80f0
+  /* Called when GDB starts iterating over a dimension of the array.  The
4a80f0
+     argument INNER_P is true for the inner most dimension (the dimension
4a80f0
+     containing the actual elements of the array), and false for more outer
4a80f0
+     dimensions.  For a concrete example of how this function is called
4a80f0
+     see the comment on process_element below.  */
4a80f0
+  void start_dimension (bool inner_p)
4a80f0
+  { /* Nothing.  */ }
4a80f0
+
4a80f0
+  /* Called when GDB finishes iterating over a dimension of the array.  The
4a80f0
+     argument INNER_P is true for the inner most dimension (the dimension
4a80f0
+     containing the actual elements of the array), and false for more outer
4a80f0
+     dimensions.  LAST_P is true for the last call at a particular
4a80f0
+     dimension.  For a concrete example of how this function is called
4a80f0
+     see the comment on process_element below.  */
4a80f0
+  void finish_dimension (bool inner_p, bool last_p)
4a80f0
+  { /* Nothing.  */ }
4a80f0
+
4a80f0
+  /* Called when processing the inner most dimension of the array, for
4a80f0
+     every element in the array.  ELT_TYPE is the type of the element being
4a80f0
+     extracted, and ELT_OFF is the offset of the element from the start of
4a80f0
+     array being walked, and LAST_P is true only when this is the last
4a80f0
+     element that will be processed in this dimension.
4a80f0
+
4a80f0
+     Given this two dimensional array ((1, 2) (3, 4)), the calls to
4a80f0
+     start_dimension, process_element, and finish_dimension look like this:
4a80f0
+
4a80f0
+     start_dimension (false);
4a80f0
+       start_dimension (true);
4a80f0
+         process_element (TYPE, OFFSET, false);
4a80f0
+         process_element (TYPE, OFFSET, true);
4a80f0
+       finish_dimension (true, false);
4a80f0
+       start_dimension (true);
4a80f0
+         process_element (TYPE, OFFSET, false);
4a80f0
+         process_element (TYPE, OFFSET, true);
4a80f0
+       finish_dimension (true, true);
4a80f0
+     finish_dimension (false, true);  */
4a80f0
+  void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
4a80f0
+  { /* Nothing.  */ }
4a80f0
+};
4a80f0
+
4a80f0
+/* A class to wrap up the process of iterating over a multi-dimensional
4a80f0
+   Fortran array.  IMPL is used to specialise what happens as we walk over
4a80f0
+   the array.  See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
4a80f0
+   methods than can be used to customise the array walk.  */
4a80f0
+template<typename Impl>
4a80f0
+class fortran_array_walker
4a80f0
+{
4a80f0
+  /* Ensure that Impl is derived from the required base class.  This just
4a80f0
+     ensures that all of the required API methods are available and have a
4a80f0
+     sensible default implementation.  */
4a80f0
+  gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
4a80f0
+
4a80f0
+public:
4a80f0
+  /* Create a new array walker.  TYPE is the type of the array being walked
4a80f0
+     over, and ADDRESS is the base address for the object of TYPE in
4a80f0
+     memory.  All other arguments are forwarded to the constructor of the
4a80f0
+     template parameter class IMPL.  */
4a80f0
+  template <typename ...Args>
4a80f0
+  fortran_array_walker (struct type *type, CORE_ADDR address,
4a80f0
+			Args... args)
4a80f0
+    : m_type (type),
4a80f0
+      m_address (address),
4a80f0
+      m_impl (type, address, args...)
4a80f0
+  {
4a80f0
+    m_ndimensions =  calc_f77_array_dims (m_type);
4a80f0
+  }
4a80f0
+
4a80f0
+  /* Walk the array.  */
4a80f0
+  void
4a80f0
+  walk ()
4a80f0
+  {
4a80f0
+    walk_1 (1, m_type, 0, false);
4a80f0
+  }
4a80f0
+
4a80f0
+private:
4a80f0
+  /* The core of the array walking algorithm.  NSS is the current
4a80f0
+     dimension number being processed, TYPE is the type of this dimension,
4a80f0
+     and OFFSET is the offset (in bytes) for the start of this dimension.  */
4a80f0
+  void
4a80f0
+  walk_1 (int nss, struct type *type, int offset, bool last_p)
4a80f0
+  {
4a80f0
+    /* Extract the range, and get lower and upper bounds.  */
4a80f0
+    struct type *range_type = check_typedef (type)->index_type ();
4a80f0
+    LONGEST lowerbound, upperbound;
4a80f0
+    if (!get_discrete_bounds (range_type, &lowerbound, &upperbound))
4a80f0
+      error ("failed to get range bounds");
4a80f0
+
4a80f0
+    /* CALC is used to calculate the offsets for each element in this
4a80f0
+       dimension.  */
4a80f0
+    fortran_array_offset_calculator calc (type);
4a80f0
+
4a80f0
+    m_impl.start_dimension (nss == m_ndimensions);
4a80f0
+
4a80f0
+    if (nss != m_ndimensions)
4a80f0
+      {
4a80f0
+	/* For dimensions other than the inner most, walk each element and
4a80f0
+	   recurse while peeling off one more dimension of the array.  */
4a80f0
+	for (LONGEST i = lowerbound;
4a80f0
+	     m_impl.continue_walking (i < upperbound + 1);
4a80f0
+	     i++)
4a80f0
+	  {
4a80f0
+	    /* Use the index and the stride to work out a new offset.  */
4a80f0
+	    LONGEST new_offset = offset + calc.index_offset (i);
4a80f0
+
4a80f0
+	    /* Now print the lower dimension.  */
4a80f0
+	    struct type *subarray_type
4a80f0
+	      = TYPE_TARGET_TYPE (check_typedef (type));
4a80f0
+	    walk_1 (nss + 1, subarray_type, new_offset, (i == upperbound));
4a80f0
+	  }
4a80f0
+      }
4a80f0
+    else
4a80f0
+      {
4a80f0
+	/* For the inner most dimension of the array, process each element
4a80f0
+	   within this dimension.  */
4a80f0
+	for (LONGEST i = lowerbound;
4a80f0
+	     m_impl.continue_walking (i < upperbound + 1);
4a80f0
+	     i++)
4a80f0
+	  {
4a80f0
+	    LONGEST elt_off = offset + calc.index_offset (i);
4a80f0
+
4a80f0
+	    struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
4a80f0
+	    if (is_dynamic_type (elt_type))
4a80f0
+	      {
4a80f0
+		CORE_ADDR e_address = m_address + elt_off;
4a80f0
+		elt_type = resolve_dynamic_type (elt_type, {}, e_address);
4a80f0
+	      }
4a80f0
+
4a80f0
+	    m_impl.process_element (elt_type, elt_off, (i == upperbound));
4a80f0
+	  }
4a80f0
+      }
4a80f0
+
4a80f0
+    m_impl.finish_dimension (nss == m_ndimensions, last_p || nss == 1);
4a80f0
+  }
4a80f0
+
4a80f0
+  /* The array type being processed.  */
4a80f0
+  struct type *m_type;
4a80f0
+
4a80f0
+  /* The address in target memory for the object of M_TYPE being
4a80f0
+     processed.  This is required in order to resolve dynamic types.  */
4a80f0
+  CORE_ADDR m_address;
4a80f0
+
4a80f0
+  /* An instance of the template specialisation class.  */
4a80f0
+  Impl m_impl;
4a80f0
+
4a80f0
+  /* The total number of dimensions in M_TYPE.  */
4a80f0
+  int m_ndimensions;
4a80f0
+};
4a80f0
+
4a80f0
+#endif /* F_ARRAY_WALKER_H */
4a80f0
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
4a80f0
--- a/gdb/f-lang.c
4a80f0
+++ b/gdb/f-lang.c
4a80f0
@@ -36,9 +36,36 @@
4a80f0
 #include "c-lang.h"
4a80f0
 #include "target-float.h"
4a80f0
 #include "gdbarch.h"
4a80f0
+#include "gdbcmd.h"
4a80f0
+#include "f-array-walker.h"
4a80f0
 
4a80f0
 #include <math.h>
4a80f0
 
4a80f0
+/* Whether GDB should repack array slices created by the user.  */
4a80f0
+static bool repack_array_slices = false;
4a80f0
+
4a80f0
+/* Implement 'show fortran repack-array-slices'.  */
4a80f0
+static void
4a80f0
+show_repack_array_slices (struct ui_file *file, int from_tty,
4a80f0
+			  struct cmd_list_element *c, const char *value)
4a80f0
+{
4a80f0
+  fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"),
4a80f0
+		    value);
4a80f0
+}
4a80f0
+
4a80f0
+/* Debugging of Fortran's array slicing.  */
4a80f0
+static bool fortran_array_slicing_debug = false;
4a80f0
+
4a80f0
+/* Implement 'show debug fortran-array-slicing'.  */
4a80f0
+static void
4a80f0
+show_fortran_array_slicing_debug (struct ui_file *file, int from_tty,
4a80f0
+				  struct cmd_list_element *c,
4a80f0
+				  const char *value)
4a80f0
+{
4a80f0
+  fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"),
4a80f0
+		    value);
4a80f0
+}
4a80f0
+
4a80f0
 /* Local functions */
4a80f0
 
4a80f0
 /* Return the encoding that should be used for the character type
4a80f0
@@ -114,57 +141,6 @@ enum f_primitive_types {
4a80f0
   nr_f_primitive_types
4a80f0
 };
4a80f0
 
4a80f0
-/* Called from fortran_value_subarray to take a slice of an array or a
4a80f0
-   string.  ARRAY is the array or string to be accessed.  EXP, POS, and
4a80f0
-   NOSIDE are as for evaluate_subexp_standard.  Return a value that is a
4a80f0
-   slice of the array.  */
4a80f0
-
4a80f0
-static struct value *
4a80f0
-value_f90_subarray (struct value *array,
4a80f0
-		    struct expression *exp, int *pos, enum noside noside)
4a80f0
-{
4a80f0
-  int pc = (*pos) + 1;
4a80f0
-  LONGEST low_bound, high_bound, stride;
4a80f0
-  struct type *range = check_typedef (value_type (array)->index_type ());
4a80f0
-  enum range_flag range_flag
4a80f0
-    = (enum range_flag) longest_to_int (exp->elts[pc].longconst);
4a80f0
-
4a80f0
-  *pos += 3;
4a80f0
-
4a80f0
-  if (range_flag & RANGE_LOW_BOUND_DEFAULT)
4a80f0
-    low_bound = range->bounds ()->low.const_val ();
4a80f0
-  else
4a80f0
-    low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
4a80f0
-
4a80f0
-  if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
4a80f0
-    high_bound = range->bounds ()->high.const_val ();
4a80f0
-  else
4a80f0
-    high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
4a80f0
-
4a80f0
-  if (range_flag & RANGE_HAS_STRIDE)
4a80f0
-    stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
4a80f0
-  else
4a80f0
-    stride = 1;
4a80f0
-
4a80f0
-  if (stride != 1)
4a80f0
-    error (_("Fortran array strides are not currently supported"));
4a80f0
-
4a80f0
-  return value_slice (array, low_bound, high_bound - low_bound + 1);
4a80f0
-}
4a80f0
-
4a80f0
-/* Helper for skipping all the arguments in an undetermined argument list.
4a80f0
-   This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
4a80f0
-   case of evaluate_subexp_standard as multiple, but not all, code paths
4a80f0
-   require a generic skip.  */
4a80f0
-
4a80f0
-static void
4a80f0
-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
4a80f0
-			   enum noside noside)
4a80f0
-{
4a80f0
-  for (int i = 0; i < nargs; ++i)
4a80f0
-    evaluate_subexp (nullptr, exp, pos, noside);
4a80f0
-}
4a80f0
-
4a80f0
 /* Return the number of dimensions for a Fortran array or string.  */
4a80f0
 
4a80f0
 int
4a80f0
@@ -189,6 +165,145 @@ calc_f77_array_dims (struct type *array_type)
4a80f0
   return ndimen;
4a80f0
 }
4a80f0
 
4a80f0
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
4a80f0
+   slices.  This is a base class for two alternative repacking mechanisms,
4a80f0
+   one for when repacking from a lazy value, and one for repacking from a
4a80f0
+   non-lazy (already loaded) value.  */
4a80f0
+class fortran_array_repacker_base_impl
4a80f0
+  : public fortran_array_walker_base_impl
4a80f0
+{
4a80f0
+public:
4a80f0
+  /* Constructor, DEST is the value we are repacking into.  */
4a80f0
+  fortran_array_repacker_base_impl (struct value *dest)
4a80f0
+    : m_dest (dest),
4a80f0
+      m_dest_offset (0)
4a80f0
+  { /* Nothing.  */ }
4a80f0
+
4a80f0
+  /* When we start processing the inner most dimension, this is where we
4a80f0
+     will be creating values for each element as we load them and then copy
4a80f0
+     them into the M_DEST value.  Set a value mark so we can free these
4a80f0
+     temporary values.  */
4a80f0
+  void start_dimension (bool inner_p)
4a80f0
+  {
4a80f0
+    if (inner_p)
4a80f0
+      {
4a80f0
+	gdb_assert (m_mark == nullptr);
4a80f0
+	m_mark = value_mark ();
4a80f0
+      }
4a80f0
+  }
4a80f0
+
4a80f0
+  /* When we finish processing the inner most dimension free all temporary
4a80f0
+     value that were created.  */
4a80f0
+  void finish_dimension (bool inner_p, bool last_p)
4a80f0
+  {
4a80f0
+    if (inner_p)
4a80f0
+      {
4a80f0
+	gdb_assert (m_mark != nullptr);
4a80f0
+	value_free_to_mark (m_mark);
4a80f0
+	m_mark = nullptr;
4a80f0
+      }
4a80f0
+  }
4a80f0
+
4a80f0
+protected:
4a80f0
+  /* Copy the contents of array element ELT into M_DEST at the next
4a80f0
+     available offset.  */
4a80f0
+  void copy_element_to_dest (struct value *elt)
4a80f0
+  {
4a80f0
+    value_contents_copy (m_dest, m_dest_offset, elt, 0,
4a80f0
+			 TYPE_LENGTH (value_type (elt)));
4a80f0
+    m_dest_offset += TYPE_LENGTH (value_type (elt));
4a80f0
+  }
4a80f0
+
4a80f0
+  /* The value being written to.  */
4a80f0
+  struct value *m_dest;
4a80f0
+
4a80f0
+  /* The byte offset in M_DEST at which the next element should be
4a80f0
+     written.  */
4a80f0
+  LONGEST m_dest_offset;
4a80f0
+
4a80f0
+  /* Set with a call to VALUE_MARK, and then reset after calling
4a80f0
+     VALUE_FREE_TO_MARK.  */
4a80f0
+  struct value *m_mark = nullptr;
4a80f0
+};
4a80f0
+
4a80f0
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
4a80f0
+   slices.  This class is specialised for repacking an array slice from a
4a80f0
+   lazy array value, as such it does not require the parent array value to
4a80f0
+   be loaded into GDB's memory; the parent value could be huge, while the
4a80f0
+   slice could be tiny.  */
4a80f0
+class fortran_lazy_array_repacker_impl
4a80f0
+  : public fortran_array_repacker_base_impl
4a80f0
+{
4a80f0
+public:
4a80f0
+  /* Constructor.  TYPE is the type of the slice being loaded from the
4a80f0
+     parent value, so this type will correctly reflect the strides required
4a80f0
+     to find all of the elements from the parent value.  ADDRESS is the
4a80f0
+     address in target memory of value matching TYPE, and DEST is the value
4a80f0
+     we are repacking into.  */
4a80f0
+  explicit fortran_lazy_array_repacker_impl (struct type *type,
4a80f0
+					     CORE_ADDR address,
4a80f0
+					     struct value *dest)
4a80f0
+    : fortran_array_repacker_base_impl (dest),
4a80f0
+      m_addr (address)
4a80f0
+  { /* Nothing.  */ }
4a80f0
+
4a80f0
+  /* Create a lazy value in target memory representing a single element,
4a80f0
+     then load the element into GDB's memory and copy the contents into the
4a80f0
+     destination value.  */
4a80f0
+  void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
4a80f0
+  {
4a80f0
+    copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off));
4a80f0
+  }
4a80f0
+
4a80f0
+private:
4a80f0
+  /* The address in target memory where the parent value starts.  */
4a80f0
+  CORE_ADDR m_addr;
4a80f0
+};
4a80f0
+
4a80f0
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
4a80f0
+   slices.  This class is specialised for repacking an array slice from a
4a80f0
+   previously loaded (non-lazy) array value, as such it fetches the
4a80f0
+   element values from the contents of the parent value.  */
4a80f0
+class fortran_array_repacker_impl
4a80f0
+  : public fortran_array_repacker_base_impl
4a80f0
+{
4a80f0
+public:
4a80f0
+  /* Constructor.  TYPE is the type for the array slice within the parent
4a80f0
+     value, as such it has stride values as required to find the elements
4a80f0
+     within the original parent value.  ADDRESS is the address in target
4a80f0
+     memory of the value matching TYPE.  BASE_OFFSET is the offset from
4a80f0
+     the start of VAL's content buffer to the start of the object of TYPE,
4a80f0
+     VAL is the parent object from which we are loading the value, and
4a80f0
+     DEST is the value into which we are repacking.  */
4a80f0
+  explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address,
4a80f0
+					LONGEST base_offset,
4a80f0
+					struct value *val, struct value *dest)
4a80f0
+    : fortran_array_repacker_base_impl (dest),
4a80f0
+      m_base_offset (base_offset),
4a80f0
+      m_val (val)
4a80f0
+  {
4a80f0
+    gdb_assert (!value_lazy (val));
4a80f0
+  }
4a80f0
+
4a80f0
+  /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF)
4a80f0
+     from the content buffer of M_VAL then copy this extracted value into
4a80f0
+     the repacked destination value.  */
4a80f0
+  void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
4a80f0
+  {
4a80f0
+    struct value *elt
4a80f0
+      = value_from_component (m_val, elt_type, (elt_off + m_base_offset));
4a80f0
+    copy_element_to_dest (elt);
4a80f0
+  }
4a80f0
+
4a80f0
+private:
4a80f0
+  /* The offset into the content buffer of M_VAL to the start of the slice
4a80f0
+     being extracted.  */
4a80f0
+  LONGEST m_base_offset;
4a80f0
+
4a80f0
+  /* The parent value from which we are extracting a slice.  */
4a80f0
+  struct value *m_val;
4a80f0
+};
4a80f0
+
4a80f0
 /* Called from evaluate_subexp_standard to perform array indexing, and
4a80f0
    sub-range extraction, for Fortran.  As well as arrays this function
4a80f0
    also handles strings as they can be treated like arrays of characters.
4a80f0
@@ -200,51 +315,394 @@ static struct value *
4a80f0
 fortran_value_subarray (struct value *array, struct expression *exp,
4a80f0
 			int *pos, int nargs, enum noside noside)
4a80f0
 {
4a80f0
-  if (exp->elts[*pos].opcode == OP_RANGE)
4a80f0
-    return value_f90_subarray (array, exp, pos, noside);
4a80f0
-
4a80f0
-  if (noside == EVAL_SKIP)
4a80f0
+  type *original_array_type = check_typedef (value_type (array));
4a80f0
+  bool is_string_p = original_array_type->code () == TYPE_CODE_STRING;
4a80f0
+
4a80f0
+  /* Perform checks for ARRAY not being available.  The somewhat overly
4a80f0
+     complex logic here is just to keep backward compatibility with the
4a80f0
+     errors that we used to get before FORTRAN_VALUE_SUBARRAY was
4a80f0
+     rewritten.  Maybe a future task would streamline the error messages we
4a80f0
+     get here, and update all the expected test results.  */
4a80f0
+  if (exp->elts[*pos].opcode != OP_RANGE)
4a80f0
     {
4a80f0
-      skip_undetermined_arglist (nargs, exp, pos, noside);
4a80f0
-      /* Return the dummy value with the correct type.  */
4a80f0
-      return array;
4a80f0
+      if (type_not_associated (original_array_type))
4a80f0
+	error (_("no such vector element (vector not associated)"));
4a80f0
+      else if (type_not_allocated (original_array_type))
4a80f0
+	error (_("no such vector element (vector not allocated)"));
4a80f0
+    }
4a80f0
+  else
4a80f0
+    {
4a80f0
+      if (type_not_associated (original_array_type))
4a80f0
+	error (_("array not associated"));
4a80f0
+      else if (type_not_allocated (original_array_type))
4a80f0
+	error (_("array not allocated"));
4a80f0
     }
4a80f0
 
4a80f0
-  LONGEST subscript_array[MAX_FORTRAN_DIMS];
4a80f0
-  int ndimensions = 1;
4a80f0
-  struct type *type = check_typedef (value_type (array));
4a80f0
+  /* First check that the number of dimensions in the type we are slicing
4a80f0
+     matches the number of arguments we were passed.  */
4a80f0
+  int ndimensions = calc_f77_array_dims (original_array_type);
4a80f0
+  if (nargs != ndimensions)
4a80f0
+    error (_("Wrong number of subscripts"));
4a80f0
 
4a80f0
-  if (nargs > MAX_FORTRAN_DIMS)
4a80f0
-    error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
4a80f0
+  /* This will be initialised below with the type of the elements held in
4a80f0
+     ARRAY.  */
4a80f0
+  struct type *inner_element_type;
4a80f0
 
4a80f0
-  ndimensions = calc_f77_array_dims (type);
4a80f0
+  /* Extract the types of each array dimension from the original array
4a80f0
+     type.  We need these available so we can fill in the default upper and
4a80f0
+     lower bounds if the user requested slice doesn't provide that
4a80f0
+     information.  Additionally unpacking the dimensions like this gives us
4a80f0
+     the inner element type.  */
4a80f0
+  std::vector<struct type *> dim_types;
4a80f0
+  {
4a80f0
+    dim_types.reserve (ndimensions);
4a80f0
+    struct type *type = original_array_type;
4a80f0
+    for (int i = 0; i < ndimensions; ++i)
4a80f0
+      {
4a80f0
+	dim_types.push_back (type);
4a80f0
+	type = TYPE_TARGET_TYPE (type);
4a80f0
+      }
4a80f0
+    /* TYPE is now the inner element type of the array, we start the new
4a80f0
+       array slice off as this type, then as we process the requested slice
4a80f0
+       (from the user) we wrap new types around this to build up the final
4a80f0
+       slice type.  */
4a80f0
+    inner_element_type = type;
4a80f0
+  }
4a80f0
 
4a80f0
-  if (nargs != ndimensions)
4a80f0
-    error (_("Wrong number of subscripts"));
4a80f0
+  /* As we analyse the new slice type we need to understand if the data
4a80f0
+     being referenced is contiguous.  Do decide this we must track the size
4a80f0
+     of an element at each dimension of the new slice array.  Initially the
4a80f0
+     elements of the inner most dimension of the array are the same inner
4a80f0
+     most elements as the original ARRAY.  */
4a80f0
+  LONGEST slice_element_size = TYPE_LENGTH (inner_element_type);
4a80f0
+
4a80f0
+  /* Start off assuming all data is contiguous, this will be set to false
4a80f0
+     if access to any dimension results in non-contiguous data.  */
4a80f0
+  bool is_all_contiguous = true;
4a80f0
+
4a80f0
+  /* The TOTAL_OFFSET is the distance in bytes from the start of the
4a80f0
+     original ARRAY to the start of the new slice.  This is calculated as
4a80f0
+     we process the information from the user.  */
4a80f0
+  LONGEST total_offset = 0;
4a80f0
+
4a80f0
+  /* A structure representing information about each dimension of the
4a80f0
+     resulting slice.  */
4a80f0
+  struct slice_dim
4a80f0
+  {
4a80f0
+    /* Constructor.  */
4a80f0
+    slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx)
4a80f0
+      : low (l),
4a80f0
+	high (h),
4a80f0
+	stride (s),
4a80f0
+	index (idx)
4a80f0
+    { /* Nothing.  */ }
4a80f0
+
4a80f0
+    /* The low bound for this dimension of the slice.  */
4a80f0
+    LONGEST low;
4a80f0
+
4a80f0
+    /* The high bound for this dimension of the slice.  */
4a80f0
+    LONGEST high;
4a80f0
+
4a80f0
+    /* The byte stride for this dimension of the slice.  */
4a80f0
+    LONGEST stride;
4a80f0
+
4a80f0
+    struct type *index;
4a80f0
+  };
4a80f0
+
4a80f0
+  /* The dimensions of the resulting slice.  */
4a80f0
+  std::vector<slice_dim> slice_dims;
4a80f0
+
4a80f0
+  /* Process the incoming arguments.   These arguments are in the reverse
4a80f0
+     order to the array dimensions, that is the first argument refers to
4a80f0
+     the last array dimension.  */
4a80f0
+  if (fortran_array_slicing_debug)
4a80f0
+    debug_printf ("Processing array access:\n");
4a80f0
+  for (int i = 0; i < nargs; ++i)
4a80f0
+    {
4a80f0
+      /* For each dimension of the array the user will have either provided
4a80f0
+	 a ranged access with optional lower bound, upper bound, and
4a80f0
+	 stride, or the user will have supplied a single index.  */
4a80f0
+      struct type *dim_type = dim_types[ndimensions - (i + 1)];
4a80f0
+      if (exp->elts[*pos].opcode == OP_RANGE)
4a80f0
+	{
4a80f0
+	  int pc = (*pos) + 1;
4a80f0
+	  enum range_flag range_flag = (enum range_flag) exp->elts[pc].longconst;
4a80f0
+	  *pos += 3;
4a80f0
+
4a80f0
+	  LONGEST low, high, stride;
4a80f0
+	  low = high = stride = 0;
4a80f0
+
4a80f0
+	  if ((range_flag & RANGE_LOW_BOUND_DEFAULT) == 0)
4a80f0
+	    low = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
4a80f0
+	  else
4a80f0
+	    low = f77_get_lowerbound (dim_type);
4a80f0
+	  if ((range_flag & RANGE_HIGH_BOUND_DEFAULT) == 0)
4a80f0
+	    high = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
4a80f0
+	  else
4a80f0
+	    high = f77_get_upperbound (dim_type);
4a80f0
+	  if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
4a80f0
+	    stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
4a80f0
+	  else
4a80f0
+	    stride = 1;
4a80f0
+
4a80f0
+	  if (stride == 0)
4a80f0
+	    error (_("stride must not be 0"));
4a80f0
+
4a80f0
+	  /* Get information about this dimension in the original ARRAY.  */
4a80f0
+	  struct type *target_type = TYPE_TARGET_TYPE (dim_type);
4a80f0
+	  struct type *index_type = dim_type->index_type ();
4a80f0
+	  LONGEST lb = f77_get_lowerbound (dim_type);
4a80f0
+	  LONGEST ub = f77_get_upperbound (dim_type);
4a80f0
+	  LONGEST sd = index_type->bit_stride ();
4a80f0
+	  if (sd == 0)
4a80f0
+	    sd = TYPE_LENGTH (target_type) * 8;
4a80f0
+
4a80f0
+	  if (fortran_array_slicing_debug)
4a80f0
+	    {
4a80f0
+	      debug_printf ("|-> Range access\n");
4a80f0
+	      std::string str = type_to_string (dim_type);
4a80f0
+	      debug_printf ("|   |-> Type: %s\n", str.c_str ());
4a80f0
+	      debug_printf ("|   |-> Array:\n");
4a80f0
+	      debug_printf ("|   |   |-> Low bound: %ld\n", lb);
4a80f0
+	      debug_printf ("|   |   |-> High bound: %ld\n", ub);
4a80f0
+	      debug_printf ("|   |   |-> Bit stride: %ld\n", sd);
4a80f0
+	      debug_printf ("|   |   |-> Byte stride: %ld\n", sd / 8);
4a80f0
+	      debug_printf ("|   |   |-> Type size: %ld\n",
4a80f0
+			    TYPE_LENGTH (dim_type));
4a80f0
+	      debug_printf ("|   |   '-> Target type size: %ld\n",
4a80f0
+			    TYPE_LENGTH (target_type));
4a80f0
+	      debug_printf ("|   |-> Accessing:\n");
4a80f0
+	      debug_printf ("|   |   |-> Low bound: %ld\n",
4a80f0
+			    low);
4a80f0
+	      debug_printf ("|   |   |-> High bound: %ld\n",
4a80f0
+			    high);
4a80f0
+	      debug_printf ("|   |   '-> Element stride: %ld\n",
4a80f0
+			    stride);
4a80f0
+	    }
4a80f0
+
4a80f0
+	  /* Check the user hasn't asked for something invalid.  */
4a80f0
+	  if (high > ub || low < lb)
4a80f0
+	    error (_("array subscript out of bounds"));
4a80f0
+
4a80f0
+	  /* Calculate what this dimension of the new slice array will look
4a80f0
+	     like.  OFFSET is the byte offset from the start of the
4a80f0
+	     previous (more outer) dimension to the start of this
4a80f0
+	     dimension.  E_COUNT is the number of elements in this
4a80f0
+	     dimension.  REMAINDER is the number of elements remaining
4a80f0
+	     between the last included element and the upper bound.  For
4a80f0
+	     example an access '1:6:2' will include elements 1, 3, 5 and
4a80f0
+	     have a remainder of 1 (element #6).  */
4a80f0
+	  LONGEST lowest = std::min (low, high);
4a80f0
+	  LONGEST offset = (sd / 8) * (lowest - lb);
4a80f0
+	  LONGEST e_count = std::abs (high - low) + 1;
4a80f0
+	  e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride);
4a80f0
+	  LONGEST new_low = 1;
4a80f0
+	  LONGEST new_high = new_low + e_count - 1;
4a80f0
+	  LONGEST new_stride = (sd * stride) / 8;
4a80f0
+	  LONGEST last_elem = low + ((e_count - 1) * stride);
4a80f0
+	  LONGEST remainder = high - last_elem;
4a80f0
+	  if (low > high)
4a80f0
+	    {
4a80f0
+	      offset += std::abs (remainder) * TYPE_LENGTH (target_type);
4a80f0
+	      if (stride > 0)
4a80f0
+		error (_("incorrect stride and boundary combination"));
4a80f0
+	    }
4a80f0
+	  else if (stride < 0)
4a80f0
+	    error (_("incorrect stride and boundary combination"));
4a80f0
+
4a80f0
+	  /* Is the data within this dimension contiguous?  It is if the
4a80f0
+	     newly computed stride is the same size as a single element of
4a80f0
+	     this dimension.  */
4a80f0
+	  bool is_dim_contiguous = (new_stride == slice_element_size);
4a80f0
+	  is_all_contiguous &= is_dim_contiguous;
4a80f0
+
4a80f0
+	  if (fortran_array_slicing_debug)
4a80f0
+	    {
4a80f0
+	      debug_printf ("|   '-> Results:\n");
4a80f0
+	      debug_printf ("|       |-> Offset = %ld\n", offset);
4a80f0
+	      debug_printf ("|       |-> Elements = %ld\n", e_count);
4a80f0
+	      debug_printf ("|       |-> Low bound = %ld\n", new_low);
4a80f0
+	      debug_printf ("|       |-> High bound = %ld\n", new_high);
4a80f0
+	      debug_printf ("|       |-> Byte stride = %ld\n", new_stride);
4a80f0
+	      debug_printf ("|       |-> Last element = %ld\n", last_elem);
4a80f0
+	      debug_printf ("|       |-> Remainder = %ld\n", remainder);
4a80f0
+	      debug_printf ("|       '-> Contiguous = %s\n",
4a80f0
+			    (is_dim_contiguous ? "Yes" : "No"));
4a80f0
+	    }
4a80f0
+
4a80f0
+	  /* Figure out how big (in bytes) an element of this dimension of
4a80f0
+	     the new array slice will be.  */
4a80f0
+	  slice_element_size = std::abs (new_stride * e_count);
4a80f0
+
4a80f0
+	  slice_dims.emplace_back (new_low, new_high, new_stride,
4a80f0
+				   index_type);
4a80f0
+
4a80f0
+	  /* Update the total offset.  */
4a80f0
+	  total_offset += offset;
4a80f0
+	}
4a80f0
+      else
4a80f0
+	{
4a80f0
+	  /* There is a single index for this dimension.  */
4a80f0
+	  LONGEST index
4a80f0
+	    = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside));
4a80f0
+
4a80f0
+	  /* Get information about this dimension in the original ARRAY.  */
4a80f0
+	  struct type *target_type = TYPE_TARGET_TYPE (dim_type);
4a80f0
+	  struct type *index_type = dim_type->index_type ();
4a80f0
+	  LONGEST lb = f77_get_lowerbound (dim_type);
4a80f0
+	  LONGEST ub = f77_get_upperbound (dim_type);
4a80f0
+	  LONGEST sd = index_type->bit_stride () / 8;
4a80f0
+	  if (sd == 0)
4a80f0
+	    sd = TYPE_LENGTH (target_type);
4a80f0
+
4a80f0
+	  if (fortran_array_slicing_debug)
4a80f0
+	    {
4a80f0
+	      debug_printf ("|-> Index access\n");
4a80f0
+	      std::string str = type_to_string (dim_type);
4a80f0
+	      debug_printf ("|   |-> Type: %s\n", str.c_str ());
4a80f0
+	      debug_printf ("|   |-> Array:\n");
4a80f0
+	      debug_printf ("|   |   |-> Low bound: %ld\n", lb);
4a80f0
+	      debug_printf ("|   |   |-> High bound: %ld\n", ub);
4a80f0
+	      debug_printf ("|   |   |-> Byte stride: %ld\n", sd);
4a80f0
+	      debug_printf ("|   |   |-> Type size: %ld\n", TYPE_LENGTH (dim_type));
4a80f0
+	      debug_printf ("|   |   '-> Target type size: %ld\n",
4a80f0
+			    TYPE_LENGTH (target_type));
4a80f0
+	      debug_printf ("|   '-> Accessing:\n");
4a80f0
+	      debug_printf ("|       '-> Index: %ld\n", index);
4a80f0
+	    }
4a80f0
+
4a80f0
+	  /* If the array has actual content then check the index is in
4a80f0
+	     bounds.  An array without content (an unbound array) doesn't
4a80f0
+	     have a known upper bound, so don't error check in that
4a80f0
+	     situation.  */
4a80f0
+	  if (index < lb
4a80f0
+	      || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED
4a80f0
+		  && index > ub)
4a80f0
+	      || (VALUE_LVAL (array) != lval_memory
4a80f0
+		  && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED))
4a80f0
+	    {
4a80f0
+	      if (type_not_associated (dim_type))
4a80f0
+		error (_("no such vector element (vector not associated)"));
4a80f0
+	      else if (type_not_allocated (dim_type))
4a80f0
+		error (_("no such vector element (vector not allocated)"));
4a80f0
+	      else
4a80f0
+		error (_("no such vector element"));
4a80f0
+	    }
4a80f0
 
4a80f0
-  gdb_assert (nargs > 0);
4a80f0
+	  /* Calculate using the type stride, not the target type size.  */
4a80f0
+	  LONGEST offset = sd * (index - lb);
4a80f0
+	  total_offset += offset;
4a80f0
+	}
4a80f0
+    }
4a80f0
 
4a80f0
-  /* Now that we know we have a legal array subscript expression let us
4a80f0
-     actually find out where this element exists in the array.  */
4a80f0
+  if (noside == EVAL_SKIP)
4a80f0
+    return array;
4a80f0
 
4a80f0
-  /* Take array indices left to right.  */
4a80f0
-  for (int i = 0; i < nargs; i++)
4a80f0
+  /* Build a type that represents the new array slice in the target memory
4a80f0
+     of the original ARRAY, this type makes use of strides to correctly
4a80f0
+     find only those elements that are part of the new slice.  */
4a80f0
+  struct type *array_slice_type = inner_element_type;
4a80f0
+  for (const auto &d : slice_dims)
4a80f0
     {
4a80f0
-      /* Evaluate each subscript; it must be a legal integer in F77.  */
4a80f0
-      value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
4a80f0
+      /* Create the range.  */
4a80f0
+      dynamic_prop p_low, p_high, p_stride;
4a80f0
+
4a80f0
+      p_low.set_const_val (d.low);
4a80f0
+      p_high.set_const_val (d.high);
4a80f0
+      p_stride.set_const_val (d.stride);
4a80f0
+
4a80f0
+      struct type *new_range
4a80f0
+	= create_range_type_with_stride ((struct type *) NULL,
4a80f0
+					 TYPE_TARGET_TYPE (d.index),
4a80f0
+					 &p_low, &p_high, 0, &p_stride,
4a80f0
+					 true);
4a80f0
+      array_slice_type
4a80f0
+	= create_array_type (nullptr, array_slice_type, new_range);
4a80f0
+    }
4a80f0
 
4a80f0
-      /* Fill in the subscript array.  */
4a80f0
-      subscript_array[i] = value_as_long (arg2);
4a80f0
+  if (fortran_array_slicing_debug)
4a80f0
+    {
4a80f0
+      debug_printf ("'-> Final result:\n");
4a80f0
+      debug_printf ("    |-> Type: %s\n",
4a80f0
+		    type_to_string (array_slice_type).c_str ());
4a80f0
+      debug_printf ("    |-> Total offset: %ld\n", total_offset);
4a80f0
+      debug_printf ("    |-> Base address: %s\n",
4a80f0
+		    core_addr_to_string (value_address (array)));
4a80f0
+      debug_printf ("    '-> Contiguous = %s\n",
4a80f0
+		    (is_all_contiguous ? "Yes" : "No"));
4a80f0
     }
4a80f0
 
4a80f0
-  /* Internal type of array is arranged right to left.  */
4a80f0
-  for (int i = nargs; i > 0; i--)
4a80f0
+  /* Should we repack this array slice?  */
4a80f0
+  if (!is_all_contiguous && (repack_array_slices || is_string_p))
4a80f0
     {
4a80f0
-      struct type *array_type = check_typedef (value_type (array));
4a80f0
-      LONGEST index = subscript_array[i - 1];
4a80f0
+      /* Build a type for the repacked slice.  */
4a80f0
+      struct type *repacked_array_type = inner_element_type;
4a80f0
+      for (const auto &d : slice_dims)
4a80f0
+	{
4a80f0
+	  /* Create the range.  */
4a80f0
+	  dynamic_prop p_low, p_high, p_stride;
4a80f0
+
4a80f0
+	  p_low.set_const_val (d.low);
4a80f0
+	  p_high.set_const_val (d.high);
4a80f0
+	  p_stride.set_const_val (TYPE_LENGTH (repacked_array_type));
4a80f0
+
4a80f0
+	  struct type *new_range
4a80f0
+	    = create_range_type_with_stride ((struct type *) NULL,
4a80f0
+					     TYPE_TARGET_TYPE (d.index),
4a80f0
+					     &p_low, &p_high, 0, &p_stride,
4a80f0
+					     true);
4a80f0
+	  repacked_array_type
4a80f0
+	    = create_array_type (nullptr, repacked_array_type, new_range);
4a80f0
+	}
4a80f0
 
4a80f0
-      array = value_subscripted_rvalue (array, index,
4a80f0
-					f77_get_lowerbound (array_type));
4a80f0
+      /* Now copy the elements from the original ARRAY into the packed
4a80f0
+	 array value DEST.  */
4a80f0
+      struct value *dest = allocate_value (repacked_array_type);
4a80f0
+      if (value_lazy (array)
4a80f0
+	  || (total_offset + TYPE_LENGTH (array_slice_type)
4a80f0
+	      > TYPE_LENGTH (check_typedef (value_type (array)))))
4a80f0
+	{
4a80f0
+	  fortran_array_walker<fortran_lazy_array_repacker_impl> p
4a80f0
+	    (array_slice_type, value_address (array) + total_offset, dest);
4a80f0
+	  p.walk ();
4a80f0
+	}
4a80f0
+      else
4a80f0
+	{
4a80f0
+	  fortran_array_walker<fortran_array_repacker_impl> p
4a80f0
+	    (array_slice_type, value_address (array) + total_offset,
4a80f0
+	     total_offset, array, dest);
4a80f0
+	  p.walk ();
4a80f0
+	}
4a80f0
+      array = dest;
4a80f0
+    }
4a80f0
+  else
4a80f0
+    {
4a80f0
+      if (VALUE_LVAL (array) == lval_memory)
4a80f0
+	{
4a80f0
+	  /* If the value we're taking a slice from is not yet loaded, or
4a80f0
+	     the requested slice is outside the values content range then
4a80f0
+	     just create a new lazy value pointing at the memory where the
4a80f0
+	     contents we're looking for exist.  */
4a80f0
+	  if (value_lazy (array)
4a80f0
+	      || (total_offset + TYPE_LENGTH (array_slice_type)
4a80f0
+		  > TYPE_LENGTH (check_typedef (value_type (array)))))
4a80f0
+	    array = value_at_lazy (array_slice_type,
4a80f0
+				   value_address (array) + total_offset);
4a80f0
+	  else
4a80f0
+	    array = value_from_contents_and_address (array_slice_type,
4a80f0
+						     (value_contents (array)
4a80f0
+						      + total_offset),
4a80f0
+						     (value_address (array)
4a80f0
+						      + total_offset));
4a80f0
+	}
4a80f0
+      else if (!value_lazy (array))
4a80f0
+	{
4a80f0
+	  const void *valaddr = value_contents (array) + total_offset;
4a80f0
+	  array = allocate_value (array_slice_type);
4a80f0
+	  memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type));
4a80f0
+	}
4a80f0
+      else
4a80f0
+	error (_("cannot subscript arrays that are not in memory"));
4a80f0
     }
4a80f0
 
4a80f0
   return array;
4a80f0
@@ -1031,11 +1489,50 @@ builtin_f_type (struct gdbarch *gdbarch)
4a80f0
   return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
4a80f0
 }
4a80f0
 
4a80f0
+/* Command-list for the "set/show fortran" prefix command.  */
4a80f0
+static struct cmd_list_element *set_fortran_list;
4a80f0
+static struct cmd_list_element *show_fortran_list;
4a80f0
+
4a80f0
 void _initialize_f_language ();
4a80f0
 void
4a80f0
 _initialize_f_language ()
4a80f0
 {
4a80f0
   f_type_data = gdbarch_data_register_post_init (build_fortran_types);
4a80f0
+
4a80f0
+  add_basic_prefix_cmd ("fortran", no_class,
4a80f0
+			_("Prefix command for changing Fortran-specific settings."),
4a80f0
+			&set_fortran_list, "set fortran ", 0, &setlist);
4a80f0
+
4a80f0
+  add_show_prefix_cmd ("fortran", no_class,
4a80f0
+		       _("Generic command for showing Fortran-specific settings."),
4a80f0
+		       &show_fortran_list, "show fortran ", 0, &showlist);
4a80f0
+
4a80f0
+  add_setshow_boolean_cmd ("repack-array-slices", class_vars,
4a80f0
+			   &repack_array_slices, _("\
4a80f0
+Enable or disable repacking of non-contiguous array slices."), _("\
4a80f0
+Show whether non-contiguous array slices are repacked."), _("\
4a80f0
+When the user requests a slice of a Fortran array then we can either return\n\
4a80f0
+a descriptor that describes the array in place (using the original array data\n\
4a80f0
+in its existing location) or the original data can be repacked (copied) to a\n\
4a80f0
+new location.\n\
4a80f0
+\n\
4a80f0
+When the content of the array slice is contiguous within the original array\n\
4a80f0
+then the result will never be repacked, but when the data for the new array\n\
4a80f0
+is non-contiguous within the original array repacking will only be performed\n\
4a80f0
+when this setting is on."),
4a80f0
+			   NULL,
4a80f0
+			   show_repack_array_slices,
4a80f0
+			   &set_fortran_list, &show_fortran_list);
4a80f0
+
4a80f0
+  /* Debug Fortran's array slicing logic.  */
4a80f0
+  add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance,
4a80f0
+			   &fortran_array_slicing_debug, _("\
4a80f0
+Set debugging of Fortran array slicing."), _("\
4a80f0
+Show debugging of Fortran array slicing."), _("\
4a80f0
+When on, debugging of Fortran array slicing is enabled."),
4a80f0
+			    NULL,
4a80f0
+			    show_fortran_array_slicing_debug,
4a80f0
+			    &setdebuglist, &showdebuglist);
4a80f0
 }
4a80f0
 
4a80f0
 /* See f-lang.h.  */
4a80f0
@@ -1074,3 +1571,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type)
4a80f0
     return value_type (arg);
4a80f0
   return type;
4a80f0
 }
4a80f0
+
4a80f0
+/* See f-lang.h.  */
4a80f0
+
4a80f0
+CORE_ADDR
4a80f0
+fortran_adjust_dynamic_array_base_address_hack (struct type *type,
4a80f0
+						CORE_ADDR address)
4a80f0
+{
4a80f0
+  gdb_assert (type->code () == TYPE_CODE_ARRAY);
4a80f0
+
4a80f0
+  int ndimensions = calc_f77_array_dims (type);
4a80f0
+  LONGEST total_offset = 0;
4a80f0
+
4a80f0
+  /* Walk through each of the dimensions of this array type and figure out
4a80f0
+     if any of the dimensions are "backwards", that is the base address
4a80f0
+     for this dimension points to the element at the highest memory
4a80f0
+     address and the stride is negative.  */
4a80f0
+  struct type *tmp_type = type;
4a80f0
+  for (int i = 0 ; i < ndimensions; ++i)
4a80f0
+    {
4a80f0
+      /* Grab the range for this dimension and extract the lower and upper
4a80f0
+	 bounds.  */
4a80f0
+      tmp_type = check_typedef (tmp_type);
4a80f0
+      struct type *range_type = tmp_type->index_type ();
4a80f0
+      LONGEST lowerbound, upperbound, stride;
4a80f0
+      if (!get_discrete_bounds (range_type, &lowerbound, &upperbound))
4a80f0
+	error ("failed to get range bounds");
4a80f0
+
4a80f0
+      /* Figure out the stride for this dimension.  */
4a80f0
+      struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
4a80f0
+      stride = tmp_type->index_type ()->bounds ()->bit_stride ();
4a80f0
+      if (stride == 0)
4a80f0
+	stride = type_length_units (elt_type);
4a80f0
+      else
4a80f0
+	{
4a80f0
+	  struct gdbarch *arch = get_type_arch (elt_type);
4a80f0
+	  int unit_size = gdbarch_addressable_memory_unit_size (arch);
4a80f0
+	  stride /= (unit_size * 8);
4a80f0
+	}
4a80f0
+
4a80f0
+      /* If this dimension is "backward" then figure out the offset
4a80f0
+	 adjustment required to point to the element at the lowest memory
4a80f0
+	 address, and add this to the total offset.  */
4a80f0
+      LONGEST offset = 0;
4a80f0
+      if (stride < 0 && lowerbound < upperbound)
4a80f0
+	offset = (upperbound - lowerbound) * stride;
4a80f0
+      total_offset += offset;
4a80f0
+      tmp_type = TYPE_TARGET_TYPE (tmp_type);
4a80f0
+    }
4a80f0
+
4a80f0
+  /* Adjust the address of this object and return it.  */
4a80f0
+  address += total_offset;
4a80f0
+  return address;
4a80f0
+}
4a80f0
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
4a80f0
--- a/gdb/f-lang.h
4a80f0
+++ b/gdb/f-lang.h
4a80f0
@@ -64,7 +64,6 @@ extern void f77_get_dynamic_array_length (struct type *);
4a80f0
 
4a80f0
 extern int calc_f77_array_dims (struct type *);
4a80f0
 
4a80f0
-
4a80f0
 /* Fortran (F77) types */
4a80f0
 
4a80f0
 struct builtin_f_type
4a80f0
@@ -122,4 +121,22 @@ extern struct value *fortran_argument_convert (struct value *value,
4a80f0
 extern struct type *fortran_preserve_arg_pointer (struct value *arg,
4a80f0
 						  struct type *type);
4a80f0
 
4a80f0
+/* Fortran arrays can have a negative stride.  When this happens it is
4a80f0
+   often the case that the base address for an object is not the lowest
4a80f0
+   address occupied by that object.  For example, an array slice (10:1:-1)
4a80f0
+   will be encoded with lower bound 1, upper bound 10, a stride of
4a80f0
+   -ELEMENT_SIZE, and have a base address pointer that points at the
4a80f0
+   element with the highest address in memory.
4a80f0
+
4a80f0
+   This really doesn't play well with our current model of value contents,
4a80f0
+   but could easily require a significant update in order to be supported
4a80f0
+   "correctly".
4a80f0
+
4a80f0
+   For now, we manually force the base address to be the lowest addressed
4a80f0
+   element here.  Yes, this will break some things, but it fixes other
4a80f0
+   things.  The hope is that it fixes more than it breaks.  */
4a80f0
+
4a80f0
+extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
4a80f0
+	(struct type *type, CORE_ADDR address);
4a80f0
+
4a80f0
 #endif /* F_LANG_H */
4a80f0
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
4a80f0
--- a/gdb/f-valprint.c
4a80f0
+++ b/gdb/f-valprint.c
4a80f0
@@ -35,6 +35,7 @@
4a80f0
 #include "dictionary.h"
4a80f0
 #include "cli/cli-style.h"
4a80f0
 #include "gdbarch.h"
4a80f0
+#include "f-array-walker.h"
4a80f0
 
4a80f0
 static void f77_get_dynamic_length_of_aggregate (struct type *);
4a80f0
 
4a80f0
@@ -100,100 +101,103 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
4a80f0
     * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
4a80f0
 }
4a80f0
 
4a80f0
-/* Actual function which prints out F77 arrays, Valaddr == address in 
4a80f0
-   the superior.  Address == the address in the inferior.  */
4a80f0
+/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array
4a80f0
+   walking template.  This specialisation prints Fortran arrays.  */
4a80f0
 
4a80f0
-static void
4a80f0
-f77_print_array_1 (int nss, int ndimensions, struct type *type,
4a80f0
-		   const gdb_byte *valaddr,
4a80f0
-		   int embedded_offset, CORE_ADDR address,
4a80f0
-		   struct ui_file *stream, int recurse,
4a80f0
-		   const struct value *val,
4a80f0
-		   const struct value_print_options *options,
4a80f0
-		   int *elts)
4a80f0
+class fortran_array_printer_impl : public fortran_array_walker_base_impl
4a80f0
 {
4a80f0
-  struct type *range_type = check_typedef (type)->index_type ();
4a80f0
-  CORE_ADDR addr = address + embedded_offset;
4a80f0
-  LONGEST lowerbound, upperbound;
4a80f0
-  LONGEST i;
4a80f0
-
4a80f0
-  get_discrete_bounds (range_type, &lowerbound, &upperbound);
4a80f0
-
4a80f0
-  if (nss != ndimensions)
4a80f0
-    {
4a80f0
-      struct gdbarch *gdbarch = get_type_arch (type);
4a80f0
-      size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type));
4a80f0
-      int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
4a80f0
-      size_t byte_stride = type->bit_stride () / (unit_size * 8);
4a80f0
-      if (byte_stride == 0)
4a80f0
-	byte_stride = dim_size;
4a80f0
-      size_t offs = 0;
4a80f0
-
4a80f0
-      for (i = lowerbound;
4a80f0
-	   (i < upperbound + 1 && (*elts) < options->print_max);
4a80f0
-	   i++)
4a80f0
-	{
4a80f0
-	  struct value *subarray = value_from_contents_and_address
4a80f0
-	    (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
4a80f0
-	     + offs, addr + offs);
4a80f0
-
4a80f0
-	  fprintf_filtered (stream, "(");
4a80f0
-	  f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
4a80f0
-			     value_contents_for_printing (subarray),
4a80f0
-			     value_embedded_offset (subarray),
4a80f0
-			     value_address (subarray),
4a80f0
-			     stream, recurse, subarray, options, elts);
4a80f0
-	  offs += byte_stride;
4a80f0
-	  fprintf_filtered (stream, ")");
4a80f0
-
4a80f0
-	  if (i < upperbound)
4a80f0
-	    fprintf_filtered (stream, " ");
4a80f0
-	}
4a80f0
-      if (*elts >= options->print_max && i < upperbound)
4a80f0
-	fprintf_filtered (stream, "...");
4a80f0
-    }
4a80f0
-  else
4a80f0
-    {
4a80f0
-      for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
4a80f0
-	   i++, (*elts)++)
4a80f0
-	{
4a80f0
-	  struct value *elt = value_subscript ((struct value *)val, i);
4a80f0
-
4a80f0
-	  common_val_print (elt, stream, recurse, options, current_language);
4a80f0
-
4a80f0
-	  if (i != upperbound)
4a80f0
-	    fprintf_filtered (stream, ", ");
4a80f0
-
4a80f0
-	  if ((*elts == options->print_max - 1)
4a80f0
-	      && (i != upperbound))
4a80f0
-	    fprintf_filtered (stream, "...");
4a80f0
-	}
4a80f0
-    }
4a80f0
-}
4a80f0
+public:
4a80f0
+  /* Constructor.  TYPE is the array type being printed, ADDRESS is the
4a80f0
+     address in target memory for the object of TYPE being printed.  VAL is
4a80f0
+     the GDB value (of TYPE) being printed.  STREAM is where to print to,
4a80f0
+     RECOURSE is passed through (and prevents infinite recursion), and
4a80f0
+     OPTIONS are the printing control options.  */
4a80f0
+  explicit fortran_array_printer_impl (struct type *type,
4a80f0
+				       CORE_ADDR address,
4a80f0
+				       struct value *val,
4a80f0
+				       struct ui_file *stream,
4a80f0
+				       int recurse,
4a80f0
+				       const struct value_print_options *options)
4a80f0
+    : m_elts (0),
4a80f0
+      m_val (val),
4a80f0
+      m_stream (stream),
4a80f0
+      m_recurse (recurse),
4a80f0
+      m_options (options)
4a80f0
+  { /* Nothing.  */ }
4a80f0
+
4a80f0
+  /* Called while iterating over the array bounds.  When SHOULD_CONTINUE is
4a80f0
+     false then we must return false, as we have reached the end of the
4a80f0
+     array bounds for this dimension.  However, we also return false if we
4a80f0
+     have printed too many elements (after printing '...').  In all other
4a80f0
+     cases, return true.  */
4a80f0
+  bool continue_walking (bool should_continue)
4a80f0
+  {
4a80f0
+    bool cont = should_continue && (m_elts < m_options->print_max);
4a80f0
+    if (!cont && should_continue)
4a80f0
+      fputs_filtered ("...", m_stream);
4a80f0
+    return cont;
4a80f0
+  }
4a80f0
+
4a80f0
+  /* Called when we start iterating over a dimension.  If it's not the
4a80f0
+     inner most dimension then print an opening '(' character.  */
4a80f0
+  void start_dimension (bool inner_p)
4a80f0
+  {
4a80f0
+    fputs_filtered ("(", m_stream);
4a80f0
+  }
4a80f0
+
4a80f0
+  /* Called when we finish processing a batch of items within a dimension
4a80f0
+     of the array.  Depending on whether this is the inner most dimension
4a80f0
+     or not we print different things, but this is all about adding
4a80f0
+     separators between elements, and dimensions of the array.  */
4a80f0
+  void finish_dimension (bool inner_p, bool last_p)
4a80f0
+  {
4a80f0
+    fputs_filtered (")", m_stream);
4a80f0
+    if (!last_p)
4a80f0
+      fputs_filtered (" ", m_stream);
4a80f0
+  }
4a80f0
+
4a80f0
+  /* Called to process an element of ELT_TYPE at offset ELT_OFF from the
4a80f0
+     start of the parent object.  */
4a80f0
+  void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
4a80f0
+  {
4a80f0
+    /* Extract the element value from the parent value.  */
4a80f0
+    struct value *e_val
4a80f0
+      = value_from_component (m_val, elt_type, elt_off);
4a80f0
+    common_val_print (e_val, m_stream, m_recurse, m_options, current_language);
4a80f0
+    if (!last_p)
4a80f0
+      fputs_filtered (", ", m_stream);
4a80f0
+    ++m_elts;
4a80f0
+  }
4a80f0
+
4a80f0
+private:
4a80f0
+  /* The number of elements printed so far.  */
4a80f0
+  int m_elts;
4a80f0
+
4a80f0
+  /* The value from which we are printing elements.  */
4a80f0
+  struct value *m_val;
4a80f0
+
4a80f0
+  /* The stream we should print too.  */
4a80f0
+  struct ui_file *m_stream;
4a80f0
+
4a80f0
+  /* The recursion counter, passed through when we print each element.  */
4a80f0
+  int m_recurse;
4a80f0
+
4a80f0
+  /* The print control options.  Gives us the maximum number of elements to
4a80f0
+     print, and is passed through to each element that we print.  */
4a80f0
+  const struct value_print_options *m_options = nullptr;
4a80f0
+};
4a80f0
 
4a80f0
-/* This function gets called to print an F77 array, we set up some 
4a80f0
-   stuff and then immediately call f77_print_array_1().  */
4a80f0
+/* This function gets called to print a Fortran array.  */
4a80f0
 
4a80f0
 static void
4a80f0
-f77_print_array (struct type *type, const gdb_byte *valaddr,
4a80f0
-		 int embedded_offset,
4a80f0
-		 CORE_ADDR address, struct ui_file *stream,
4a80f0
-		 int recurse,
4a80f0
-		 const struct value *val,
4a80f0
-		 const struct value_print_options *options)
4a80f0
+fortran_print_array (struct type *type, CORE_ADDR address,
4a80f0
+		     struct ui_file *stream, int recurse,
4a80f0
+		     const struct value *val,
4a80f0
+		     const struct value_print_options *options)
4a80f0
 {
4a80f0
-  int ndimensions;
4a80f0
-  int elts = 0;
4a80f0
-
4a80f0
-  ndimensions = calc_f77_array_dims (type);
4a80f0
-
4a80f0
-  if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
4a80f0
-    error (_("\
4a80f0
-Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
4a80f0
-	   ndimensions, MAX_FORTRAN_DIMS);
4a80f0
-
4a80f0
-  f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
4a80f0
-		     address, stream, recurse, val, options, &elts);
4a80f0
+  fortran_array_walker<fortran_array_printer_impl> p
4a80f0
+    (type, address, (struct value *) val, stream, recurse, options);
4a80f0
+  p.walk ();
4a80f0
 }
4a80f0
 
4a80f0
 
4a80f0
@@ -236,12 +240,7 @@ f_value_print_inner (struct value *val, struct ui_file *stream, int recurse,
4a80f0
 
4a80f0
     case TYPE_CODE_ARRAY:
4a80f0
       if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR)
4a80f0
-	{
4a80f0
-	  fprintf_filtered (stream, "(");
4a80f0
-	  f77_print_array (type, valaddr, 0,
4a80f0
-			   address, stream, recurse, val, options);
4a80f0
-	  fprintf_filtered (stream, ")");
4a80f0
-	}
4a80f0
+	fortran_print_array (type, address, stream, recurse, val, options);
4a80f0
       else
4a80f0
 	{
4a80f0
 	  struct type *ch_type = TYPE_TARGET_TYPE (type);
4a80f0
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
4a80f0
--- a/gdb/gdbtypes.c
4a80f0
+++ b/gdb/gdbtypes.c
4a80f0
@@ -39,6 +39,7 @@
4a80f0
 #include "dwarf2/loc.h"
4a80f0
 #include "gdbcore.h"
4a80f0
 #include "floatformat.h"
4a80f0
+#include "f-lang.h"
4a80f0
 #include <algorithm>
4a80f0
 
4a80f0
 /* Initialize BADNESS constants.  */
4a80f0
@@ -2695,7 +2696,16 @@ resolve_dynamic_type_internal (struct type *type,
4a80f0
   prop = TYPE_DATA_LOCATION (resolved_type);
4a80f0
   if (prop != NULL
4a80f0
       && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
4a80f0
-    prop->set_const_val (value);
4a80f0
+    {
4a80f0
+      /* Start of Fortran hack.  See comment in f-lang.h for what is going
4a80f0
+	 on here.*/
4a80f0
+      if (current_language->la_language == language_fortran
4a80f0
+	  && resolved_type->code () == TYPE_CODE_ARRAY)
4a80f0
+	value = fortran_adjust_dynamic_array_base_address_hack (resolved_type,
4a80f0
+								value);
4a80f0
+      /* End of Fortran hack.  */
4a80f0
+      prop->set_const_val (value);
4a80f0
+    }
4a80f0
 
4a80f0
   return resolved_type;
4a80f0
 }
4a80f0
@@ -3600,9 +3610,11 @@ is_scalar_type_recursive (struct type *t)
4a80f0
       LONGEST low_bound, high_bound;
4a80f0
       struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (t));
4a80f0
 
4a80f0
-      get_discrete_bounds (t->index_type (), &low_bound, &high_bound);
4a80f0
-
4a80f0
-      return high_bound == low_bound && is_scalar_type_recursive (elt_type);
4a80f0
+      if (get_discrete_bounds (t->index_type (), &low_bound, &high_bound))
4a80f0
+	return (high_bound == low_bound
4a80f0
+	        && is_scalar_type_recursive (elt_type));
4a80f0
+      else
4a80f0
+	return 0;
4a80f0
     }
4a80f0
   /* Are we dealing with a struct with one element?  */
4a80f0
   else if (t->code () == TYPE_CODE_STRUCT && t->num_fields () == 1)
4a80f0
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
4a80f0
new file mode 100644
4a80f0
--- /dev/null
4a80f0
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
4a80f0
@@ -0,0 +1,69 @@
4a80f0
+# Copyright 2020 Free Software Foundation, Inc.
4a80f0
+
4a80f0
+# This program is free software; you can redistribute it and/or modify
4a80f0
+# it under the terms of the GNU General Public License as published by
4a80f0
+# the Free Software Foundation; either version 3 of the License, or
4a80f0
+# (at your option) any later version.
4a80f0
+#
4a80f0
+# This program is distributed in the hope that it will be useful,
4a80f0
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
4a80f0
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
4a80f0
+# GNU General Public License for more details.
4a80f0
+#
4a80f0
+# You should have received a copy of the GNU General Public License
4a80f0
+# along with this program.  If not, see <http://www.gnu.org/licenses/> .
4a80f0
+
4a80f0
+# Test invalid element and slice array accesses.
4a80f0
+
4a80f0
+if {[skip_fortran_tests]} { return -1 }
4a80f0
+
4a80f0
+standard_testfile ".f90"
4a80f0
+load_lib fortran.exp
4a80f0
+
4a80f0
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
4a80f0
+	 {debug f90}]} {
4a80f0
+    return -1
4a80f0
+}
4a80f0
+
4a80f0
+if ![fortran_runto_main] {
4a80f0
+    untested "could not run to main"
4a80f0
+    return -1
4a80f0
+}
4a80f0
+
4a80f0
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
4a80f0
+gdb_breakpoint [gdb_get_line_number "First Breakpoint"]
4a80f0
+gdb_breakpoint [gdb_get_line_number "Second Breakpoint"]
4a80f0
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
4a80f0
+
4a80f0
+gdb_continue_to_breakpoint "First Breakpoint"
4a80f0
+
4a80f0
+# Access not yet allocated array.
4a80f0
+gdb_test "print other" " = <not allocated>"
4a80f0
+gdb_test "print other(0:4,2:3)" "array not allocated"
4a80f0
+gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)"
4a80f0
+
4a80f0
+# Access not yet associated pointer.
4a80f0
+gdb_test "print pointer2d" " = <not associated>"
4a80f0
+gdb_test "print pointer2d(1:2,1:2)" "array not associated"
4a80f0
+gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)"
4a80f0
+
4a80f0
+gdb_continue_to_breakpoint "Second Breakpoint"
4a80f0
+
4a80f0
+# Accessing just outside the arrays.
4a80f0
+foreach name {array pointer2d other} {
4a80f0
+    gdb_test "print $name (0:,:)" "array subscript out of bounds"
4a80f0
+    gdb_test "print $name (:11,:)" "array subscript out of bounds"
4a80f0
+    gdb_test "print $name (:,0:)" "array subscript out of bounds"
4a80f0
+    gdb_test "print $name (:,:11)" "array subscript out of bounds"
4a80f0
+
4a80f0
+    gdb_test "print $name (0,:)" "no such vector element"
4a80f0
+    gdb_test "print $name (11,:)" "no such vector element"
4a80f0
+    gdb_test "print $name (:,0)" "no such vector element"
4a80f0
+    gdb_test "print $name (:,11)" "no such vector element"
4a80f0
+}
4a80f0
+
4a80f0
+# Stride in the wrong direction.
4a80f0
+gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination"
4a80f0
+gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination"
4a80f0
+gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination"
4a80f0
+gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination"
4a80f0
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
4a80f0
new file mode 100644
4a80f0
--- /dev/null
4a80f0
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
4a80f0
@@ -0,0 +1,42 @@
4a80f0
+! Copyright 2020 Free Software Foundation, Inc.
4a80f0
+!
4a80f0
+! This program is free software; you can redistribute it and/or modify
4a80f0
+! it under the terms of the GNU General Public License as published by
4a80f0
+! the Free Software Foundation; either version 3 of the License, or
4a80f0
+! (at your option) any later version.
4a80f0
+!
4a80f0
+! This program is distributed in the hope that it will be useful,
4a80f0
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
4a80f0
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
4a80f0
+! GNU General Public License for more details.
4a80f0
+!
4a80f0
+! You should have received a copy of the GNU General Public License
4a80f0
+! along with this program.  If not, see <http://www.gnu.org/licenses/>.
4a80f0
+
4a80f0
+!
4a80f0
+! Start of test program.
4a80f0
+!
4a80f0
+program test
4a80f0
+
4a80f0
+  ! Declare variables used in this test.
4a80f0
+  integer, dimension (1:10,1:10) :: array
4a80f0
+  integer, allocatable :: other (:, :)
4a80f0
+  integer, dimension(:,:), pointer :: pointer2d => null()
4a80f0
+  integer, dimension(1:10,1:10), target :: tarray
4a80f0
+
4a80f0
+  print *, "" ! First Breakpoint.
4a80f0
+
4a80f0
+  ! Allocate or associate any variables as needed.
4a80f0
+  allocate (other (1:10, 1:10))
4a80f0
+  pointer2d => tarray
4a80f0
+  array = 0
4a80f0
+
4a80f0
+  print *, "" ! Second Breakpoint.
4a80f0
+
4a80f0
+  ! All done.  Deallocate.
4a80f0
+  deallocate (other)
4a80f0
+
4a80f0
+  ! GDB catches this final breakpoint to indicate the end of the test.
4a80f0
+  print *, "" ! Final Breakpoint.
4a80f0
+
4a80f0
+end program test
4a80f0
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
4a80f0
new file mode 100644
4a80f0
--- /dev/null
4a80f0
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
4a80f0
@@ -0,0 +1,111 @@
4a80f0
+# Copyright 2020 Free Software Foundation, Inc.
4a80f0
+
4a80f0
+# This program is free software; you can redistribute it and/or modify
4a80f0
+# it under the terms of the GNU General Public License as published by
4a80f0
+# the Free Software Foundation; either version 3 of the License, or
4a80f0
+# (at your option) any later version.
4a80f0
+#
4a80f0
+# This program is distributed in the hope that it will be useful,
4a80f0
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
4a80f0
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
4a80f0
+# GNU General Public License for more details.
4a80f0
+#
4a80f0
+# You should have received a copy of the GNU General Public License
4a80f0
+# along with this program.  If not, see <http://www.gnu.org/licenses/> .
4a80f0
+
4a80f0
+# Create a slice of an array, then take a slice of that slice.
4a80f0
+
4a80f0
+if {[skip_fortran_tests]} { return -1 }
4a80f0
+
4a80f0
+standard_testfile ".f90"
4a80f0
+load_lib fortran.exp
4a80f0
+
4a80f0
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
4a80f0
+	 {debug f90}]} {
4a80f0
+    return -1
4a80f0
+}
4a80f0
+
4a80f0
+if ![fortran_runto_main] {
4a80f0
+    untested "could not run to main"
4a80f0
+    return -1
4a80f0
+}
4a80f0
+
4a80f0
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
4a80f0
+gdb_breakpoint [gdb_get_line_number "Stop Here"]
4a80f0
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
4a80f0
+
4a80f0
+# We're going to print some reasonably large arrays.
4a80f0
+gdb_test_no_output "set print elements unlimited"
4a80f0
+
4a80f0
+gdb_continue_to_breakpoint "Stop Here"
4a80f0
+
4a80f0
+# Print a slice, capture the convenience variable name created.
4a80f0
+set cmd "print array (1:10:2, 1:10:2)"
4a80f0
+gdb_test_multiple $cmd $cmd {
4a80f0
+    -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" {
4a80f0
+	set varname "\$$expect_out(1,string)"
4a80f0
+    }
4a80f0
+}
4a80f0
+
4a80f0
+# Now check that we can correctly extract all the elements from this
4a80f0
+# slice.
4a80f0
+for { set j 1 } { $j < 6 } { incr j } {
4a80f0
+    for { set i 1 } { $i < 6 } { incr i } {
4a80f0
+	set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1]
4a80f0
+	gdb_test "print ${varname} ($i,$j)" " = $val"
4a80f0
+    }
4a80f0
+}
4a80f0
+
4a80f0
+# Now take a slice of the slice.
4a80f0
+gdb_test "print ${varname} (3:5, 3:5)" \
4a80f0
+    " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)"
4a80f0
+
4a80f0
+# Now take a different slice of a slice.
4a80f0
+set cmd "print ${varname} (1:5:2, 1:5:2)"
4a80f0
+gdb_test_multiple $cmd $cmd {
4a80f0
+    -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" {
4a80f0
+	set varname "\$$expect_out(1,string)"
4a80f0
+	pass $gdb_test_name
4a80f0
+    }
4a80f0
+}
4a80f0
+
4a80f0
+# Now take a slice from the slice, of a slice!
4a80f0
+set cmd "print ${varname} (1:3:2, 1:3:2)"
4a80f0
+gdb_test_multiple $cmd $cmd {
4a80f0
+    -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" {
4a80f0
+	set varname "\$$expect_out(1,string)"
4a80f0
+	pass $gdb_test_name
4a80f0
+    }
4a80f0
+}
4a80f0
+
4a80f0
+# And again!
4a80f0
+set cmd "print ${varname} (1:2:2, 1:2:2)"
4a80f0
+gdb_test_multiple $cmd $cmd {
4a80f0
+    -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" {
4a80f0
+	set varname "\$$expect_out(1,string)"
4a80f0
+	pass $gdb_test_name
4a80f0
+    }
4a80f0
+}
4a80f0
+
4a80f0
+# Test taking a slice with stride of a string.  This isn't actually
4a80f0
+# supported within gfortran (at least), but naturally drops out of how
4a80f0
+# GDB models arrays and strings in a similar way, so we may as well
4a80f0
+# test that this is still working.
4a80f0
+gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'"
4a80f0
+gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'"
4a80f0
+gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'"
4a80f0
+
4a80f0
+# Now test the memory requirements of taking a slice from an array.
4a80f0
+# The idea is that we shouldn't require more memory to extract a slice
4a80f0
+# than the size of the slice.
4a80f0
+#
4a80f0
+# This will only work if array repacking is turned on, otherwise GDB
4a80f0
+# will create the slice by generating a new type that sits over the
4a80f0
+# existing value in memory.
4a80f0
+gdb_test_no_output "set fortran repack-array-slices on"
4a80f0
+set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"]
4a80f0
+set slice_size [expr $element_size * 4]
4a80f0
+gdb_test_no_output "set max-value-size $slice_size"
4a80f0
+gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)"
4a80f0
+gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)"
4a80f0
+gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)"
4a80f0
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
4a80f0
new file mode 100644
4a80f0
--- /dev/null
4a80f0
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
4a80f0
@@ -0,0 +1,96 @@
4a80f0
+! Copyright 2020 Free Software Foundation, Inc.
4a80f0
+!
4a80f0
+! This program is free software; you can redistribute it and/or modify
4a80f0
+! it under the terms of the GNU General Public License as published by
4a80f0
+! the Free Software Foundation; either version 3 of the License, or
4a80f0
+! (at your option) any later version.
4a80f0
+!
4a80f0
+! This program is distributed in the hope that it will be useful,
4a80f0
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
4a80f0
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
4a80f0
+! GNU General Public License for more details.
4a80f0
+!
4a80f0
+! You should have received a copy of the GNU General Public License
4a80f0
+! along with this program.  If not, see <http://www.gnu.org/licenses/>.
4a80f0
+
4a80f0
+!
4a80f0
+! Start of test program.
4a80f0
+!
4a80f0
+program test
4a80f0
+  integer, dimension (1:10,1:11) :: array
4a80f0
+  character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz"
4a80f0
+
4a80f0
+  call fill_array_2d (array)
4a80f0
+
4a80f0
+  ! GDB catches this final breakpoint to indicate the end of the test.
4a80f0
+  print *, "" ! Stop Here
4a80f0
+
4a80f0
+  print *, array
4a80f0
+  print *, str
4a80f0
+
4a80f0
+  ! GDB catches this final breakpoint to indicate the end of the test.
4a80f0
+  print *, "" ! Final Breakpoint.
4a80f0
+
4a80f0
+contains
4a80f0
+
4a80f0
+  ! Fill a 1D array with a unique positive integer in each element.
4a80f0
+  subroutine fill_array_1d (array)
4a80f0
+    integer, dimension (:) :: array
4a80f0
+    integer :: counter
4a80f0
+
4a80f0
+    counter = 1
4a80f0
+    do j=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+       array (j) = counter
4a80f0
+       counter = counter + 1
4a80f0
+    end do
4a80f0
+  end subroutine fill_array_1d
4a80f0
+
4a80f0
+  ! Fill a 2D array with a unique positive integer in each element.
4a80f0
+  subroutine fill_array_2d (array)
4a80f0
+    integer, dimension (:,:) :: array
4a80f0
+    integer :: counter
4a80f0
+
4a80f0
+    counter = 1
4a80f0
+    do i=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
+       do j=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+          array (j,i) = counter
4a80f0
+          counter = counter + 1
4a80f0
+       end do
4a80f0
+    end do
4a80f0
+  end subroutine fill_array_2d
4a80f0
+
4a80f0
+  ! Fill a 3D array with a unique positive integer in each element.
4a80f0
+  subroutine fill_array_3d (array)
4a80f0
+    integer, dimension (:,:,:) :: array
4a80f0
+    integer :: counter
4a80f0
+
4a80f0
+    counter = 1
4a80f0
+    do i=LBOUND (array, 3), UBOUND (array, 3), 1
4a80f0
+       do j=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
+          do k=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+             array (k, j,i) = counter
4a80f0
+             counter = counter + 1
4a80f0
+          end do
4a80f0
+       end do
4a80f0
+    end do
4a80f0
+  end subroutine fill_array_3d
4a80f0
+
4a80f0
+  ! Fill a 4D array with a unique positive integer in each element.
4a80f0
+  subroutine fill_array_4d (array)
4a80f0
+    integer, dimension (:,:,:,:) :: array
4a80f0
+    integer :: counter
4a80f0
+
4a80f0
+    counter = 1
4a80f0
+    do i=LBOUND (array, 4), UBOUND (array, 4), 1
4a80f0
+       do j=LBOUND (array, 3), UBOUND (array, 3), 1
4a80f0
+          do k=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
+             do l=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+                array (l, k, j,i) = counter
4a80f0
+                counter = counter + 1
4a80f0
+             end do
4a80f0
+          end do
4a80f0
+       end do
4a80f0
+    end do
4a80f0
+    print *, ""
4a80f0
+  end subroutine fill_array_4d
4a80f0
+end program test
4a80f0
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
4a80f0
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
4a80f0
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
4a80f0
@@ -18,6 +18,21 @@
4a80f0
 # the subroutine.  This should exercise GDB's ability to handle
4a80f0
 # different strides for the different dimensions.
4a80f0
 
4a80f0
+# Testing GDB's ability to print array (and string) slices, including
4a80f0
+# slices that make use of array strides.
4a80f0
+#
4a80f0
+# In the Fortran code various arrays of different ranks are filled
4a80f0
+# with data, and slices are passed to a series of show functions.
4a80f0
+#
4a80f0
+# In this test script we break in each of the show functions, print
4a80f0
+# the array slice that was passed in, and then move up the stack to
4a80f0
+# the parent frame and check GDB can manually extract the same slice.
4a80f0
+#
4a80f0
+# This test also checks that the size of the array slice passed to the
4a80f0
+# function (so as extracted and described by the compiler and the
4a80f0
+# debug information) matches the size of the slice manually extracted
4a80f0
+# by GDB.
4a80f0
+
4a80f0
 if {[skip_fortran_tests]} { return -1 }
4a80f0
 
4a80f0
 standard_testfile ".f90"
4a80f0
@@ -28,57 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
4a80f0
     return -1
4a80f0
 }
4a80f0
 
4a80f0
-if ![fortran_runto_main] {
4a80f0
-    untested "could not run to main"
4a80f0
-    return -1
4a80f0
+# Takes the name of an array slice as used in the test source, and extracts
4a80f0
+# the base array name.  For example: 'array (1,2)' becomes 'array'.
4a80f0
+proc array_slice_to_var { slice_str } {
4a80f0
+    regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname
4a80f0
+    return $varname
4a80f0
 }
4a80f0
 
4a80f0
-gdb_breakpoint "show"
4a80f0
-gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
4a80f0
-
4a80f0
-set array_contents \
4a80f0
-    [list \
4a80f0
-	 " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
4a80f0
-	 " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
4a80f0
-	 " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
4a80f0
-	 " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
4a80f0
-	 " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
4a80f0
-	 " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
4a80f0
-	 " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
4a80f0
-	 " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
4a80f0
-
4a80f0
-set message_strings \
4a80f0
-    [list \
4a80f0
-	 " = 'array'" \
4a80f0
-	 " = 'array \\(1:5,1:5\\)'" \
4a80f0
-	 " = 'array \\(1:10:2,1:10:2\\)'" \
4a80f0
-	 " = 'array \\(1:10:3,1:10:2\\)'" \
4a80f0
-	 " = 'array \\(1:10:5,1:10:3\\)'" ]
4a80f0
-
4a80f0
-set i 0
4a80f0
-foreach result $array_contents msg $message_strings {
4a80f0
-    incr i
4a80f0
-    with_test_prefix "test $i" {
4a80f0
-	gdb_continue_to_breakpoint "show"
4a80f0
-	gdb_test "p array" $result
4a80f0
-	gdb_test "p message" "$msg"
4a80f0
+proc run_test { repack } {
4a80f0
+    global binfile gdb_prompt
4a80f0
+
4a80f0
+    clean_restart ${binfile}
4a80f0
+
4a80f0
+    if ![fortran_runto_main] {
4a80f0
+	untested "could not run to main"
4a80f0
+	return -1
4a80f0
     }
4a80f0
-}
4a80f0
 
4a80f0
-gdb_continue_to_breakpoint "continue to Final Breakpoint"
4a80f0
+    gdb_test_no_output "set fortran repack-array-slices $repack"
4a80f0
+
4a80f0
+    # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
4a80f0
+    gdb_breakpoint [gdb_get_line_number "Display Element"]
4a80f0
+    gdb_breakpoint [gdb_get_line_number "Display String"]
4a80f0
+    gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"]
4a80f0
+    gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"]
4a80f0
+    gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"]
4a80f0
+    gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"]
4a80f0
+    gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
4a80f0
+
4a80f0
+    # We're going to print some reasonably large arrays.
4a80f0
+    gdb_test_no_output "set print elements unlimited"
4a80f0
+
4a80f0
+    set found_final_breakpoint false
4a80f0
+
4a80f0
+    # We place a limit on the number of tests that can be run, just in
4a80f0
+    # case something goes wrong, and GDB gets stuck in an loop here.
4a80f0
+    set test_count 0
4a80f0
+    while { $test_count < 500 } {
4a80f0
+	with_test_prefix "test $test_count" {
4a80f0
+	    incr test_count
4a80f0
+
4a80f0
+	    set found_final_breakpoint false
4a80f0
+	    set expected_result ""
4a80f0
+	    set func_name ""
4a80f0
+	    gdb_test_multiple "continue" "continue" {
4a80f0
+		-re ".*GDB = (\[^\r\n\]+)\r\n" {
4a80f0
+		    set expected_result $expect_out(1,string)
4a80f0
+		    exp_continue
4a80f0
+		}
4a80f0
+		-re "! Display Element" {
4a80f0
+		    set func_name "show_elem"
4a80f0
+		    exp_continue
4a80f0
+		}
4a80f0
+		-re "! Display String" {
4a80f0
+		    set func_name "show_str"
4a80f0
+		    exp_continue
4a80f0
+		}
4a80f0
+		-re "! Display Array Slice (.)D" {
4a80f0
+		    set func_name "show_$expect_out(1,string)d"
4a80f0
+		    exp_continue
4a80f0
+		}
4a80f0
+		-re "! Final Breakpoint" {
4a80f0
+		    set found_final_breakpoint true
4a80f0
+		    exp_continue
4a80f0
+		}
4a80f0
+		-re "$gdb_prompt $" {
4a80f0
+		    # We're done.
4a80f0
+		}
4a80f0
+	    }
4a80f0
 
4a80f0
-# Next test that asking for an array with stride at the CLI gives an
4a80f0
-# error.
4a80f0
-clean_restart ${testfile}
4a80f0
+	    if ($found_final_breakpoint) {
4a80f0
+		break
4a80f0
+	    }
4a80f0
 
4a80f0
-if ![fortran_runto_main] then {
4a80f0
-    perror "couldn't run to main"
4a80f0
-    continue
4a80f0
+	    # We want to take a look at the line in the previous frame that
4a80f0
+	    # called the current function.  I couldn't find a better way of
4a80f0
+	    # doing this than 'up', which will print the line, then 'down'
4a80f0
+	    # again.
4a80f0
+	    #
4a80f0
+	    # I don't want to fill the log with passes for these up/down
4a80f0
+	    # commands, so we don't report any.  If something goes wrong then we
4a80f0
+	    # should get a fail from gdb_test_multiple.
4a80f0
+	    set array_slice_name ""
4a80f0
+	    set unique_id ""
4a80f0
+	    array unset replacement_vars
4a80f0
+	    array set replacement_vars {}
4a80f0
+	    gdb_test_multiple "up" "up" {
4a80f0
+		-re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" {
4a80f0
+		    set array_slice_name $expect_out(1,string)
4a80f0
+		}
4a80f0
+		-re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" {
4a80f0
+		    set array_slice_name $expect_out(1,string)
4a80f0
+		    set unique_id $expect_out(2,string)
4a80f0
+		}
4a80f0
+	    }
4a80f0
+	    if {$unique_id != ""} {
4a80f0
+		set str ""
4a80f0
+		foreach v [split $unique_id ,] {
4a80f0
+		    set val [get_integer_valueof "${v}" "??"\
4a80f0
+				 "get variable '$v' for '$array_slice_name'"]
4a80f0
+		    set replacement_vars($v) $val
4a80f0
+		    if {$str != ""} {
4a80f0
+			set str "Str,"
4a80f0
+		    }
4a80f0
+		    set str "$str$v=$val"
4a80f0
+		}
4a80f0
+		set unique_id " $str"
4a80f0
+	    }
4a80f0
+	    gdb_test_multiple "down" "down" {
4a80f0
+		-re "\r\n$gdb_prompt $" {
4a80f0
+		    # Don't issue a pass here.
4a80f0
+		}
4a80f0
+	    }
4a80f0
+
4a80f0
+	    # Check we have all the information we need to successfully run one
4a80f0
+	    # of these tests.
4a80f0
+	    if { $expected_result == "" } {
4a80f0
+		perror "failed to extract expected results"
4a80f0
+		return 0
4a80f0
+	    }
4a80f0
+	    if { $array_slice_name == "" } {
4a80f0
+		perror "failed to extract array slice name"
4a80f0
+		return 0
4a80f0
+	    }
4a80f0
+
4a80f0
+	    # Check GDB can correctly print the array slice that was passed into
4a80f0
+	    # the current frame.
4a80f0
+	    set pattern [string_to_regexp " = $expected_result"]
4a80f0
+	    gdb_test "p array" "$pattern" \
4a80f0
+		"check value of '$array_slice_name'$unique_id"
4a80f0
+
4a80f0
+	    # Get the size of the slice.
4a80f0
+	    set size_in_show \
4a80f0
+		[get_integer_valueof "sizeof (array)" "show_unknown" \
4a80f0
+		     "get sizeof '$array_slice_name'$unique_id in show"]
4a80f0
+	    set addr_in_show \
4a80f0
+		[get_hexadecimal_valueof "&array" "show_unknown" \
4a80f0
+		     "get address '$array_slice_name'$unique_id in show"]
4a80f0
+
4a80f0
+	    # Now move into the previous frame, and see if GDB can extract the
4a80f0
+	    # array slice from the original parent object.  Again, use of
4a80f0
+	    # gdb_test_multiple to avoid filling the logs with unnecessary
4a80f0
+	    # passes.
4a80f0
+	    gdb_test_multiple "up" "up" {
4a80f0
+		-re "\r\n$gdb_prompt $" {
4a80f0
+		    # Do nothing.
4a80f0
+		}
4a80f0
+	    }
4a80f0
+
4a80f0
+	    # Print the array slice, this will force GDB to manually extract the
4a80f0
+	    # slice from the parent array.
4a80f0
+	    gdb_test "p $array_slice_name" "$pattern" \
4a80f0
+		"check array slice '$array_slice_name'$unique_id can be extracted"
4a80f0
+
4a80f0
+	    # Get the size of the slice in the calling frame.
4a80f0
+	    set size_in_parent \
4a80f0
+		[get_integer_valueof "sizeof ($array_slice_name)" \
4a80f0
+		     "parent_unknown" \
4a80f0
+		     "get sizeof '$array_slice_name'$unique_id in parent"]
4a80f0
+
4a80f0
+	    # Figure out the start and end addresses of the full array in the
4a80f0
+	    # parent frame.
4a80f0
+	    set full_var_name [array_slice_to_var $array_slice_name]
4a80f0
+	    set start_addr [get_hexadecimal_valueof "&${full_var_name}" \
4a80f0
+				"start unknown"]
4a80f0
+	    set end_addr [get_hexadecimal_valueof \
4a80f0
+			      "(&${full_var_name}) + sizeof (${full_var_name})" \
4a80f0
+			      "end unknown"]
4a80f0
+
4a80f0
+	    # The Fortran compiler can choose to either send a descriptor that
4a80f0
+	    # describes the array slice to the subroutine, or it can repack the
4a80f0
+	    # slice into an array section and send that.
4a80f0
+	    #
4a80f0
+	    # We find the address range of the original array in the parent,
4a80f0
+	    # and the address of the slice in the show function, if the
4a80f0
+	    # address of the slice (from show) is in the range of the original
4a80f0
+	    # array then repacking has not occurred, otherwise, the slice is
4a80f0
+	    # outside of the parent, and repacking must have occurred.
4a80f0
+	    #
4a80f0
+	    # The goal here is to compare the sizes of the slice in show with
4a80f0
+	    # the size of the slice extracted by GDB.  So we can only compare
4a80f0
+	    # sizes when GDB's repacking setting matches the repacking
4a80f0
+	    # behaviour we got from the compiler.
4a80f0
+	    if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \
4a80f0
+		 == ($repack == "on") } {
4a80f0
+		gdb_assert {$size_in_show == $size_in_parent} \
4a80f0
+		    "check sizes match"
4a80f0
+	    } elseif { $repack == "off" } {
4a80f0
+		# GDB's repacking is off (so slices are left unpacked), but
4a80f0
+		# the compiler did pack this one.  As a result we can't
4a80f0
+		# compare the sizes between the compiler's slice and GDB's
4a80f0
+		# slice.
4a80f0
+		verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared"
4a80f0
+	    } else {
4a80f0
+		# Like the above, but the reverse, GDB's repacking is on, but
4a80f0
+		# the compiler didn't repack this slice.
4a80f0
+		verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared"
4a80f0
+	    }
4a80f0
+
4a80f0
+	    # If the array name we just tested included variable names, then
4a80f0
+	    # test again with all the variables expanded.
4a80f0
+	    if {$unique_id != ""} {
4a80f0
+		foreach v [array names replacement_vars] {
4a80f0
+		    set val $replacement_vars($v)
4a80f0
+		    set array_slice_name \
4a80f0
+			[regsub "\\y${v}\\y" $array_slice_name $val]
4a80f0
+		}
4a80f0
+		gdb_test "p $array_slice_name" "$pattern" \
4a80f0
+		    "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded"
4a80f0
+	    }
4a80f0
+	}
4a80f0
+    }
4a80f0
+
4a80f0
+    # Ensure we reached the final breakpoint.  If more tests have been added
4a80f0
+    # to the test script, and this starts failing, then the safety 'while'
4a80f0
+    # loop above might need to be increased.
4a80f0
+    gdb_assert {$found_final_breakpoint} "ran all tests"
4a80f0
 }
4a80f0
 
4a80f0
-gdb_breakpoint "show"
4a80f0
-gdb_continue_to_breakpoint "show"
4a80f0
-gdb_test "up" ".*"
4a80f0
-gdb_test "p array (1:10:2, 1:10:2)" \
4a80f0
-    "Fortran array strides are not currently supported" \
4a80f0
-    "using array stride gives an error"
4a80f0
+foreach_with_prefix repack { on off } {
4a80f0
+    run_test $repack
4a80f0
+}
4a80f0
diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
4a80f0
--- a/gdb/testsuite/gdb.fortran/array-slices.f90
4a80f0
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
4a80f0
@@ -13,58 +13,368 @@
4a80f0
 ! You should have received a copy of the GNU General Public License
4a80f0
 ! along with this program.  If not, see <http://www.gnu.org/licenses/>.
4a80f0
 
4a80f0
-subroutine show (message, array)
4a80f0
-  character (len=*) :: message
4a80f0
+subroutine show_elem (array)
4a80f0
+  integer :: array
4a80f0
+
4a80f0
+  print *, ""
4a80f0
+  print *, "Expected GDB Output:"
4a80f0
+  print *, ""
4a80f0
+
4a80f0
+  write(*, fmt="(A)", advance="no") "GDB = "
4a80f0
+  write(*, fmt="(I0)", advance="no") array
4a80f0
+  write(*, fmt="(A)", advance="yes") ""
4a80f0
+
4a80f0
+  print *, ""	! Display Element
4a80f0
+end subroutine show_elem
4a80f0
+
4a80f0
+subroutine show_str (array)
4a80f0
+  character (len=*) :: array
4a80f0
+
4a80f0
+  print *, ""
4a80f0
+  print *, "Expected GDB Output:"
4a80f0
+  print *, ""
4a80f0
+  write (*, fmt="(A)", advance="no") "GDB = '"
4a80f0
+  write (*, fmt="(A)", advance="no") array
4a80f0
+  write (*, fmt="(A)", advance="yes") "'"
4a80f0
+
4a80f0
+  print *, ""	! Display String
4a80f0
+end subroutine show_str
4a80f0
+
4a80f0
+subroutine show_1d (array)
4a80f0
+  integer, dimension (:) :: array
4a80f0
+
4a80f0
+  print *, "Array Contents:"
4a80f0
+  print *, ""
4a80f0
+
4a80f0
+  do i=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+     write(*, fmt="(i4)", advance="no") array (i)
4a80f0
+  end do
4a80f0
+
4a80f0
+  print *, ""
4a80f0
+  print *, "Expected GDB Output:"
4a80f0
+  print *, ""
4a80f0
+
4a80f0
+  write(*, fmt="(A)", advance="no") "GDB = ("
4a80f0
+  do i=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+     if (i > LBOUND (array, 1)) then
4a80f0
+        write(*, fmt="(A)", advance="no") ", "
4a80f0
+     end if
4a80f0
+     write(*, fmt="(I0)", advance="no") array (i)
4a80f0
+  end do
4a80f0
+  write(*, fmt="(A)", advance="no") ")"
4a80f0
+
4a80f0
+  print *, ""	! Display Array Slice 1D
4a80f0
+end subroutine show_1d
4a80f0
+
4a80f0
+subroutine show_2d (array)
4a80f0
   integer, dimension (:,:) :: array
4a80f0
 
4a80f0
-  print *, message
4a80f0
+  print *, "Array Contents:"
4a80f0
+  print *, ""
4a80f0
+
4a80f0
   do i=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
      do j=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
         write(*, fmt="(i4)", advance="no") array (j, i)
4a80f0
      end do
4a80f0
      print *, ""
4a80f0
- end do
4a80f0
- print *, array
4a80f0
- print *, ""
4a80f0
+  end do
4a80f0
 
4a80f0
-end subroutine show
4a80f0
+  print *, ""
4a80f0
+  print *, "Expected GDB Output:"
4a80f0
+  print *, ""
4a80f0
 
4a80f0
-program test
4a80f0
+  write(*, fmt="(A)", advance="no") "GDB = ("
4a80f0
+  do i=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
+     if (i > LBOUND (array, 2)) then
4a80f0
+        write(*, fmt="(A)", advance="no") " "
4a80f0
+     end if
4a80f0
+     write(*, fmt="(A)", advance="no") "("
4a80f0
+     do j=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+        if (j > LBOUND (array, 1)) then
4a80f0
+           write(*, fmt="(A)", advance="no") ", "
4a80f0
+        end if
4a80f0
+        write(*, fmt="(I0)", advance="no") array (j, i)
4a80f0
+     end do
4a80f0
+     write(*, fmt="(A)", advance="no") ")"
4a80f0
+  end do
4a80f0
+  write(*, fmt="(A)", advance="yes") ")"
4a80f0
+
4a80f0
+  print *, ""	! Display Array Slice 2D
4a80f0
+end subroutine show_2d
4a80f0
+
4a80f0
+subroutine show_3d (array)
4a80f0
+  integer, dimension (:,:,:) :: array
4a80f0
+
4a80f0
+  print *, ""
4a80f0
+  print *, "Expected GDB Output:"
4a80f0
+  print *, ""
4a80f0
+
4a80f0
+  write(*, fmt="(A)", advance="no") "GDB = ("
4a80f0
+  do i=LBOUND (array, 3), UBOUND (array, 3), 1
4a80f0
+     if (i > LBOUND (array, 3)) then
4a80f0
+        write(*, fmt="(A)", advance="no") " "
4a80f0
+     end if
4a80f0
+     write(*, fmt="(A)", advance="no") "("
4a80f0
+     do j=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
+        if (j > LBOUND (array, 2)) then
4a80f0
+           write(*, fmt="(A)", advance="no") " "
4a80f0
+        end if
4a80f0
+        write(*, fmt="(A)", advance="no") "("
4a80f0
+        do k=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+           if (k > LBOUND (array, 1)) then
4a80f0
+              write(*, fmt="(A)", advance="no") ", "
4a80f0
+           end if
4a80f0
+           write(*, fmt="(I0)", advance="no") array (k, j, i)
4a80f0
+        end do
4a80f0
+        write(*, fmt="(A)", advance="no") ")"
4a80f0
+     end do
4a80f0
+     write(*, fmt="(A)", advance="no") ")"
4a80f0
+  end do
4a80f0
+  write(*, fmt="(A)", advance="yes") ")"
4a80f0
+
4a80f0
+  print *, ""	! Display Array Slice 3D
4a80f0
+end subroutine show_3d
4a80f0
+
4a80f0
+subroutine show_4d (array)
4a80f0
+  integer, dimension (:,:,:,:) :: array
4a80f0
+
4a80f0
+  print *, ""
4a80f0
+  print *, "Expected GDB Output:"
4a80f0
+  print *, ""
4a80f0
+
4a80f0
+  write(*, fmt="(A)", advance="no") "GDB = ("
4a80f0
+  do i=LBOUND (array, 4), UBOUND (array, 4), 1
4a80f0
+     if (i > LBOUND (array, 4)) then
4a80f0
+        write(*, fmt="(A)", advance="no") " "
4a80f0
+     end if
4a80f0
+     write(*, fmt="(A)", advance="no") "("
4a80f0
+     do j=LBOUND (array, 3), UBOUND (array, 3), 1
4a80f0
+        if (j > LBOUND (array, 3)) then
4a80f0
+           write(*, fmt="(A)", advance="no") " "
4a80f0
+        end if
4a80f0
+        write(*, fmt="(A)", advance="no") "("
4a80f0
+
4a80f0
+        do k=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
+           if (k > LBOUND (array, 2)) then
4a80f0
+              write(*, fmt="(A)", advance="no") " "
4a80f0
+           end if
4a80f0
+           write(*, fmt="(A)", advance="no") "("
4a80f0
+           do l=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+              if (l > LBOUND (array, 1)) then
4a80f0
+                 write(*, fmt="(A)", advance="no") ", "
4a80f0
+              end if
4a80f0
+              write(*, fmt="(I0)", advance="no") array (l, k, j, i)
4a80f0
+           end do
4a80f0
+           write(*, fmt="(A)", advance="no") ")"
4a80f0
+        end do
4a80f0
+        write(*, fmt="(A)", advance="no") ")"
4a80f0
+     end do
4a80f0
+     write(*, fmt="(A)", advance="no") ")"
4a80f0
+  end do
4a80f0
+  write(*, fmt="(A)", advance="yes") ")"
4a80f0
+
4a80f0
+  print *, ""	! Display Array Slice 4D
4a80f0
+end subroutine show_4d
4a80f0
 
4a80f0
+!
4a80f0
+! Start of test program.
4a80f0
+!
4a80f0
+program test
4a80f0
   interface
4a80f0
-     subroutine show (message, array)
4a80f0
-       character (len=*) :: message
4a80f0
+     subroutine show_str (array)
4a80f0
+       character (len=*) :: array
4a80f0
+     end subroutine show_str
4a80f0
+
4a80f0
+     subroutine show_1d (array)
4a80f0
+       integer, dimension (:) :: array
4a80f0
+     end subroutine show_1d
4a80f0
+
4a80f0
+     subroutine show_2d (array)
4a80f0
        integer, dimension(:,:) :: array
4a80f0
-     end subroutine show
4a80f0
+     end subroutine show_2d
4a80f0
+
4a80f0
+     subroutine show_3d (array)
4a80f0
+       integer, dimension(:,:,:) :: array
4a80f0
+     end subroutine show_3d
4a80f0
+
4a80f0
+     subroutine show_4d (array)
4a80f0
+       integer, dimension(:,:,:,:) :: array
4a80f0
+     end subroutine show_4d
4a80f0
   end interface
4a80f0
 
4a80f0
+  ! Declare variables used in this test.
4a80f0
+  integer, dimension (-10:-1,-10:-2) :: neg_array
4a80f0
   integer, dimension (1:10,1:10) :: array
4a80f0
   integer, allocatable :: other (:, :)
4a80f0
+  character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz"
4a80f0
+  integer, dimension (-2:2,-2:2,-2:2) :: array3d
4a80f0
+  integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d
4a80f0
+  integer, dimension (10:20) :: array1d
4a80f0
+  integer, dimension(:,:), pointer :: pointer2d => null()
4a80f0
+  integer, dimension(-1:9,-1:9), target :: tarray
4a80f0
 
4a80f0
+  ! Allocate or associate any variables as needed.
4a80f0
   allocate (other (-5:4, -2:7))
4a80f0
+  pointer2d => tarray
4a80f0
 
4a80f0
-  do i=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
-     do j=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
-        array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
4a80f0
-     end do
4a80f0
-  end do
4a80f0
+  ! Fill arrays with contents ready for testing.
4a80f0
+  call fill_array_1d (array1d)
4a80f0
+
4a80f0
+  call fill_array_2d (neg_array)
4a80f0
+  call fill_array_2d (array)
4a80f0
+  call fill_array_2d (other)
4a80f0
+  call fill_array_2d (tarray)
4a80f0
+
4a80f0
+  call fill_array_3d (array3d)
4a80f0
+  call fill_array_4d (array4d)
4a80f0
+
4a80f0
+  ! The tests.  Each call to a show_* function must have a unique set
4a80f0
+  ! of arguments as GDB uses the arguments are part of the test name
4a80f0
+  ! string, so duplicate arguments will result in duplicate test
4a80f0
+  ! names.
4a80f0
+  !
4a80f0
+  ! If a show_* line ends with VARS=... where '...' is a comma
4a80f0
+  ! separated list of variable names, these variables are assumed to
4a80f0
+  ! be part of the call line, and will be expanded by the test script,
4a80f0
+  ! for example:
4a80f0
+  !
4a80f0
+  !     do x=1,9,1
4a80f0
+  !       do y=x,10,1
4a80f0
+  !         call show_1d (some_array (x,y))	! VARS=x,y
4a80f0
+  !       end do
4a80f0
+  !     end do
4a80f0
+  !
4a80f0
+  ! In this example the test script will automatically expand 'x' and
4a80f0
+  ! 'y' in order to better test different aspects of GDB.  Do take
4a80f0
+  ! care, the expansion is not very "smart", so try to avoid clashing
4a80f0
+  ! with other text on the line, in the example above, avoid variables
4a80f0
+  ! named 'some' or 'array', as these will likely clash with
4a80f0
+  ! 'some_array'.
4a80f0
+  call show_str (str_1)
4a80f0
+  call show_str (str_1 (1:20))
4a80f0
+  call show_str (str_1 (10:20))
4a80f0
 
4a80f0
-  do i=LBOUND (other, 2), UBOUND (other, 2), 1
4a80f0
-     do j=LBOUND (other, 1), UBOUND (other, 1), 1
4a80f0
-        other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
4a80f0
+  call show_elem (array1d (11))
4a80f0
+  call show_elem (pointer2d (2,3))
4a80f0
+
4a80f0
+  call show_1d (array1d)
4a80f0
+  call show_1d (array1d (13:17))
4a80f0
+  call show_1d (array1d (17:13:-1))
4a80f0
+  call show_1d (array (1:5,1))
4a80f0
+  call show_1d (array4d (1,7,3,:))
4a80f0
+  call show_1d (pointer2d (-1:3, 2))
4a80f0
+  call show_1d (pointer2d (-1, 2:4))
4a80f0
+
4a80f0
+  ! Enclosing the array slice argument in (...) causess gfortran to
4a80f0
+  ! repack the array.
4a80f0
+  call show_1d ((array (1:5,1)))
4a80f0
+
4a80f0
+  call show_2d (pointer2d)
4a80f0
+  call show_2d (array)
4a80f0
+  call show_2d (array (1:5,1:5))
4a80f0
+  do i=1,10,2
4a80f0
+     do j=1,10,3
4a80f0
+        call show_2d (array (1:10:i,1:10:j))	! VARS=i,j
4a80f0
+        call show_2d (array (10:1:-i,1:10:j))	! VARS=i,j
4a80f0
+        call show_2d (array (10:1:-i,10:1:-j))	! VARS=i,j
4a80f0
+        call show_2d (array (1:10:i,10:1:-j))	! VARS=i,j
4a80f0
      end do
4a80f0
   end do
4a80f0
+  call show_2d (array (6:2:-1,3:9))
4a80f0
+  call show_2d (array (1:10:2, 1:10:2))
4a80f0
+  call show_2d (other)
4a80f0
+  call show_2d (other (-5:0, -2:0))
4a80f0
+  call show_2d (other (-5:4:2, -2:7:3))
4a80f0
+  call show_2d (neg_array)
4a80f0
+  call show_2d (neg_array (-10:-3,-8:-4:2))
4a80f0
+
4a80f0
+  ! Enclosing the array slice argument in (...) causess gfortran to
4a80f0
+  ! repack the array.
4a80f0
+  call show_2d ((array (1:10:3, 1:10:2)))
4a80f0
+  call show_2d ((neg_array (-10:-3,-8:-4:2)))
4a80f0
 
4a80f0
-  call show ("array", array)
4a80f0
-  call show ("array (1:5,1:5)", array (1:5,1:5))
4a80f0
-  call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
4a80f0
-  call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
4a80f0
-  call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
4a80f0
+  call show_3d (array3d)
4a80f0
+  call show_3d (array3d(-1:1,-1:1,-1:1))
4a80f0
+  call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1))
4a80f0
 
4a80f0
-  call show ("other", other)
4a80f0
-  call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
4a80f0
-  call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
4a80f0
+  ! Enclosing the array slice argument in (...) causess gfortran to
4a80f0
+  ! repack the array.
4a80f0
+  call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1)))
4a80f0
 
4a80f0
+  call show_4d (array4d)
4a80f0
+  call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1))
4a80f0
+  call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1))
4a80f0
+
4a80f0
+  ! Enclosing the array slice argument in (...) causess gfortran to
4a80f0
+  ! repack the array.
4a80f0
+  call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1)))
4a80f0
+
4a80f0
+  ! All done.  Deallocate.
4a80f0
   deallocate (other)
4a80f0
+
4a80f0
+  ! GDB catches this final breakpoint to indicate the end of the test.
4a80f0
   print *, "" ! Final Breakpoint.
4a80f0
+
4a80f0
+contains
4a80f0
+
4a80f0
+  ! Fill a 1D array with a unique positive integer in each element.
4a80f0
+  subroutine fill_array_1d (array)
4a80f0
+    integer, dimension (:) :: array
4a80f0
+    integer :: counter
4a80f0
+
4a80f0
+    counter = 1
4a80f0
+    do j=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+       array (j) = counter
4a80f0
+       counter = counter + 1
4a80f0
+    end do
4a80f0
+  end subroutine fill_array_1d
4a80f0
+
4a80f0
+  ! Fill a 2D array with a unique positive integer in each element.
4a80f0
+  subroutine fill_array_2d (array)
4a80f0
+    integer, dimension (:,:) :: array
4a80f0
+    integer :: counter
4a80f0
+
4a80f0
+    counter = 1
4a80f0
+    do i=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
+       do j=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+          array (j,i) = counter
4a80f0
+          counter = counter + 1
4a80f0
+       end do
4a80f0
+    end do
4a80f0
+  end subroutine fill_array_2d
4a80f0
+
4a80f0
+  ! Fill a 3D array with a unique positive integer in each element.
4a80f0
+  subroutine fill_array_3d (array)
4a80f0
+    integer, dimension (:,:,:) :: array
4a80f0
+    integer :: counter
4a80f0
+
4a80f0
+    counter = 1
4a80f0
+    do i=LBOUND (array, 3), UBOUND (array, 3), 1
4a80f0
+       do j=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
+          do k=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+             array (k, j,i) = counter
4a80f0
+             counter = counter + 1
4a80f0
+          end do
4a80f0
+       end do
4a80f0
+    end do
4a80f0
+  end subroutine fill_array_3d
4a80f0
+
4a80f0
+  ! Fill a 4D array with a unique positive integer in each element.
4a80f0
+  subroutine fill_array_4d (array)
4a80f0
+    integer, dimension (:,:,:,:) :: array
4a80f0
+    integer :: counter
4a80f0
+
4a80f0
+    counter = 1
4a80f0
+    do i=LBOUND (array, 4), UBOUND (array, 4), 1
4a80f0
+       do j=LBOUND (array, 3), UBOUND (array, 3), 1
4a80f0
+          do k=LBOUND (array, 2), UBOUND (array, 2), 1
4a80f0
+             do l=LBOUND (array, 1), UBOUND (array, 1), 1
4a80f0
+                array (l, k, j,i) = counter
4a80f0
+                counter = counter + 1
4a80f0
+             end do
4a80f0
+          end do
4a80f0
+       end do
4a80f0
+    end do
4a80f0
+    print *, ""
4a80f0
+  end subroutine fill_array_4d
4a80f0
 end program test
4a80f0
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
4a80f0
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
4a80f0
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
4a80f0
@@ -44,7 +44,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
4a80f0
 gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
4a80f0
 gdb_test "print sizeof(vla1(3,2,1))" "4" \
4a80f0
     "print sizeof element from allocated vla1"
4a80f0
-gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
4a80f0
+gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
4a80f0
     "print sizeof sliced vla1"
4a80f0
 
4a80f0
 # Try to access values in undefined pointer to VLA (dangling)
4a80f0
@@ -61,7 +61,7 @@ gdb_continue_to_breakpoint "pvla-associated"
4a80f0
 gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
4a80f0
 gdb_test "print sizeof(pvla(3,2,1))" "4" \
4a80f0
     "print sizeof element from associated pvla"
4a80f0
-gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
4a80f0
+gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
4a80f0
 
4a80f0
 gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
4a80f0
 gdb_continue_to_breakpoint "vla1-neg-bounds-v1"