gdb/fortran: array stride support
authorAndrew Burgess <andrew.burgess@embecosm.com>
Thu, 24 Oct 2019 10:12:11 +0000 (11:12 +0100)
committerAndrew Burgess <andrew.burgess@embecosm.com>
Sun, 1 Dec 2019 22:31:30 +0000 (22:31 +0000)
Currently GDB supports a byte or bit stride on arrays, in DWARF this
would be DW_AT_bit_stride or DW_AT_byte_stride on DW_TAG_array_type.
However, DWARF can also support DW_AT_byte_stride or DW_AT_bit_stride
on DW_TAG_subrange_type, the tag used to describe each dimension of an
array.

Strides on subranges are used by gFortran to represent Fortran arrays,
and this commit adds support for this to GDB.

I've extended the range_bounds struct to include the stride
information.  The name is possibly a little inaccurate now, but this
still sort of makes sense, the structure represents information about
the bounds of the range, and also how to move from the lower to the
upper bound (the stride).

I've added initial support for bit strides, but I've never actually
seen an example of this being generated.  Further, I don't really see
right now how GDB would currently handle a bit stride that was not a
multiple of the byte size as the code in, for example,
valarith.c:value_subscripted_rvalue seems geared around byte
addressing.  As a consequence if we see a bit stride that is not a
multiple of 8 then GDB will give an error.

gdb/ChangeLog:

* dwarf2read.c (read_subrange_type): Read bit and byte stride and
create a range with stride where appropriate.
* f-valprint.c: Include 'gdbarch.h'.
(f77_print_array_1): Take the stride into account when walking the
array.  Also convert the stride into addressable units.
* gdbtypes.c (create_range_type): Initialise the stride to
constant zero.
(create_range_type_with_stride): New function, initialise the
range as normal, and then setup the stride.
(has_static_range): Include the stride here.  Also change the
return type to bool.
(create_array_type_with_stride): Consider the range stride if the
array isn't given its own stride.
(resolve_dynamic_range): Resolve the stride if needed.
* gdbtypes.h (struct range_bounds) <stride>: New member variable.
(struct range_bounds) <flag_is_byte_stride>: New member variable.
(TYPE_BIT_STRIDE): Define.
(TYPE_ARRAY_BIT_STRIDE): Define.
(create_range_type_with_stride): Declare.
* valarith.c (value_subscripted_rvalue): Take range stride into
account when walking the array.

gdb/testsuite/ChangeLog:

* gdb.fortran/derived-type-striding.exp: New file.
* gdb.fortran/derived-type-striding.f90: New file.
* gdb.fortran/array-slices.exp: New file.
* gdb.fortran/array-slices.f90: New file.

Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a

gdb/ChangeLog
gdb/dwarf2read.c
gdb/f-valprint.c
gdb/gdbtypes.c
gdb/gdbtypes.h
gdb/testsuite/ChangeLog
gdb/testsuite/gdb.fortran/array-slices.exp [new file with mode: 0644]
gdb/testsuite/gdb.fortran/array-slices.f90 [new file with mode: 0644]
gdb/testsuite/gdb.fortran/derived-type-striding.exp [new file with mode: 0644]
gdb/testsuite/gdb.fortran/derived-type-striding.f90 [new file with mode: 0644]
gdb/valarith.c

index 497626d3dc22173fda36f94a87e07f45e96128a9..5da07259fc415ff1e7b154fa116b76156dc7bc0b 100644 (file)
@@ -1,3 +1,27 @@
+2019-12-01  Andrew Burgess  <andrew.burgess@embecosm.com>
+
+       * dwarf2read.c (read_subrange_type): Read bit and byte stride and
+       create a range with stride where appropriate.
+       * f-valprint.c: Include 'gdbarch.h'.
+       (f77_print_array_1): Take the stride into account when walking the
+       array.  Also convert the stride into addressable units.
+       * gdbtypes.c (create_range_type): Initialise the stride to
+       constant zero.
+       (create_range_type_with_stride): New function, initialise the
+       range as normal, and then setup the stride.
+       (has_static_range): Include the stride here.  Also change the
+       return type to bool.
+       (create_array_type_with_stride): Consider the range stride if the
+       array isn't given its own stride.
+       (resolve_dynamic_range): Resolve the stride if needed.
+       * gdbtypes.h (struct range_bounds) <stride>: New member variable.
+       (struct range_bounds) <flag_is_byte_stride>: New member variable.
+       (TYPE_BIT_STRIDE): Define.
+       (TYPE_ARRAY_BIT_STRIDE): Define.
+       (create_range_type_with_stride): Declare.
+       * valarith.c (value_subscripted_rvalue): Take range stride into
+       account when walking the array.
+
 2019-12-01  Tom Tromey  <tom@tromey.com>
 
        * tui/tui-win.c (tui_all_windows_info): Treat inactive TUI
index fd7d21c02e949341167af19a4794b5489e6550ff..12a9773302e41b0fd351cc3537099068f0adc32f 100644 (file)
@@ -18065,7 +18065,52 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
       && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
     high.data.const_val |= negative_mask;
 
-  range_type = create_range_type (NULL, orig_base_type, &low, &high, bias);
+  /* Check for bit and byte strides.  */
+  struct dynamic_prop byte_stride_prop;
+  attribute *attr_byte_stride = dwarf2_attr (die, DW_AT_byte_stride, cu);
+  if (attr_byte_stride != nullptr)
+    {
+      struct type *prop_type
+       = dwarf2_per_cu_addr_sized_int_type (cu->per_cu, false);
+      attr_to_dynamic_prop (attr_byte_stride, die, cu, &byte_stride_prop,
+                           prop_type);
+    }
+
+  struct dynamic_prop bit_stride_prop;
+  attribute *attr_bit_stride = dwarf2_attr (die, DW_AT_bit_stride, cu);
+  if (attr_bit_stride != nullptr)
+    {
+      /* It only makes sense to have either a bit or byte stride.  */
+      if (attr_byte_stride != nullptr)
+       {
+         complaint (_("Found DW_AT_bit_stride and DW_AT_byte_stride "
+                      "- DIE at %s [in module %s]"),
+                    sect_offset_str (die->sect_off),
+                    objfile_name (cu->per_cu->dwarf2_per_objfile->objfile));
+         attr_bit_stride = nullptr;
+       }
+      else
+       {
+         struct type *prop_type
+           = dwarf2_per_cu_addr_sized_int_type (cu->per_cu, false);
+         attr_to_dynamic_prop (attr_bit_stride, die, cu, &bit_stride_prop,
+                               prop_type);
+       }
+    }
+
+  if (attr_byte_stride != nullptr
+      || attr_bit_stride != nullptr)
+    {
+      bool byte_stride_p = (attr_byte_stride != nullptr);
+      struct dynamic_prop *stride
+       = byte_stride_p ? &byte_stride_prop : &bit_stride_prop;
+
+      range_type
+       = create_range_type_with_stride (NULL, orig_base_type, &low,
+                                        &high, bias, stride, byte_stride_p);
+    }
+  else
+    range_type = create_range_type (NULL, orig_base_type, &low, &high, bias);
 
   if (high_bound_is_count)
     TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
index d5515c8f8fec041f8dfc97bcd6d6293b31e4b119..35dc90dcb0f6471dc1013ea74edea3bc0889e067 100644 (file)
@@ -34,6 +34,7 @@
 #include "block.h"
 #include "dictionary.h"
 #include "cli/cli-style.h"
+#include "gdbarch.h"
 
 static void f77_get_dynamic_length_of_aggregate (struct type *);
 
@@ -120,7 +121,12 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
 
   if (nss != ndimensions)
     {
-      size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+      struct gdbarch *gdbarch = get_type_arch (type);
+      size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type));
+      int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
+      size_t byte_stride = TYPE_ARRAY_BIT_STRIDE (type) / (unit_size * 8);
+      if (byte_stride == 0)
+       byte_stride = dim_size;
       size_t offs = 0;
 
       for (i = lowerbound;
@@ -137,7 +143,7 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
                             value_embedded_offset (subarray),
                             value_address (subarray),
                             stream, recurse, subarray, options, elts);
-         offs += dim_size;
+         offs += byte_stride;
          fprintf_filtered (stream, ") ");
        }
       if (*elts >= options->print_max && i < upperbound)
index 31c1a7b732b1627077a3b1dcd566875b4e8b1829..b1e03d1643c512c2d65404286cf4b1534259d498 100644 (file)
@@ -935,6 +935,10 @@ create_range_type (struct type *result_type, struct type *index_type,
   TYPE_RANGE_DATA (result_type)->high = *high_bound;
   TYPE_RANGE_DATA (result_type)->bias = bias;
 
+  /* Initialize the stride to be a constant, the value will already be zero
+     thanks to the use of TYPE_ZALLOC above.  */
+  TYPE_RANGE_DATA (result_type)->stride.kind = PROP_CONST;
+
   if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
     TYPE_UNSIGNED (result_type) = 1;
 
@@ -948,6 +952,29 @@ create_range_type (struct type *result_type, struct type *index_type,
   return result_type;
 }
 
+/* See gdbtypes.h.  */
+
+struct type *
+create_range_type_with_stride (struct type *result_type,
+                              struct type *index_type,
+                              const struct dynamic_prop *low_bound,
+                              const struct dynamic_prop *high_bound,
+                              LONGEST bias,
+                              const struct dynamic_prop *stride,
+                              bool byte_stride_p)
+{
+  result_type = create_range_type (result_type, index_type, low_bound,
+                                  high_bound, bias);
+
+  gdb_assert (stride != nullptr);
+  TYPE_RANGE_DATA (result_type)->stride = *stride;
+  TYPE_RANGE_DATA (result_type)->flag_is_byte_stride = byte_stride_p;
+
+  return result_type;
+}
+
+
+
 /* Create a range type using either a blank type supplied in
    RESULT_TYPE, or creating a new type, inheriting the objfile from
    INDEX_TYPE.
@@ -978,11 +1005,14 @@ create_static_range_type (struct type *result_type, struct type *index_type,
 /* Predicate tests whether BOUNDS are static.  Returns 1 if all bounds values
    are static, otherwise returns 0.  */
 
-static int
+static bool
 has_static_range (const struct range_bounds *bounds)
 {
+  /* If the range doesn't have a defined stride then its stride field will
+     be initialized to the constant 0.  */
   return (bounds->low.kind == PROP_CONST
-         && bounds->high.kind == PROP_CONST);
+         && bounds->high.kind == PROP_CONST
+         && bounds->stride.kind == PROP_CONST);
 }
 
 
@@ -1189,6 +1219,15 @@ create_array_type_with_stride (struct type *result_type,
          && !type_not_allocated (result_type)))
     {
       LONGEST low_bound, high_bound;
+      unsigned int stride;
+
+      /* If the array itself doesn't provide a stride value then take
+        whatever stride the range provides.  Don't update BIT_STRIDE as
+        we don't want to place the stride value from the range into this
+        arrays bit size field.  */
+      stride = bit_stride;
+      if (stride == 0)
+       stride = TYPE_BIT_STRIDE (range_type);
 
       if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
        low_bound = high_bound = 0;
@@ -1198,9 +1237,9 @@ create_array_type_with_stride (struct type *result_type,
         In such cases, the array length should be zero.  */
       if (high_bound < low_bound)
        TYPE_LENGTH (result_type) = 0;
-      else if (bit_stride > 0)
+      else if (stride > 0)
        TYPE_LENGTH (result_type) =
-         (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
+         (stride * (high_bound - low_bound + 1) + 7) / 8;
       else
        TYPE_LENGTH (result_type) =
          TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
@@ -1982,7 +2021,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
   CORE_ADDR value;
   struct type *static_range_type, *static_target_type;
   const struct dynamic_prop *prop;
-  struct dynamic_prop low_bound, high_bound;
+  struct dynamic_prop low_bound, high_bound, stride;
 
   gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
 
@@ -2014,13 +2053,37 @@ resolve_dynamic_range (struct type *dyn_range_type,
       high_bound.data.const_val = 0;
     }
 
+  bool byte_stride_p = TYPE_RANGE_DATA (dyn_range_type)->flag_is_byte_stride;
+  prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
+  if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+    {
+      stride.kind = PROP_CONST;
+      stride.data.const_val = value;
+
+      /* If we have a bit stride that is not an exact number of bytes then
+        I really don't think this is going to work with current GDB, the
+        array indexing code in GDB seems to be pretty heavily tied to byte
+        offsets right now.  Assuming 8 bits in a byte.  */
+      struct gdbarch *gdbarch = get_type_arch (dyn_range_type);
+      int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
+      if (!byte_stride_p && (value % (unit_size * 8)) != 0)
+       error (_("bit strides that are not a multiple of the byte size "
+                "are currently not supported"));
+    }
+  else
+    {
+      stride.kind = PROP_UNDEFINED;
+      stride.data.const_val = 0;
+      byte_stride_p = true;
+    }
+
   static_target_type
     = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type),
                                     addr_stack, 0);
   LONGEST bias = TYPE_RANGE_DATA (dyn_range_type)->bias;
-  static_range_type = create_range_type (copy_type (dyn_range_type),
-                                        static_target_type,
-                                        &low_bound, &high_bound, bias);
+  static_range_type = create_range_type_with_stride
+    (copy_type (dyn_range_type), static_target_type,
+     &low_bound, &high_bound, bias, &stride, byte_stride_p);
   TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
   return static_range_type;
 }
index 2e128aae063f9dec3802cb893e146c06ddd53fc1..963314dcc81932b674b7aa4c7ef877b14c5566e3 100644 (file)
@@ -623,6 +623,13 @@ struct range_bounds
 
   struct dynamic_prop high;
 
+  /* The stride value for this range.  This can be stored in bits or bytes
+     based on the value of BYTE_STRIDE_P.  It is optional to have a stride
+     value, if this range has no stride value defined then this will be set
+     to the constant zero.  */
+
+  struct dynamic_prop stride;
+
   /* * The bias.  Sometimes a range value is biased before storage.
      The bias is added to the stored bits to form the true value.  */
 
@@ -637,6 +644,10 @@ struct range_bounds
      a dynamic one.  */
 
   unsigned int flag_bound_evaluated : 1;
+
+  /* If this is true this STRIDE is in bytes, otherwise STRIDE is in bits.  */
+
+  unsigned int flag_is_byte_stride : 1;
 };
 
 /* Compare two range_bounds objects for equality.  Simply does
@@ -1352,6 +1363,9 @@ extern bool set_type_align (struct type *, ULONGEST);
   TYPE_RANGE_DATA(range_type)->high.kind
 #define TYPE_LOW_BOUND_KIND(range_type) \
   TYPE_RANGE_DATA(range_type)->low.kind
+#define TYPE_BIT_STRIDE(range_type) \
+  (TYPE_RANGE_DATA(range_type)->stride.data.const_val \
+   * (TYPE_RANGE_DATA(range_type)->flag_is_byte_stride ? 8 : 1))
 
 /* Property accessors for the type data location.  */
 #define TYPE_DATA_LOCATION(thistype) \
@@ -1394,6 +1408,9 @@ extern bool set_type_align (struct type *, ULONGEST);
 #define TYPE_ARRAY_LOWER_BOUND_VALUE(arraytype) \
    (TYPE_LOW_BOUND(TYPE_INDEX_TYPE((arraytype))))
 
+#define TYPE_ARRAY_BIT_STRIDE(arraytype) \
+  (TYPE_BIT_STRIDE(TYPE_INDEX_TYPE((arraytype))))
+
 /* C++ */
 
 #define TYPE_SELF_TYPE(thistype) internal_type_self_type (thistype)
@@ -1966,6 +1983,16 @@ extern struct type *create_range_type (struct type *, struct type *,
                                       const struct dynamic_prop *,
                                       LONGEST);
 
+/* Like CREATE_RANGE_TYPE but also sets up a stride.  When BYTE_STRIDE_P
+   is true the value in STRIDE is a byte stride, otherwise STRIDE is a bit
+   stride.  */
+
+extern struct type * create_range_type_with_stride
+  (struct type *result_type, struct type *index_type,
+   const struct dynamic_prop *low_bound,
+   const struct dynamic_prop *high_bound, LONGEST bias,
+   const struct dynamic_prop *stride, bool byte_stride_p);
+
 extern struct type *create_array_type (struct type *, struct type *,
                                       struct type *);
 
index 1f52d01df7efa2bcc74aa4b621800edc2974c60d..f3bffa5dbe6b091d67a2ace7b2f3f1678c697fc8 100644 (file)
@@ -1,3 +1,11 @@
+2019-12-01  Richard Bunt  <richard.bunt@arm.com>
+           Andrew Burgess  <andrew.burgess@embecosm.com>
+
+       * gdb.fortran/derived-type-striding.exp: New file.
+       * gdb.fortran/derived-type-striding.f90: New file.
+       * gdb.fortran/array-slices.exp: New file.
+       * gdb.fortran/array-slices.f90: New file.
+
 2019-11-30  Philippe Waroquiers  <philippe.waroquiers@skynet.be>
 
        * gdb.base/define.exp: Test . in command names.
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
new file mode 100644 (file)
index 0000000..db07ace
--- /dev/null
@@ -0,0 +1,58 @@
+# Copyright 2019 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/> .
+
+# Print a 2 dimensional assumed shape array.  We pass different slices
+# of the array to a subroutine and print the array as recieved within
+# the subroutine.  This should exercise GDB's ability to handle
+# different strides for the different dimensions.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+        {debug f90}]} {
+    return -1
+}
+
+if ![runto_main] {
+    untested "could not run to main"
+    return -1
+}
+
+gdb_breakpoint "show"
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+set array_contents \
+    [list \
+        " = \\(\\( 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\\) \\)" \
+        " = \\(\\( 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\\) \\)" \
+        " = \\(\\( 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\\) \\)" \
+        " = \\(\\( 1, 4, 7, 10\\) \\( 21, 24, 27, 30\\) \\( 41, 44, 47, 50\\) \\( 61, 64, 67, 70\\) \\( 81, 84, 87, 90\\) \\)" \
+        " = \\(\\( 1, 5, 9\\) \\( 31, 35, 39\\) \\( 61, 65, 69\\) \\( 91, 95, 99\\) \\)" \
+        " = \\(\\( -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\\) \\)" \
+        " = \\(\\( -26, -25, -24, -23, -22, -21\\) \\( -19, -18, -17, -16, -15, -14\\) \\( -12, -11, -10, -9, -8, -7\\) \\)" \
+        " = \\(\\( -26, -24, -22, -20, -18\\) \\( -5, -3, -1, 1, 3\\) \\( 16, 18, 20, 22, 24\\) \\( 37, 39, 41, 43, 45\\) \\)" ]
+
+set i 0
+foreach result $array_contents {
+    incr i
+    with_test_prefix "test $i" {
+       gdb_continue_to_breakpoint "show"
+       gdb_test "p array" $result
+    }
+}
+
+gdb_continue_to_breakpoint "continue to Final Breakpoint"
diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
new file mode 100644 (file)
index 0000000..ec4e1eb
--- /dev/null
@@ -0,0 +1,70 @@
+! Copyright 2019 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+subroutine show (message, array)
+  character (len=*) :: message
+  integer, dimension (:,:) :: array
+
+  print *, message
+  do i=LBOUND (array, 2), UBOUND (array, 2), 1
+     do j=LBOUND (array, 1), UBOUND (array, 1), 1
+        write(*, fmt="(i4)", advance="no") array (j, i)
+     end do
+     print *, ""
+ end do
+ print *, array
+ print *, ""
+
+end subroutine show
+
+program test
+
+  interface
+     subroutine show (message, array)
+       character (len=*) :: message
+       integer, dimension(:,:) :: array
+     end subroutine show
+  end interface
+
+  integer, dimension (1:10,1:10) :: array
+  integer, allocatable :: other (:, :)
+
+  allocate (other (-5:4, -2:7))
+
+  do i=LBOUND (array, 2), UBOUND (array, 2), 1
+     do j=LBOUND (array, 1), UBOUND (array, 1), 1
+        array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
+     end do
+  end do
+
+  do i=LBOUND (other, 2), UBOUND (other, 2), 1
+     do j=LBOUND (other, 1), UBOUND (other, 1), 1
+        other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
+     end do
+  end do
+
+  call show ("array", array)
+  call show ("array (1:5,1:5)", array (1:5,1:5))
+  call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
+  call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
+  call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
+
+  call show ("other", other)
+  call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
+  call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
+
+  deallocate (other)
+  print *, "" ! Final Breakpoint.
+end program test
diff --git a/gdb/testsuite/gdb.fortran/derived-type-striding.exp b/gdb/testsuite/gdb.fortran/derived-type-striding.exp
new file mode 100644 (file)
index 0000000..a2590a9
--- /dev/null
@@ -0,0 +1,37 @@
+# Copyright 2019 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/> .
+
+# Print some single dimensional integer arrays that will have a byte
+# stride in the debug information.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+        {debug f90}]} {
+    return -1
+}
+
+if {![runto [gdb_get_line_number "post_init"]]} then {
+    perror "couldn't run to breakpoint post_init"
+    continue
+}
+
+# Test homogeneous derived type.
+gdb_test "p point_dimension" "= \\\(2, 2, 2, 2, 2, 2, 2, 2, 2\\\)"
+
+# Test mixed type derived type.
+gdb_test "p point_mixed_dimension" "= \\\(3, 3, 3, 3\\\)"
diff --git a/gdb/testsuite/gdb.fortran/derived-type-striding.f90 b/gdb/testsuite/gdb.fortran/derived-type-striding.f90
new file mode 100644 (file)
index 0000000..8189ad3
--- /dev/null
@@ -0,0 +1,43 @@
+! Copyright 2019 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+program derived_type_member_stride
+    type cartesian
+        integer(kind=8) :: x
+        integer(kind=8) :: y
+        integer(kind=8) :: z
+    end type
+    type mixed_cartesian
+        integer(kind=8) :: x
+        integer(kind=4) :: y
+        integer(kind=8) :: z
+    end type
+    type(cartesian), dimension(10), target :: cloud
+    type(mixed_cartesian), dimension(10), target :: mixed_cloud
+    integer(kind=8), dimension(:), pointer :: point_dimension => null()
+    integer(kind=8), dimension(:), pointer :: point_mixed_dimension => null()
+    cloud(:)%x = 1
+    cloud(:)%y = 2
+    cloud(:)%z = 3
+    point_dimension => cloud(1:9)%y
+    mixed_cloud(:)%x = 1
+    mixed_cloud(:)%y = 2
+    mixed_cloud(:)%z = 3
+    point_mixed_dimension => mixed_cloud(1:4)%z
+    ! Prevent the compiler from optimising the work out.
+    print *, cloud(:)%x ! post_init
+    print *, point_dimension
+    print *, point_mixed_dimension
+end program
index ea999b5ba71a3a876e2f44f75f95b55225094b83..4920cfc18a606bce21ddea4890b1845bc55c4022 100644 (file)
@@ -188,6 +188,17 @@ value_subscripted_rvalue (struct value *array, LONGEST index, LONGEST lowerbound
   struct type *array_type = check_typedef (value_type (array));
   struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
   ULONGEST elt_size = type_length_units (elt_type);
+
+  /* Fetch the bit stride and convert it to a byte stride, assuming 8 bits
+     in a byte.  */
+  LONGEST stride = TYPE_ARRAY_BIT_STRIDE (array_type);
+  if (stride != 0)
+    {
+      struct gdbarch *arch = get_type_arch (elt_type);
+      int unit_size = gdbarch_addressable_memory_unit_size (arch);
+      elt_size = stride / (unit_size * 8);
+    }
+
   ULONGEST elt_offs = elt_size * (index - lowerbound);
 
   if (index < lowerbound