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

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