aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gdb/ChangeLog24
-rw-r--r--gdb/dwarf2read.c47
-rw-r--r--gdb/f-valprint.c10
-rw-r--r--gdb/gdbtypes.c79
-rw-r--r--gdb/gdbtypes.h27
-rw-r--r--gdb/testsuite/ChangeLog8
-rw-r--r--gdb/testsuite/gdb.fortran/array-slices.exp58
-rw-r--r--gdb/testsuite/gdb.fortran/array-slices.f9070
-rw-r--r--gdb/testsuite/gdb.fortran/derived-type-striding.exp37
-rw-r--r--gdb/testsuite/gdb.fortran/derived-type-striding.f9043
-rw-r--r--gdb/valarith.c11
11 files changed, 403 insertions, 11 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 497626d..5da0725 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -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
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index fd7d21c..12a9773 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -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;
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index d5515c8..35dc90d 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -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)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 31c1a7b..b1e03d1 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -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;
}
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 2e128aa..963314d 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -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 *);
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 1f52d01..f3bffa5 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -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
index 0000000..db07ace
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -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
index 0000000..ec4e1eb
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -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
index 0000000..a2590a9
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/derived-type-striding.exp
@@ -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
index 0000000..8189ad3
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/derived-type-striding.f90
@@ -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
diff --git a/gdb/valarith.c b/gdb/valarith.c
index ea999b5..4920cfc 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -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
generated by cgit v1.1 at 2024-09-11 19:25:25 +0000