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

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