public inbox for gdb-patches@sourceware.org
 help / color / mirror / Atom feed
* [review] gdb/fortran: array stride support
@ 2019-11-14 14:56 Andrew Burgess (Code Review)
  2019-11-15 22:36 ` Tom Tromey (Code Review)
                   ` (22 more replies)
  0 siblings, 23 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-14 14:56 UTC (permalink / raw)
  To: gdb-patches

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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 a warning and then carry on, even
though the results are likely to be wrong.

gdb/ChangeLog:

	* dwarf2read.c (read_subrange_type): Read bit and byte stride and
	create a range with stride where appropriate.
	* f-valprint.c (f77_print_array_1): Take the stride into account
	when walking the array.
	* gdbtypes.c (create_range_type): Initialise the stride to
	constant zero.
	(create_range_type_with_stride): Initialise the range as normal,
	and then setup the stride.
	(has_static_range): Include the stride here.
	(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) <byte_stride_p>: 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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
11 files changed, 369 insertions(+), 9 deletions(-)



diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 8be8efb..210af76 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,25 @@
+2019-11-14  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 (f77_print_array_1): Take the stride into account
+	when walking the array.
+	* gdbtypes.c (create_range_type): Initialise the stride to
+	constant zero.
+	(create_range_type_with_stride): Initialise the range as normal,
+	and then setup the stride.
+	(has_static_range): Include the stride here.
+	(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) <byte_stride_p>: 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-11-14  Philippe Waroquiers  <philippe.waroquiers@skynet.be>
 
 	* python/py-finishbreakpoint.c (gdbpy_breakpoint_created):
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index bbfa442..14d294d 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -18047,7 +18047,51 @@
       && !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 attribute *attr_bit_stride, *attr_byte_stride;
+  struct dynamic_prop bit_stride_prop, byte_stride_prop;
+  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);
+    }
+  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 f9d4923..a2330a9 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -121,6 +121,9 @@
   if (nss != ndimensions)
     {
       size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+      size_t stride = TYPE_ARRAY_BIT_STRIDE (type) / HOST_CHAR_BIT;
+      if (stride == 0)
+	stride = dim_size;
       size_t offs = 0;
 
       for (i = lowerbound;
@@ -137,7 +140,7 @@
 			     value_embedded_offset (subarray),
 			     value_address (subarray),
 			     stream, recurse, subarray, options, elts);
-	  offs += dim_size;
+	  offs += stride;
 	  fprintf_filtered (stream, ") ");
 	}
       if (*elts >= options->print_max && i < upperbound)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index fd1c765..968aeb2 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -935,6 +935,10 @@
   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,31 @@
   return result_type;
 }
 
+/* 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.  */
+
+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)->byte_stride_p = 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.
@@ -982,7 +1011,8 @@
 has_static_range (const struct range_bounds *bounds)
 {
   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 @@
 	  && !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 @@
 	 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 @@
   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,40 @@
       high_bound.data.const_val = 0;
     }
 
+  bool byte_stride_p = TYPE_RANGE_DATA (dyn_range_type)->byte_stride_p;
+  prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
+  if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+    {
+      /* If we have a bit stride that is not a multiple of the byte stride
+	 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.  If this comes up then we warn the user
+	 and set up a known incorrect stride.  */
+      if (!byte_stride_p && (value % HOST_CHAR_BIT) != 0)
+	{
+	  warning (_("bit strides that are not a multiple of the byte "
+		     "size are currently not supported"));
+	  value = value / HOST_CHAR_BIT;
+	  byte_stride_p = true;
+	}
+
+      stride.kind = PROP_CONST;
+      stride.data.const_val = value;
+    }
+  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 6d6ff59..c0940e1 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -617,6 +617,17 @@
 
   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;
+
+  /* If this is true this STRIDE is in bytes, otherwise STRIDE is in bits.  */
+
+  bool byte_stride_p;
+
   /* * The bias.  Sometimes a range value is biased before storage.
      The bias is added to the stored bits to form the true value.  */
 
@@ -1345,6 +1356,9 @@
   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)->byte_stride_p ? HOST_CHAR_BIT : 1))
 
 /* Property accessors for the type data location.  */
 #define TYPE_DATA_LOCATION(thistype) \
@@ -1387,6 +1401,9 @@
 #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)
@@ -1959,6 +1976,10 @@
 				       const struct dynamic_prop *,
 				       LONGEST);
 
+extern struct type * create_range_type_with_stride
+  (struct type *, struct type *, const struct dynamic_prop *,
+   const struct dynamic_prop *, LONGEST, const struct dynamic_prop *, bool);
+
 extern struct type *create_array_type (struct type *, struct type *,
 				       struct type *);
 
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 7416b82..0e09ca2 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-14  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-12  Tom Tromey  <tom@tromey.com>
 
 	* lib/tuiterm.exp (_accept): Add wait_for parameter.  Check output
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
new file mode 100644
index 0000000..afd030b
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -0,0 +1,55 @@
+# 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\\) \\)" ]
+
+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..6f80a51
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -0,0 +1,56 @@
+! 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
+
+  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
+
+  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))
+
+  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 7f1b24f..fb42688 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -188,6 +188,11 @@
   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);
+
+  LONGEST stride = TYPE_ARRAY_BIT_STRIDE (array_type);
+  if (stride != 0)
+    elt_size = stride / HOST_CHAR_BIT;
+
   ULONGEST elt_offs = elt_size * (index - lowerbound);
 
   if (index < lowerbound

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 1
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-MessageType: newchange

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
@ 2019-11-15 22:36 ` Tom Tromey (Code Review)
  2019-11-15 23:54 ` Andrew Burgess (Code Review)
                   ` (21 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Tom Tromey (Code Review) @ 2019-11-15 22:36 UTC (permalink / raw)
  To: Andrew Burgess, gdb-patches

Tom Tromey has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 1:

(3 comments)

Thanks for doing this.  It looks essentially good to me, though I had
a few notes.

| --- /dev/null
| +++ /COMMIT_MSG
| @@ -1,0 +20,21 @@ 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 a warning and then carry on, even
| +though the results are likely to be wrong.

PS1, Line 31:

I wonder if it would be better to "error" when evaluating
such an expression, to avoid giving incorrect answers.

| +
| +gdb/ChangeLog:
| +
| +	* dwarf2read.c (read_subrange_type): Read bit and byte stride and
| +	create a range with stride where appropriate.
| +	* f-valprint.c (f77_print_array_1): Take the stride into account
| +	when walking the array.
| +	* gdbtypes.c (create_range_type): Initialise the stride to
| +	constant zero.
| --- gdb/gdbtypes.c
| +++ gdb/gdbtypes.c
| @@ -978,17 +1007,18 @@ 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
|  has_static_range (const struct range_bounds *bounds)
|  {
|    return (bounds->low.kind == PROP_CONST
| -	  && bounds->high.kind == PROP_CONST);
| +	  && bounds->high.kind == PROP_CONST
| +	  && bounds->stride.kind == PROP_CONST);

PS1, Line 1015:

It seems like this will not be true for types that don't
have a stride -- changing the semantics of this function.
Won't this negatively affect other cases?

|  }
|  
|  
|  /* Set *LOWP and *HIGHP to the lower and upper bounds of discrete type
|     TYPE.  Return 1 if type is a range type, 0 if it is discrete (and
|     bounds will fit in LONGEST), or -1 otherwise.  */
|  
|  int
|  get_discrete_bounds (struct type *type, LONGEST *lowp, LONGEST *highp)
| --- gdb/gdbtypes.h
| +++ gdb/gdbtypes.h
| @@ -620,8 +620,19 @@ struct range_bounds
| +  /* 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;
| +
| +  /* If this is true this STRIDE is in bytes, otherwise STRIDE is in bits.  */
| +
| +  bool byte_stride_p;

PS1, Line 629:

Perhaps this should be at the end of the struct, so it packs better.

| +
|    /* * The bias.  Sometimes a range value is biased before storage.
|       The bias is added to the stored bits to form the true value.  */
|  
|    LONGEST bias;
|  
|    /* True if HIGH range bound contains the number of elements in the
|       subrange.  This affects how the final high bound is computed.  */
|  

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 1
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Fri, 15 Nov 2019 22:36:26 +0000
Gerrit-HasComments: Yes
Gerrit-Has-Labels: No
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
  2019-11-15 22:36 ` Tom Tromey (Code Review)
@ 2019-11-15 23:54 ` Andrew Burgess (Code Review)
  2019-11-18 18:58 ` Tom Tromey (Code Review)
                   ` (20 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-15 23:54 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey

Andrew Burgess has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 1:

(3 comments)

I'll roll a new revision - I just wanted to check how you feel about the gdbtypes.c change given my comment below... thanks.

| --- /dev/null
| +++ /COMMIT_MSG
| @@ -1,0 +20,21 @@ 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 a warning and then carry on, even
| +though the results are likely to be wrong.

PS1, Line 31:

I'll change to 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 (f77_print_array_1): Take the stride into account
| +	when walking the array.
| +	* gdbtypes.c (create_range_type): Initialise the stride to
| +	constant zero.
| --- gdb/gdbtypes.c
| +++ gdb/gdbtypes.c
| @@ -978,17 +1007,18 @@ 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
|  has_static_range (const struct range_bounds *bounds)
|  {
|    return (bounds->low.kind == PROP_CONST
| -	  && bounds->high.kind == PROP_CONST);
| +	  && bounds->high.kind == PROP_CONST
| +	  && bounds->stride.kind == PROP_CONST);

PS1, Line 1015:

If the range is initialised without a stride then the stride property
is set to a constant 0, its only if there _is_ a stride that this
could ever be non-constant.  I'll add a comment to this effect here,
but does this sound like it addresses your concern?

|  }
|  
|  
|  /* Set *LOWP and *HIGHP to the lower and upper bounds of discrete type
|     TYPE.  Return 1 if type is a range type, 0 if it is discrete (and
|     bounds will fit in LONGEST), or -1 otherwise.  */
|  
|  int
|  get_discrete_bounds (struct type *type, LONGEST *lowp, LONGEST *highp)
| --- gdb/gdbtypes.h
| +++ gdb/gdbtypes.h
| @@ -620,8 +620,19 @@ struct range_bounds
| +  /* 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;
| +
| +  /* If this is true this STRIDE is in bytes, otherwise STRIDE is in bits.  */
| +
| +  bool byte_stride_p;

PS1, Line 629:

I'll move it.

| +
|    /* * The bias.  Sometimes a range value is biased before storage.
|       The bias is added to the stored bits to form the true value.  */
|  
|    LONGEST bias;
|  
|    /* True if HIGH range bound contains the number of elements in the
|       subrange.  This affects how the final high bound is computed.  */
|  

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 1
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Fri, 15 Nov 2019 23:54:10 +0000
Gerrit-HasComments: Yes
Gerrit-Has-Labels: No
Comment-In-Reply-To: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
  2019-11-15 22:36 ` Tom Tromey (Code Review)
  2019-11-15 23:54 ` Andrew Burgess (Code Review)
@ 2019-11-18 18:58 ` Tom Tromey (Code Review)
  2019-11-18 21:47 ` [review v2] " Andrew Burgess (Code Review)
                   ` (19 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Tom Tromey (Code Review) @ 2019-11-18 18:58 UTC (permalink / raw)
  To: Andrew Burgess, gdb-patches

Tom Tromey has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 1:

(1 comment)

| --- gdb/gdbtypes.c
| +++ gdb/gdbtypes.c
| @@ -978,17 +1007,18 @@ 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
|  has_static_range (const struct range_bounds *bounds)
|  {
|    return (bounds->low.kind == PROP_CONST
| -	  && bounds->high.kind == PROP_CONST);
| +	  && bounds->high.kind == PROP_CONST
| +	  && bounds->stride.kind == PROP_CONST);

PS1, Line 1015:

Yes, sorry about this -- I missed the hunk that initializes this
field in create_range_type.

|  }
|  
|  
|  /* Set *LOWP and *HIGHP to the lower and upper bounds of discrete type
|     TYPE.  Return 1 if type is a range type, 0 if it is discrete (and
|     bounds will fit in LONGEST), or -1 otherwise.  */
|  
|  int
|  get_discrete_bounds (struct type *type, LONGEST *lowp, LONGEST *highp)

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 1
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Mon, 18 Nov 2019 18:58:28 +0000
Gerrit-HasComments: Yes
Gerrit-Has-Labels: No
Comment-In-Reply-To: Andrew Burgess <andrew.burgess@embecosm.com>
Comment-In-Reply-To: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v2] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (2 preceding siblings ...)
  2019-11-18 18:58 ` Tom Tromey (Code Review)
@ 2019-11-18 21:47 ` Andrew Burgess (Code Review)
  2019-11-18 21:50 ` Andrew Burgess (Code Review)
                   ` (18 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-18 21:47 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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 a warning and then carry on, even
though the results are likely to be wrong.

gdb/ChangeLog:

	* dwarf2read.c (read_subrange_type): Read bit and byte stride and
	create a range with stride where appropriate.
	* f-valprint.c (f77_print_array_1): Take the stride into account
	when walking the array.
	* gdbtypes.c (create_range_type): Initialise the stride to
	constant zero.
	(create_range_type_with_stride): 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) <byte_stride_p>: 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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
11 files changed, 373 insertions(+), 10 deletions(-)



diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 0dfc96a..aadbd65 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,26 @@
+2019-11-18  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 (f77_print_array_1): Take the stride into account
+	when walking the array.
+	* gdbtypes.c (create_range_type): Initialise the stride to
+	constant zero.
+	(create_range_type_with_stride): 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) <byte_stride_p>: 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-11-18  Philippe Waroquiers  <philippe.waroquiers@skynet.be>
 
 	* python/py-block.c (blpy_dealloc): Call tp_free.
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index bbfa442..14d294d 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -18047,7 +18047,51 @@
       && !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 attribute *attr_bit_stride, *attr_byte_stride;
+  struct dynamic_prop bit_stride_prop, byte_stride_prop;
+  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);
+    }
+  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 f9d4923..a2330a9 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -121,6 +121,9 @@
   if (nss != ndimensions)
     {
       size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+      size_t stride = TYPE_ARRAY_BIT_STRIDE (type) / HOST_CHAR_BIT;
+      if (stride == 0)
+	stride = dim_size;
       size_t offs = 0;
 
       for (i = lowerbound;
@@ -137,7 +140,7 @@
 			     value_embedded_offset (subarray),
 			     value_address (subarray),
 			     stream, recurse, subarray, options, elts);
-	  offs += dim_size;
+	  offs += stride;
 	  fprintf_filtered (stream, ") ");
 	}
       if (*elts >= options->print_max && i < upperbound)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index fd1c765..dc70b28 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -935,6 +935,10 @@
   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,31 @@
   return result_type;
 }
 
+/* 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.  */
+
+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)->byte_stride_p = 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 +1007,14 @@
 /* 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 +1221,15 @@
 	  && !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 +1239,9 @@
 	 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 +2023,7 @@
   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 +2055,40 @@
       high_bound.data.const_val = 0;
     }
 
+  bool byte_stride_p = TYPE_RANGE_DATA (dyn_range_type)->byte_stride_p;
+  prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
+  if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+    {
+      /* If we have a bit stride that is not a multiple of the byte stride
+	 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.  If this comes up then we warn the user
+	 and set up a known incorrect stride.  */
+      if (!byte_stride_p && (value % HOST_CHAR_BIT) != 0)
+	{
+	  warning (_("bit strides that are not a multiple of the byte "
+		     "size are currently not supported"));
+	  value = value / HOST_CHAR_BIT;
+	  byte_stride_p = true;
+	}
+
+      stride.kind = PROP_CONST;
+      stride.data.const_val = value;
+    }
+  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 6d6ff59..c0940e1 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -617,6 +617,17 @@
 
   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;
+
+  /* If this is true this STRIDE is in bytes, otherwise STRIDE is in bits.  */
+
+  bool byte_stride_p;
+
   /* * The bias.  Sometimes a range value is biased before storage.
      The bias is added to the stored bits to form the true value.  */
 
@@ -1345,6 +1356,9 @@
   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)->byte_stride_p ? HOST_CHAR_BIT : 1))
 
 /* Property accessors for the type data location.  */
 #define TYPE_DATA_LOCATION(thistype) \
@@ -1387,6 +1401,9 @@
 #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)
@@ -1959,6 +1976,10 @@
 				       const struct dynamic_prop *,
 				       LONGEST);
 
+extern struct type * create_range_type_with_stride
+  (struct type *, struct type *, const struct dynamic_prop *,
+   const struct dynamic_prop *, LONGEST, const struct dynamic_prop *, bool);
+
 extern struct type *create_array_type (struct type *, struct type *,
 				       struct type *);
 
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 3a4d229..b05d060 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-18  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-14  Tom Tromey  <tromey@adacore.com>
 
 	* gdb.base/gdbvars.exp (test_convenience_variables): Add
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
new file mode 100644
index 0000000..afd030b
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -0,0 +1,55 @@
+# 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\\) \\)" ]
+
+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..6f80a51
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -0,0 +1,56 @@
+! 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
+
+  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
+
+  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))
+
+  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 7f1b24f..fb42688 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -188,6 +188,11 @@
   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);
+
+  LONGEST stride = TYPE_ARRAY_BIT_STRIDE (array_type);
+  if (stride != 0)
+    elt_size = stride / HOST_CHAR_BIT;
+
   ULONGEST elt_offs = elt_size * (index - lowerbound);
 
   if (index < lowerbound

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 2
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: newpatchset

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v2] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (3 preceding siblings ...)
  2019-11-18 21:47 ` [review v2] " Andrew Burgess (Code Review)
@ 2019-11-18 21:50 ` Andrew Burgess (Code Review)
  2019-11-18 21:55 ` [review v3] " Andrew Burgess (Code Review)
                   ` (17 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-18 21:50 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey

Andrew Burgess has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 2:

Updated the patch to add a comment in has_static_range.  I also made that function return a bool.


-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 2
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Mon, 18 Nov 2019 21:50:09 +0000
Gerrit-HasComments: No
Gerrit-Has-Labels: No
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v3] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (4 preceding siblings ...)
  2019-11-18 21:50 ` Andrew Burgess (Code Review)
@ 2019-11-18 21:55 ` Andrew Burgess (Code Review)
  2019-11-22 10:10 ` [review v4] " Andrew Burgess (Code Review)
                   ` (16 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-18 21:55 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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 (f77_print_array_1): Take the stride into account
	when walking the array.
	* gdbtypes.c (create_range_type): Initialise the stride to
	constant zero.
	(create_range_type_with_stride): 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) <byte_stride_p>: 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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
11 files changed, 369 insertions(+), 10 deletions(-)



diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 0dfc96a..aadbd65 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,26 @@
+2019-11-18  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 (f77_print_array_1): Take the stride into account
+	when walking the array.
+	* gdbtypes.c (create_range_type): Initialise the stride to
+	constant zero.
+	(create_range_type_with_stride): 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) <byte_stride_p>: 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-11-18  Philippe Waroquiers  <philippe.waroquiers@skynet.be>
 
 	* python/py-block.c (blpy_dealloc): Call tp_free.
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index bbfa442..14d294d 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -18047,7 +18047,51 @@
       && !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 attribute *attr_bit_stride, *attr_byte_stride;
+  struct dynamic_prop bit_stride_prop, byte_stride_prop;
+  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);
+    }
+  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 f9d4923..a2330a9 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -121,6 +121,9 @@
   if (nss != ndimensions)
     {
       size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+      size_t stride = TYPE_ARRAY_BIT_STRIDE (type) / HOST_CHAR_BIT;
+      if (stride == 0)
+	stride = dim_size;
       size_t offs = 0;
 
       for (i = lowerbound;
@@ -137,7 +140,7 @@
 			     value_embedded_offset (subarray),
 			     value_address (subarray),
 			     stream, recurse, subarray, options, elts);
-	  offs += dim_size;
+	  offs += stride;
 	  fprintf_filtered (stream, ") ");
 	}
       if (*elts >= options->print_max && i < upperbound)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index fd1c765..23e36da 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -935,6 +935,10 @@
   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,31 @@
   return result_type;
 }
 
+/* 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.  */
+
+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)->byte_stride_p = 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 +1007,14 @@
 /* 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 +1221,15 @@
 	  && !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 +1239,9 @@
 	 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 +2023,7 @@
   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 +2055,36 @@
       high_bound.data.const_val = 0;
     }
 
+  bool byte_stride_p = TYPE_RANGE_DATA (dyn_range_type)->byte_stride_p;
+  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 a multiple of the byte stride
+	 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.  If this comes up then we warn the user
+	 and set up a known incorrect stride.  */
+      if (!byte_stride_p && (value % HOST_CHAR_BIT) != 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 6d6ff59..8932ff8 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -617,6 +617,13 @@
 
   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.  */
 
@@ -631,6 +638,10 @@
      a dynamic one.  */
 
   int flag_bound_evaluated : 1;
+
+  /* If this is true this STRIDE is in bytes, otherwise STRIDE is in bits.  */
+
+  bool byte_stride_p;
 };
 
 /* Compare two range_bounds objects for equality.  Simply does
@@ -1345,6 +1356,9 @@
   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)->byte_stride_p ? HOST_CHAR_BIT : 1))
 
 /* Property accessors for the type data location.  */
 #define TYPE_DATA_LOCATION(thistype) \
@@ -1387,6 +1401,9 @@
 #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)
@@ -1959,6 +1976,10 @@
 				       const struct dynamic_prop *,
 				       LONGEST);
 
+extern struct type * create_range_type_with_stride
+  (struct type *, struct type *, const struct dynamic_prop *,
+   const struct dynamic_prop *, LONGEST, const struct dynamic_prop *, bool);
+
 extern struct type *create_array_type (struct type *, struct type *,
 				       struct type *);
 
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 3a4d229..b05d060 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-18  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-14  Tom Tromey  <tromey@adacore.com>
 
 	* gdb.base/gdbvars.exp (test_convenience_variables): Add
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
new file mode 100644
index 0000000..afd030b
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -0,0 +1,55 @@
+# 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\\) \\)" ]
+
+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..6f80a51
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -0,0 +1,56 @@
+! 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
+
+  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
+
+  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))
+
+  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 7f1b24f..fb42688 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -188,6 +188,11 @@
   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);
+
+  LONGEST stride = TYPE_ARRAY_BIT_STRIDE (array_type);
+  if (stride != 0)
+    elt_size = stride / HOST_CHAR_BIT;
+
   ULONGEST elt_offs = elt_size * (index - lowerbound);
 
   if (index < lowerbound

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 3
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: newpatchset

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v4] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (5 preceding siblings ...)
  2019-11-18 21:55 ` [review v3] " Andrew Burgess (Code Review)
@ 2019-11-22 10:10 ` Andrew Burgess (Code Review)
  2019-11-22 10:12 ` Andrew Burgess (Code Review)
                   ` (15 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-22 10:10 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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 (f77_print_array_1): Take the stride into account
	when walking the array.
	* gdbtypes.c (create_range_type): Initialise the stride to
	constant zero.
	(create_range_type_with_stride): 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) <byte_stride_p>: 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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
11 files changed, 386 insertions(+), 10 deletions(-)



diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 81c6690..724a95d 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,26 @@
+2019-11-22  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 (f77_print_array_1): Take the stride into account
+	when walking the array.
+	* gdbtypes.c (create_range_type): Initialise the stride to
+	constant zero.
+	(create_range_type_with_stride): 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) <byte_stride_p>: 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-11-21  Christian Biesinger  <cbiesinger@google.com>
 
 	* Makefile.in: Update.
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index d89a541..5ea1b89 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -18057,7 +18057,51 @@
       && !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 attribute *attr_bit_stride, *attr_byte_stride;
+  struct dynamic_prop bit_stride_prop, byte_stride_prop;
+  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);
+    }
+  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 f9d4923..a2330a9 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -121,6 +121,9 @@
   if (nss != ndimensions)
     {
       size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+      size_t stride = TYPE_ARRAY_BIT_STRIDE (type) / HOST_CHAR_BIT;
+      if (stride == 0)
+	stride = dim_size;
       size_t offs = 0;
 
       for (i = lowerbound;
@@ -137,7 +140,7 @@
 			     value_embedded_offset (subarray),
 			     value_address (subarray),
 			     stream, recurse, subarray, options, elts);
-	  offs += dim_size;
+	  offs += stride;
 	  fprintf_filtered (stream, ") ");
 	}
       if (*elts >= options->print_max && i < upperbound)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 31c1a7b..8fb25d5 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -935,6 +935,10 @@
   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,31 @@
   return result_type;
 }
 
+/* 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.  */
+
+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)->byte_stride_p = 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 +1007,14 @@
 /* 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 +1221,15 @@
 	  && !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 +1239,9 @@
 	 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 +2023,7 @@
   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 +2055,36 @@
       high_bound.data.const_val = 0;
     }
 
+  bool byte_stride_p = TYPE_RANGE_DATA (dyn_range_type)->byte_stride_p;
+  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 a multiple of the byte stride
+	 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.  If this comes up then we warn the user
+	 and set up a known incorrect stride.  */
+      if (!byte_stride_p && (value % HOST_CHAR_BIT) != 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 8fc770c..eeae1b9 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -623,6 +623,13 @@
 
   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 @@
      a dynamic one.  */
 
   int flag_bound_evaluated : 1;
+
+  /* If this is true this STRIDE is in bytes, otherwise STRIDE is in bits.  */
+
+  bool byte_stride_p;
 };
 
 /* Compare two range_bounds objects for equality.  Simply does
@@ -1352,6 +1363,9 @@
   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)->byte_stride_p ? HOST_CHAR_BIT : 1))
 
 /* Property accessors for the type data location.  */
 #define TYPE_DATA_LOCATION(thistype) \
@@ -1394,6 +1408,9 @@
 #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,10 @@
 				       const struct dynamic_prop *,
 				       LONGEST);
 
+extern struct type * create_range_type_with_stride
+  (struct type *, struct type *, const struct dynamic_prop *,
+   const struct dynamic_prop *, LONGEST, const struct dynamic_prop *, bool);
+
 extern struct type *create_array_type (struct type *, struct type *,
 				       struct type *);
 
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index d4c42bd..419b98c 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-22  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-21  Peeter Joot  <peeter.joot@lzlabs.com>
 
 	* gdb.base/endianity.c: New test.
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..fed550d 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -188,6 +188,11 @@
   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);
+
+  LONGEST stride = TYPE_ARRAY_BIT_STRIDE (array_type);
+  if (stride != 0)
+    elt_size = stride / HOST_CHAR_BIT;
+
   ULONGEST elt_offs = elt_size * (index - lowerbound);
 
   if (index < lowerbound

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 4
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: newpatchset

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v4] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (6 preceding siblings ...)
  2019-11-22 10:10 ` [review v4] " Andrew Burgess (Code Review)
@ 2019-11-22 10:12 ` Andrew Burgess (Code Review)
  2019-11-22 13:06 ` Simon Marchi (Code Review)
                   ` (14 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-22 10:12 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey

Andrew Burgess has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 4:

Rebase and slightly improved the test - it now covers dynamically allocated arrays as well.


-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 4
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Fri, 22 Nov 2019 10:12:00 +0000
Gerrit-HasComments: No
Gerrit-Has-Labels: No
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v4] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (7 preceding siblings ...)
  2019-11-22 10:12 ` Andrew Burgess (Code Review)
@ 2019-11-22 13:06 ` Simon Marchi (Code Review)
  2019-11-22 17:30 ` [review v5] " Andrew Burgess (Code Review)
                   ` (13 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Simon Marchi (Code Review) @ 2019-11-22 13:06 UTC (permalink / raw)
  To: Andrew Burgess, gdb-patches; +Cc: Tom Tromey

Simon Marchi has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 4:

(3 comments)

I can't assess the correctness of the patch, as I don't really know the domain, but I noted a few points.

| --- gdb/dwarf2read.c
| +++ gdb/dwarf2read.c
| @@ -18053,8 +18053,18 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
|    if (low.kind == PROP_CONST
|        && !TYPE_UNSIGNED (base_type) && (low.data.const_val & negative_mask))
|      low.data.const_val |= negative_mask;
|    if (high.kind == PROP_CONST
|        && !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 attribute *attr_bit_stride, *attr_byte_stride;

PS4, Line 18061:

You might as well declare them on the line where you assign them.

| +  struct dynamic_prop bit_stride_prop, byte_stride_prop;
| +  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);
| +    }
| --- gdb/gdbtypes.c
| +++ gdb/gdbtypes.c
| @@ -942,9 +946,21 @@ create_range_type (struct type *result_type, struct type *index_type,
|       less than the lower bound, so checking the lower bound is not
|       enough.  Make sure we do not mark a range type whose upper bound
|       is negative as unsigned.  */
|    if (high_bound->kind == PROP_CONST && high_bound->data.const_val < 0)
|      TYPE_UNSIGNED (result_type) = 0;
|  
|    return result_type;
|  }
|  
| +/* 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.  */

PS4, Line 957:

This comment should be

 /* See gdbtypes.h.  */

I know that other functions around don't adhere to this rule, but I
think for a new function, or when modifying an existing function
comment, we should do it right.

| +
| +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)

 ...

| @@ -2017,0 +2061,19 @@ resolve_dynamic_range (struct type *dyn_range_type,
| +    {
| +      stride.kind = PROP_CONST;
| +      stride.data.const_val = value;
| +
| +      /* If we have a bit stride that is not a multiple of the byte stride
| +	 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.  If this comes up then we warn the user
| +	 and set up a known incorrect stride.  */
| +      if (!byte_stride_p && (value % HOST_CHAR_BIT) != 0)

PS4, Line 2070:

Using HOST_CHAR_BIT (a few occurences in the patch) when manipulating
target data is probably not right.  You probably want to use
gdbarch_addressable_memory_unit_size, using the gdbarch from the type.

| +	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;
| +    }

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 4
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Fri, 22 Nov 2019 13:06:49 +0000
Gerrit-HasComments: Yes
Gerrit-Has-Labels: No
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v5] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (8 preceding siblings ...)
  2019-11-22 13:06 ` Simon Marchi (Code Review)
@ 2019-11-22 17:30 ` Andrew Burgess (Code Review)
  2019-11-22 17:31 ` Andrew Burgess (Code Review)
                   ` (12 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-22 17:30 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey, Simon Marchi

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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 (f77_print_array_1): Take the stride into account
	when walking the array.
	* 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) <byte_stride_p>: 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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
11 files changed, 389 insertions(+), 10 deletions(-)



diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 93258c3..49dc3b1 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,26 @@
+2019-11-22  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 (f77_print_array_1): Take the stride into account
+	when walking the array.
+	* 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) <byte_stride_p>: 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-11-22  Tom de Vries  <tdevries@suse.de>
 
 	* contrib/words.sh: Improve words extraction.
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index d89a541..d9c3c1f 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -18057,7 +18057,52 @@
       && !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 f9d4923..7816016 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -121,6 +121,9 @@
   if (nss != ndimensions)
     {
       size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+      size_t stride = TYPE_ARRAY_BIT_STRIDE (type) / TARGET_CHAR_BIT;
+      if (stride == 0)
+	stride = dim_size;
       size_t offs = 0;
 
       for (i = lowerbound;
@@ -137,7 +140,7 @@
 			     value_embedded_offset (subarray),
 			     value_address (subarray),
 			     stream, recurse, subarray, options, elts);
-	  offs += dim_size;
+	  offs += stride;
 	  fprintf_filtered (stream, ") ");
 	}
       if (*elts >= options->print_max && i < upperbound)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 31c1a7b..9ff20aa 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -935,6 +935,10 @@
   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 @@
   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)->byte_stride_p = 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 @@
 /* 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 @@
 	  && !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 @@
 	 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 @@
   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,36 @@
       high_bound.data.const_val = 0;
     }
 
+  bool byte_stride_p = TYPE_RANGE_DATA (dyn_range_type)->byte_stride_p;
+  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 a multiple of the byte stride
+	 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.  If this comes up then we warn the user
+	 and set up a known incorrect stride.  */
+      if (!byte_stride_p && (value % TARGET_CHAR_BIT) != 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 8fc770c..6f40a29 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -623,6 +623,13 @@
 
   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 @@
      a dynamic one.  */
 
   int flag_bound_evaluated : 1;
+
+  /* If this is true this STRIDE is in bytes, otherwise STRIDE is in bits.  */
+
+  bool byte_stride_p;
 };
 
 /* Compare two range_bounds objects for equality.  Simply does
@@ -1352,6 +1363,9 @@
   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)->byte_stride_p ? TARGET_CHAR_BIT : 1))
 
 /* Property accessors for the type data location.  */
 #define TYPE_DATA_LOCATION(thistype) \
@@ -1394,6 +1408,9 @@
 #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,14 @@
 				       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 *, struct type *, const struct dynamic_prop *,
+   const struct dynamic_prop *, LONGEST, const struct dynamic_prop *, bool);
+
 extern struct type *create_array_type (struct type *, struct type *,
 				       struct type *);
 
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index d4c42bd..419b98c 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-22  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-21  Peeter Joot  <peeter.joot@lzlabs.com>
 
 	* gdb.base/endianity.c: New test.
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..2b79442 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -188,6 +188,11 @@
   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);
+
+  LONGEST stride = TYPE_ARRAY_BIT_STRIDE (array_type);
+  if (stride != 0)
+    elt_size = stride / TARGET_CHAR_BIT;
+
   ULONGEST elt_offs = elt_size * (index - lowerbound);
 
   if (index < lowerbound

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 5
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: newpatchset

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v5] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (9 preceding siblings ...)
  2019-11-22 17:30 ` [review v5] " Andrew Burgess (Code Review)
@ 2019-11-22 17:31 ` Andrew Burgess (Code Review)
  2019-11-22 17:46 ` Simon Marchi (Code Review)
                   ` (11 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-22 17:31 UTC (permalink / raw)
  To: gdb-patches; +Cc: Simon Marchi, Tom Tromey

Andrew Burgess has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 5:

(3 comments)

All issues addressed.

| --- gdb/dwarf2read.c
| +++ gdb/dwarf2read.c
| @@ -18053,8 +18053,18 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
|    if (low.kind == PROP_CONST
|        && !TYPE_UNSIGNED (base_type) && (low.data.const_val & negative_mask))
|      low.data.const_val |= negative_mask;
|    if (high.kind == PROP_CONST
|        && !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 attribute *attr_bit_stride, *attr_byte_stride;

PS4, Line 18061:

Done.

| +  struct dynamic_prop bit_stride_prop, byte_stride_prop;
| +  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);
| +    }
| --- gdb/gdbtypes.c
| +++ gdb/gdbtypes.c
| @@ -942,9 +946,21 @@ create_range_type (struct type *result_type, struct type *index_type,
|       less than the lower bound, so checking the lower bound is not
|       enough.  Make sure we do not mark a range type whose upper bound
|       is negative as unsigned.  */
|    if (high_bound->kind == PROP_CONST && high_bound->data.const_val < 0)
|      TYPE_UNSIGNED (result_type) = 0;
|  
|    return result_type;
|  }
|  
| +/* 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.  */

PS4, Line 957:

Done.

| +
| +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)

 ...

| @@ -2017,0 +2061,19 @@ resolve_dynamic_range (struct type *dyn_range_type,
| +    {
| +      stride.kind = PROP_CONST;
| +      stride.data.const_val = value;
| +
| +      /* If we have a bit stride that is not a multiple of the byte stride
| +	 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.  If this comes up then we warn the user
| +	 and set up a known incorrect stride.  */
| +      if (!byte_stride_p && (value % HOST_CHAR_BIT) != 0)

PS4, Line 2070:

I don't think that gdbarch_addressable_memory_unit_size is what I
want.  From it's comment in gdbarch.h:

  /* Return the size in 8-bit bytes of an addressable memory unit on this
   architecture.  This corresponds to the number of 8-bit bytes associated to
   each address in memory. */

While what I want is the number of bits in a byte, which is available
as... wait for it.... TARGET_CHAR_BIT.  I don't know what I was
thinking when I originally used HOST_CHAR_BIT.  Thanks for pointing
this out.

| +	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;
| +    }

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 5
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Fri, 22 Nov 2019 17:31:20 +0000
Gerrit-HasComments: Yes
Gerrit-Has-Labels: No
Comment-In-Reply-To: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v5] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (10 preceding siblings ...)
  2019-11-22 17:31 ` Andrew Burgess (Code Review)
@ 2019-11-22 17:46 ` Simon Marchi (Code Review)
  2019-11-28  0:45 ` [review v6] " Andrew Burgess (Code Review)
                   ` (10 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Simon Marchi (Code Review) @ 2019-11-22 17:46 UTC (permalink / raw)
  To: Andrew Burgess, gdb-patches; +Cc: Tom Tromey

Simon Marchi has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 5:

(1 comment)

| --- gdb/gdbtypes.c
| +++ gdb/gdbtypes.c
| @@ -2017,0 +2061,19 @@ resolve_dynamic_range (struct type *dyn_range_type,
| +    {
| +      stride.kind = PROP_CONST;
| +      stride.data.const_val = value;
| +
| +      /* If we have a bit stride that is not a multiple of the byte stride
| +	 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.  If this comes up then we warn the user
| +	 and set up a known incorrect stride.  */
| +      if (!byte_stride_p && (value % HOST_CHAR_BIT) != 0)

PS4, Line 2070:

Sorry, I meant gdbarch_addressable_memory_unit_size * 8, to have the
number of bits in a "byte" on that architecture.

I think TARGET_CHAR_BIT is actually broken and should be removed,
because it is a compile time constant.  Given that you can debug code
from different architectures (some with 8 bit bytes and some with 16
bit bytes) with the same GDB, TARGET_CHAR_BIT will necessarily be
wrong for some of these architectures.

| +	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;
| +    }

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 5
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Fri, 22 Nov 2019 17:46:33 +0000
Gerrit-HasComments: Yes
Gerrit-Has-Labels: No
Comment-In-Reply-To: Andrew Burgess <andrew.burgess@embecosm.com>
Comment-In-Reply-To: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v6] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (11 preceding siblings ...)
  2019-11-22 17:46 ` Simon Marchi (Code Review)
@ 2019-11-28  0:45 ` Andrew Burgess (Code Review)
  2019-11-29 23:32 ` [review v7] " Andrew Burgess (Code Review)
                   ` (9 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-28  0:45 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey, Simon Marchi

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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 (f77_print_array_1): Take the stride into account
	when walking the array.
	* 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) <byte_stride_p>: 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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
11 files changed, 389 insertions(+), 10 deletions(-)



diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 6bd149b..985740a 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,26 @@
+2019-11-28  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 (f77_print_array_1): Take the stride into account
+	when walking the array.
+	* 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) <byte_stride_p>: 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-11-27  Christian Biesinger  <cbiesinger@google.com>
 
 	* NEWS: Mention the new multithreaded symbol loading.
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 40626a1..0d964b3 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -18060,7 +18060,52 @@
       && !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..5d1177f 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -121,6 +121,9 @@
   if (nss != ndimensions)
     {
       size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+      size_t stride = TYPE_ARRAY_BIT_STRIDE (type) / TARGET_CHAR_BIT;
+      if (stride == 0)
+	stride = dim_size;
       size_t offs = 0;
 
       for (i = lowerbound;
@@ -137,7 +140,7 @@
 			     value_embedded_offset (subarray),
 			     value_address (subarray),
 			     stream, recurse, subarray, options, elts);
-	  offs += dim_size;
+	  offs += stride;
 	  fprintf_filtered (stream, ") ");
 	}
       if (*elts >= options->print_max && i < upperbound)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 31c1a7b..9ff20aa 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -935,6 +935,10 @@
   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 @@
   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)->byte_stride_p = 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 @@
 /* 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 @@
 	  && !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 @@
 	 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 @@
   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,36 @@
       high_bound.data.const_val = 0;
     }
 
+  bool byte_stride_p = TYPE_RANGE_DATA (dyn_range_type)->byte_stride_p;
+  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 a multiple of the byte stride
+	 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.  If this comes up then we warn the user
+	 and set up a known incorrect stride.  */
+      if (!byte_stride_p && (value % TARGET_CHAR_BIT) != 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 8fc770c..6f40a29 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -623,6 +623,13 @@
 
   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 @@
      a dynamic one.  */
 
   int flag_bound_evaluated : 1;
+
+  /* If this is true this STRIDE is in bytes, otherwise STRIDE is in bits.  */
+
+  bool byte_stride_p;
 };
 
 /* Compare two range_bounds objects for equality.  Simply does
@@ -1352,6 +1363,9 @@
   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)->byte_stride_p ? TARGET_CHAR_BIT : 1))
 
 /* Property accessors for the type data location.  */
 #define TYPE_DATA_LOCATION(thistype) \
@@ -1394,6 +1408,9 @@
 #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,14 @@
 				       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 *, struct type *, const struct dynamic_prop *,
+   const struct dynamic_prop *, LONGEST, const struct dynamic_prop *, bool);
+
 extern struct type *create_array_type (struct type *, struct type *,
 				       struct type *);
 
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 86f2130..901c307 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-28  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-27  Andrew Burgess  <andrew.burgess@embecosm.com>
 
 	* gdb.fortran/info-modules.exp: Compile source files in correct
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..2b79442 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -188,6 +188,11 @@
   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);
+
+  LONGEST stride = TYPE_ARRAY_BIT_STRIDE (array_type);
+  if (stride != 0)
+    elt_size = stride / TARGET_CHAR_BIT;
+
   ULONGEST elt_offs = elt_size * (index - lowerbound);
 
   if (index < lowerbound

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 6
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: newpatchset

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v7] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (12 preceding siblings ...)
  2019-11-28  0:45 ` [review v6] " Andrew Burgess (Code Review)
@ 2019-11-29 23:32 ` Andrew Burgess (Code Review)
  2019-11-29 23:35 ` Andrew Burgess (Code Review)
                   ` (8 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-29 23:32 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey, Simon Marchi

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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 (f77_print_array_1): Take the stride into account
	when walking the array.
	* gdbtypes.c (create_range_type): Initialise the stride to
	constant zero.
	(create_range_type_with_stride): 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) <byte_stride_p>: 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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
11 files changed, 369 insertions(+), 10 deletions(-)



diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 4b7e506..4c7d6b3 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,26 @@
+2019-11-18  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 (f77_print_array_1): Take the stride into account
+	when walking the array.
+	* gdbtypes.c (create_range_type): Initialise the stride to
+	constant zero.
+	(create_range_type_with_stride): 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-11-29  Tankut Baris Aktemur  <tankut.baris.aktemur@intel.com>
 
 	* valops.c (find_oload_champ): Improve debug output.
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 40626a1..0822817 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -18060,7 +18060,51 @@
       && !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 attribute *attr_bit_stride, *attr_byte_stride;
+  struct dynamic_prop bit_stride_prop, byte_stride_prop;
+  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);
+    }
+  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..df5b471 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -121,6 +121,9 @@
   if (nss != ndimensions)
     {
       size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+      size_t stride = TYPE_ARRAY_BIT_STRIDE (type) / HOST_CHAR_BIT;
+      if (stride == 0)
+	stride = dim_size;
       size_t offs = 0;
 
       for (i = lowerbound;
@@ -137,7 +140,7 @@
 			     value_embedded_offset (subarray),
 			     value_address (subarray),
 			     stream, recurse, subarray, options, elts);
-	  offs += dim_size;
+	  offs += stride;
 	  fprintf_filtered (stream, ") ");
 	}
       if (*elts >= options->print_max && i < upperbound)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 31c1a7b..fbc1a5b 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -935,6 +935,10 @@
   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,31 @@
   return result_type;
 }
 
+/* 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.  */
+
+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 +1007,14 @@
 /* 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 +1221,15 @@
 	  && !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 +1239,9 @@
 	 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 +2023,7 @@
   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 +2055,36 @@
       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 a multiple of the byte stride
+	 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.  If this comes up then we warn the user
+	 and set up a known incorrect stride.  */
+      if (!byte_stride_p && (value % HOST_CHAR_BIT) != 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..9f10716 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -623,6 +623,13 @@
 
   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 @@
      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 @@
   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 ? HOST_CHAR_BIT : 1))
 
 /* Property accessors for the type data location.  */
 #define TYPE_DATA_LOCATION(thistype) \
@@ -1394,6 +1408,9 @@
 #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,10 @@
 				       const struct dynamic_prop *,
 				       LONGEST);
 
+extern struct type * create_range_type_with_stride
+  (struct type *, struct type *, const struct dynamic_prop *,
+   const struct dynamic_prop *, LONGEST, const struct dynamic_prop *, bool);
+
 extern struct type *create_array_type (struct type *, struct type *,
 				       struct type *);
 
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 6b520e1..ae63519 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-18  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-28  Andrew Burgess  <andrew.burgess@embecosm.com>
 
 	* lib/gdb.exp (skip_btrace_tests): Return 1 if the test fails to
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
new file mode 100644
index 0000000..afd030b
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -0,0 +1,55 @@
+# 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\\) \\)" ]
+
+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..6f80a51
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -0,0 +1,56 @@
+! 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
+
+  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
+
+  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))
+
+  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..fed550d 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -188,6 +188,11 @@
   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);
+
+  LONGEST stride = TYPE_ARRAY_BIT_STRIDE (array_type);
+  if (stride != 0)
+    elt_size = stride / HOST_CHAR_BIT;
+
   ULONGEST elt_offs = elt_size * (index - lowerbound);
 
   if (index < lowerbound

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 7
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: newpatchset

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v7] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (13 preceding siblings ...)
  2019-11-29 23:32 ` [review v7] " Andrew Burgess (Code Review)
@ 2019-11-29 23:35 ` Andrew Burgess (Code Review)
  2019-11-30 21:47 ` [review v8] " Andrew Burgess (Code Review)
                   ` (7 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-29 23:35 UTC (permalink / raw)
  To: gdb-patches; +Cc: Simon Marchi, Tom Tromey

Andrew Burgess has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 7:

(1 comment)

| --- gdb/gdbtypes.c
| +++ gdb/gdbtypes.c
| @@ -2017,0 +2061,19 @@ resolve_dynamic_range (struct type *dyn_range_type,
| +    {
| +      stride.kind = PROP_CONST;
| +      stride.data.const_val = value;
| +
| +      /* If we have a bit stride that is not a multiple of the byte stride
| +	 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.  If this comes up then we warn the user
| +	 and set up a known incorrect stride.  */
| +      if (!byte_stride_p && (value % HOST_CHAR_BIT) != 0)

PS4, Line 2070:

OK, I see.  I'll get this change made ASAP.  Thanks.

| +	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;
| +    }

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 7
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Fri, 29 Nov 2019 23:35:11 +0000
Gerrit-HasComments: Yes
Gerrit-Has-Labels: No
Comment-In-Reply-To: Andrew Burgess <andrew.burgess@embecosm.com>
Comment-In-Reply-To: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v8] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (14 preceding siblings ...)
  2019-11-29 23:35 ` Andrew Burgess (Code Review)
@ 2019-11-30 21:47 ` Andrew Burgess (Code Review)
  2019-11-30 22:10 ` [review v9] " Andrew Burgess (Code Review)
                   ` (6 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-30 21:47 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey, Simon Marchi

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
11 files changed, 399 insertions(+), 11 deletions(-)



diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 4b7e506..7a285cb 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,27 @@
+2019-11-28  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-11-29  Tankut Baris Aktemur  <tankut.baris.aktemur@intel.com>
 
 	* valops.c (find_oload_champ): Improve debug output.
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 40626a1..0d964b3 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -18060,7 +18060,52 @@
       && !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 @@
 
   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 @@
 			     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..0c08b64 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -935,6 +935,10 @@
   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 @@
   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 @@
 /* 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 @@
 	  && !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 @@
 	 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 @@
   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,35 @@
       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.  */
+      if (!byte_stride_p && (value % 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..507f264 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -623,6 +623,13 @@
 
   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 @@
      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 @@
   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 @@
 #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,14 @@
 				       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 *, struct type *, const struct dynamic_prop *,
+   const struct dynamic_prop *, LONGEST, const struct dynamic_prop *, bool);
+
 extern struct type *create_array_type (struct type *, struct type *,
 				       struct type *);
 
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 6b520e1..0973fc1 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-28  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-28  Andrew Burgess  <andrew.burgess@embecosm.com>
 
 	* lib/gdb.exp (skip_btrace_tests): Return 1 if the test fails to
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 @@
   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

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 8
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: newpatchset

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v9] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (15 preceding siblings ...)
  2019-11-30 21:47 ` [review v8] " Andrew Burgess (Code Review)
@ 2019-11-30 22:10 ` Andrew Burgess (Code Review)
  2019-11-30 22:11 ` Andrew Burgess (Code Review)
                   ` (5 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-30 22:10 UTC (permalink / raw)
  To: gdb-patches; +Cc: Tom Tromey, Simon Marchi

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
11 files changed, 401 insertions(+), 11 deletions(-)



diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 4b7e506..7a285cb 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,27 @@
+2019-11-28  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-11-29  Tankut Baris Aktemur  <tankut.baris.aktemur@intel.com>
 
 	* valops.c (find_oload_champ): Improve debug output.
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 40626a1..0d964b3 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -18060,7 +18060,52 @@
       && !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 @@
 
   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 @@
 			     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 @@
   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 @@
   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 @@
 /* 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 @@
 	  && !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 @@
 	 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 @@
   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 @@
       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..507f264 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -623,6 +623,13 @@
 
   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 @@
      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 @@
   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 @@
 #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,14 @@
 				       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 *, struct type *, const struct dynamic_prop *,
+   const struct dynamic_prop *, LONGEST, const struct dynamic_prop *, bool);
+
 extern struct type *create_array_type (struct type *, struct type *,
 				       struct type *);
 
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 6b520e1..0973fc1 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-28  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-28  Andrew Burgess  <andrew.burgess@embecosm.com>
 
 	* lib/gdb.exp (skip_btrace_tests): Return 1 if the test fails to
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 @@
   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

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 9
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: newpatchset

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v9] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (16 preceding siblings ...)
  2019-11-30 22:10 ` [review v9] " Andrew Burgess (Code Review)
@ 2019-11-30 22:11 ` Andrew Burgess (Code Review)
  2019-12-01  0:09 ` Simon Marchi (Code Review)
                   ` (4 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess (Code Review) @ 2019-11-30 22:11 UTC (permalink / raw)
  To: gdb-patches; +Cc: Simon Marchi, Tom Tromey

Andrew Burgess has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 9:

(1 comment)

| --- gdb/gdbtypes.c
| +++ gdb/gdbtypes.c
| @@ -2017,0 +2061,19 @@ resolve_dynamic_range (struct type *dyn_range_type,
| +    {
| +      stride.kind = PROP_CONST;
| +      stride.data.const_val = value;
| +
| +      /* If we have a bit stride that is not a multiple of the byte stride
| +	 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.  If this comes up then we warn the user
| +	 and set up a known incorrect stride.  */
| +      if (!byte_stride_p && (value % HOST_CHAR_BIT) != 0)

PS4, Line 2070:

I think that the latest version should address this issue.  There were
four places I'd made use of TARGET_CHAR_BIT, in f-valprint.c,
valarith.c, and gdbtypes.c I'm now also using
gdbarch_addressable_memory_unit_size to convert the byte stride into
address unit stride.  In gdbtypes.h I now just use '8' because here we
really want to convert bytes to bits, there's no address units
involved here I think.

| +	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;
| +    }

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 9
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Sat, 30 Nov 2019 22:11:20 +0000
Gerrit-HasComments: Yes
Gerrit-Has-Labels: No
Comment-In-Reply-To: Andrew Burgess <andrew.burgess@embecosm.com>
Comment-In-Reply-To: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v9] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (17 preceding siblings ...)
  2019-11-30 22:11 ` Andrew Burgess (Code Review)
@ 2019-12-01  0:09 ` Simon Marchi (Code Review)
  2019-12-01  0:09 ` Simon Marchi (Code Review)
                   ` (3 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Simon Marchi (Code Review) @ 2019-12-01  0:09 UTC (permalink / raw)
  To: Andrew Burgess, gdb-patches; +Cc: Tom Tromey

Simon Marchi has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 9:

(1 comment)

LGTM, I have just noted something about a comment.

| --- gdb/gdbtypes.h
| +++ gdb/gdbtypes.h
| @@ -1960,13 +1977,21 @@ extern struct type *create_static_range_type (struct type *, struct type *,
|  extern struct type *create_array_type_with_stride
|    (struct type *, struct type *, struct type *,
|     struct dynamic_prop *, unsigned int);
|  
|  extern struct type *create_range_type (struct type *, struct type *,
|  				       const struct dynamic_prop *,
|  				       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.  */

PS9, Line 1988:

I know the surrounding code is like that, but I don't find it very
readable to refer to parameter names when the declaration doesn't
include parameters names.  I'd be much inclined to adding the
parameter names below at the same time.

| +
| +extern struct type * create_range_type_with_stride
| +  (struct type *, struct type *, const struct dynamic_prop *,
| +   const struct dynamic_prop *, LONGEST, const struct dynamic_prop *, bool);
| +
|  extern struct type *create_array_type (struct type *, struct type *,
|  				       struct type *);
|  
|  extern struct type *lookup_array_range_type (struct type *, LONGEST, LONGEST);

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 9
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-CC: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Sun, 01 Dec 2019 00:09:32 +0000
Gerrit-HasComments: Yes
Gerrit-Has-Labels: No
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [review v9] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (18 preceding siblings ...)
  2019-12-01  0:09 ` Simon Marchi (Code Review)
@ 2019-12-01  0:09 ` Simon Marchi (Code Review)
  2019-12-01 22:33 ` [pushed] " Sourceware to Gerrit sync (Code Review)
                   ` (2 subsequent siblings)
  22 siblings, 0 replies; 34+ messages in thread
From: Simon Marchi (Code Review) @ 2019-12-01  0:09 UTC (permalink / raw)
  To: Andrew Burgess, gdb-patches; +Cc: Tom Tromey

Simon Marchi has posted comments on this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................


Patch Set 9: Code-Review+2


-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 9
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-Comment-Date: Sun, 01 Dec 2019 00:09:35 +0000
Gerrit-HasComments: No
Gerrit-Has-Labels: Yes
Gerrit-MessageType: comment

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [pushed] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (20 preceding siblings ...)
  2019-12-01 22:33 ` [pushed] " Sourceware to Gerrit sync (Code Review)
@ 2019-12-01 22:33 ` Sourceware to Gerrit sync (Code Review)
  2020-01-14  4:11 ` [PATCH] Add gdb.fortran/vla-stride.exp and report a bug (was: Re: [review] gdb/fortran: array stride support) Sergio Durigan Junior
  22 siblings, 0 replies; 34+ messages in thread
From: Sourceware to Gerrit sync (Code Review) @ 2019-12-01 22:33 UTC (permalink / raw)
  To: Andrew Burgess, Simon Marchi, gdb-patches; +Cc: Tom Tromey

The original change was created by Andrew Burgess.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
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 @@
       && !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 @@
 
   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 @@
 			     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 @@
   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 @@
   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 @@
 /* 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 @@
 	  && !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 @@
 	 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 @@
   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 @@
       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 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 @@
      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 @@
   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 @@
 #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 @@
 				       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 @@
   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

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 10
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: newpatchset

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [pushed] gdb/fortran: array stride support
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (19 preceding siblings ...)
  2019-12-01  0:09 ` Simon Marchi (Code Review)
@ 2019-12-01 22:33 ` Sourceware to Gerrit sync (Code Review)
  2019-12-01 22:33 ` Sourceware to Gerrit sync (Code Review)
  2020-01-14  4:11 ` [PATCH] Add gdb.fortran/vla-stride.exp and report a bug (was: Re: [review] gdb/fortran: array stride support) Sergio Durigan Junior
  22 siblings, 0 replies; 34+ messages in thread
From: Sourceware to Gerrit sync (Code Review) @ 2019-12-01 22:33 UTC (permalink / raw)
  To: Andrew Burgess, gdb-patches; +Cc: Simon Marchi, Tom Tromey

Sourceware to Gerrit sync has submitted this change.

Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
......................................................................

gdb/fortran: array stride support

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
---
M gdb/ChangeLog
M gdb/dwarf2read.c
M gdb/f-valprint.c
M gdb/gdbtypes.c
M gdb/gdbtypes.h
M gdb/testsuite/ChangeLog
A gdb/testsuite/gdb.fortran/array-slices.exp
A gdb/testsuite/gdb.fortran/array-slices.f90
A gdb/testsuite/gdb.fortran/derived-type-striding.exp
A gdb/testsuite/gdb.fortran/derived-type-striding.f90
M gdb/valarith.c
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 @@
       && !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 @@
 
   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 @@
 			     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 @@
   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 @@
   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 @@
 /* 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 @@
 	  && !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 @@
 	 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 @@
   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 @@
       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 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 @@
      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 @@
   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 @@
 #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 @@
 				       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 @@
   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

-- 
Gerrit-Project: binutils-gdb
Gerrit-Branch: master
Gerrit-Change-Id: I9af2bcd1f2d4c56f76f5f3f9f89d8f06bef10d9a
Gerrit-Change-Number: 627
Gerrit-PatchSet: 10
Gerrit-Owner: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Andrew Burgess <andrew.burgess@embecosm.com>
Gerrit-Reviewer: Simon Marchi <simon.marchi@polymtl.ca>
Gerrit-CC: Tom Tromey <tromey@sourceware.org>
Gerrit-MessageType: merged

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [PATCH] Add gdb.fortran/vla-stride.exp and report a bug (was: Re: [review] gdb/fortran: array stride support)
  2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
                   ` (21 preceding siblings ...)
  2019-12-01 22:33 ` Sourceware to Gerrit sync (Code Review)
@ 2020-01-14  4:11 ` Sergio Durigan Junior
  2020-01-19  1:59   ` Andrew Burgess
  22 siblings, 1 reply; 34+ messages in thread
From: Sergio Durigan Junior @ 2020-01-14  4:11 UTC (permalink / raw)
  To: gdb-patches, andrew.burgess; +Cc: Joel Brobecker

[-- Attachment #1: Type: text/plain, Size: 3368 bytes --]

On Thursday, November 14 2019, Andrew Burgess wrote:

> Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
> ......................................................................
>
> gdb/fortran: array stride support
> [...]

Hey Andrew,

I found a problem with this patch, and I'd like to know if you've
noticed this as well.  I first encountered the problem while doing
downstream work on Fedora GDB for Fedora Rawhide; as you are probably
aware, we carry *a lot* of local Fortran VLA patches on Fedora GDB (if
you're not aware about this, feel free to get in touch with me and I'll
be more than happy to explain the situation to you).  However, I am able
to reproduce the problem on upstream GDB as well.

On Fedora GDB, we carry a testcase called gdb.fortran/vla-stride.exp.  I'm
attaching it to this message.  One of its tests fails with:

  (gdb) print pvla
  Cannot access memory at address 0x426000
  FAIL: gdb.fortran/vla-stride.exp: print single-element

See more below.

> diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
> index fd1c765..968aeb2 100644
> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
[...]
>  /* Create a range type using either a blank type supplied in
>     RESULT_TYPE, or creating a new type, inheriting the objfile from
>     INDEX_TYPE.
> @@ -982,7 +1011,8 @@
>  has_static_range (const struct range_bounds *bounds)
>  {
>    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 @@
>  	  && !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 @@
>  	 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;

After spending a lot of time investigating this, I found that the
problem because TYPE_LENGTH (result_type) will be set to a ridiculously
high value here, due to the fact that stride (and therefore bit_stride)
will also be ridiculously high.  bit_stride is obtained back in
gdbtypes.c:resolve_dynamic_array_or_string as:

  ...
  else
    bit_stride = TYPE_FIELD_BITSIZE (type, 0);

TBH, I haven't investigated further because this was taking too long,
and I decided to call on the experts.  The code above was added by Joel,
so I took the liberty to Cc him as well.

The test can be found below.

Thanks,

-- 
Sergio
GPG key ID: 237A 54B1 0287 28BF 00EF  31F4 D0EB 7628 65FC 5E36
Please send encrypted e-mail if possible
http://sergiodj.net/


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-gdb.fortran-vla-stride.exp.patch --]
[-- Type: text/x-patch, Size: 4291 bytes --]

From a2192e20726e05463405297d16d0661841360f6a Mon Sep 17 00:00:00 2001
From: Sergio Durigan Junior <sergiodj@redhat.com>
Date: Mon, 13 Jan 2020 22:43:37 -0500
Subject: [PATCH] Add gdb.fortran/vla-stride.exp

This patch adds a new testcase, gdb.fortran/vla-stride.exp, in order
to extend the Fortran stride tests.

This test was part of Fedora GDB.

gdb/testsuite/ChangeLog:
2020-01-14  Sergio Durigan Junior  <sergiodj@redhat.com>

	* gdb.fortran/vla-stride.exp: New file.
	* gdb.fortran/vla-stride.f90: New file.

Change-Id: Ia9756868b550e75143d805f1ed2763a43017804d
---
 gdb/testsuite/gdb.fortran/vla-stride.exp | 44 ++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/vla-stride.f90 | 29 ++++++++++++++++
 2 files changed, 73 insertions(+)
 create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.exp
 create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.f90

diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
new file mode 100644
index 0000000000..15573e22cb
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
@@ -0,0 +1,44 @@
+# Copyright 2016-2020 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/>.
+
+standard_testfile ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
+gdb_continue_to_breakpoint "re-reverse-elements"
+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
+  "print re-reverse-elements"
+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
+
+gdb_breakpoint [gdb_get_line_number "odd-elements"]
+gdb_continue_to_breakpoint "odd-elements"
+gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
+gdb_test "print pvla(1)" " = 1" "print first odd-element"
+gdb_test "print pvla(5)" " = 9" "print last odd-element"
+
+gdb_breakpoint [gdb_get_line_number "single-element"]
+gdb_continue_to_breakpoint "single-element"
+gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
+gdb_test "print pvla(1)" " = 5" "print one single-element"
diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
new file mode 100644
index 0000000000..22b8a65278
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
@@ -0,0 +1,29 @@
+! Copyright 2016-2020 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 vla_stride
+  integer, target, allocatable :: vla (:)
+  integer, pointer :: pvla (:)
+
+  allocate(vla(10))
+  vla = (/ (I, I = 1,10) /)
+
+  pvla => vla(10:1:-1)
+  pvla => pvla(10:1:-1)
+  pvla => vla(1:10:2)   ! re-reverse-elements
+  pvla => vla(5:4:-2)   ! odd-elements
+
+  pvla => null()        ! single-element
+end program vla_stride
-- 
2.21.0


^ permalink raw reply	[flat|nested] 34+ messages in thread

* Re: [PATCH] Add gdb.fortran/vla-stride.exp and report a bug (was: Re: [review] gdb/fortran: array stride support)
  2020-01-14  4:11 ` [PATCH] Add gdb.fortran/vla-stride.exp and report a bug (was: Re: [review] gdb/fortran: array stride support) Sergio Durigan Junior
@ 2020-01-19  1:59   ` Andrew Burgess
  2020-02-05 16:38     ` [PATCH] Add gdb.fortran/vla-stride.exp and report a bug Sergio Durigan Junior
  0 siblings, 1 reply; 34+ messages in thread
From: Andrew Burgess @ 2020-01-19  1:59 UTC (permalink / raw)
  To: Sergio Durigan Junior; +Cc: gdb-patches, Joel Brobecker

* Sergio Durigan Junior <sergiodj@redhat.com> [2020-01-13 22:46:33 -0500]:

> On Thursday, November 14 2019, Andrew Burgess wrote:
> 
> > Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
> > ......................................................................
> >
> > gdb/fortran: array stride support
> > [...]
> 
> Hey Andrew,
> 
> I found a problem with this patch, and I'd like to know if you've
> noticed this as well.  I first encountered the problem while doing
> downstream work on Fedora GDB for Fedora Rawhide; as you are probably
> aware, we carry *a lot* of local Fortran VLA patches on Fedora GDB (if
> you're not aware about this, feel free to get in touch with me and I'll
> be more than happy to explain the situation to you).  However, I am able
> to reproduce the problem on upstream GDB as well.
> 
> On Fedora GDB, we carry a testcase called gdb.fortran/vla-stride.exp.  I'm
> attaching it to this message.  One of its tests fails with:
> 
>   (gdb) print pvla
>   Cannot access memory at address 0x426000
>   FAIL: gdb.fortran/vla-stride.exp: print single-element

Sergio,

First, apologies for not replying sooner, I completely missed this
mail.  My bad!

Thanks for the bug report.  Yes I'm aware that Fedora carries some
Fortran patches, its on my (ever growing) todo list that I should take
a look at them one day.  It kind-of sucks that my top of tree GDB is
sometimes not as good as my slightly older distro-installed GDB!

I put together a patch for this issue (see below) it passes your test
case on my machine (with no other regressions), but it would be neat
if you could confirm it resolves the issue for you.

This particular case is about negative array strides, which in general
(right now) wont work in GDB ... however, this particular case is
special, it's a 1 element array with a negative array stride, that we
can do, if we don't deliberately sabotage ourselves by treating the
negative stride as unsigned.

As for negative array strides in general, I'm working on this, but
it's a big change and I don't know when it will be finished.

Anyway, patch below.  Feedback welcome.  I'll push this in a week or
so if I don't get any negative feedback.

One question - I included your testcase in this patch, I just wanted
to check that this is OK for upstream (w.r.t. copyright assignment, etc)?

Thanks,
Andrew

---

commit 6cedcaebf82d3a1b4e6defd5a07b02c0807a29af
Author: Andrew Burgess <andrew.burgess@embecosm.com>
Date:   Sat Jan 18 22:38:29 2020 +0000

    gdb/fortran: Support negative array stride in one limited case
    
    This commit adds support for negative Fortran array stride in one
    limited case, that is the case of a single element array with a
    negative array stride.
    
    The changes in this commit will be required in order for more general
    negative array stride support to work correctly, however, right now
    other problems in GDB prevent negative array strides from working in
    the general case.
    
    The reason negative array strides don't currently work in the general
    case is that when dealing with such arrays, the base address for the
    objects data is actually the highest addressed element, subsequent
    elements are then accessed with a negative offset from that address.
    
    Currently GDB supports positive type sizes, and having the base
    address of an object being its lowest address.  I am working on a
    patch series to add more general negative array stride support,
    however, this is a much larger piece of work.
    
    The changes here can be summarised as, stop treating signed values as
    unsigned, specifically, the array stride, and offsets calculated using
    the array stride.
    
    The test for this issue was posted to the list by Sergio:
    
      https://sourceware.org/ml/gdb-patches/2020-01/msg00360.html
    
    Change-Id: I9087c767d1640946a0b876ea0920481e18ffed7c

diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 1d5bfd4bc20..d1201b1df9a 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1223,7 +1223,7 @@ create_array_type_with_stride (struct type *result_type,
 	  && !type_not_allocated (result_type)))
     {
       LONGEST low_bound, high_bound;
-      unsigned int stride;
+      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
@@ -1241,9 +1241,18 @@ 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 (stride > 0)
-	TYPE_LENGTH (result_type) =
-	  (stride * (high_bound - low_bound + 1) + 7) / 8;
+      else if (stride != 0)
+	{
+	  /* Ensure that the type length is always positive, even in the
+	     case where (for example in Fortran) we have a negative
+	     stride.  It is possible to have a single element array with a
+	     negative stride in Fortran (this doesn't mean anything
+	     special, it's still just a single element array) so do
+	     consider that case when touching this code.  */
+	  LONGEST element_count = abs (high_bound - low_bound + 1);
+	  TYPE_LENGTH (result_type)
+	    = ((abs (stride) * element_count) + 7) / 8;
+	}
       else
 	TYPE_LENGTH (result_type) =
 	  TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
new file mode 100644
index 00000000000..15573e22cb3
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
@@ -0,0 +1,44 @@
+# Copyright 2016-2020 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/>.
+
+standard_testfile ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
+gdb_continue_to_breakpoint "re-reverse-elements"
+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
+  "print re-reverse-elements"
+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
+
+gdb_breakpoint [gdb_get_line_number "odd-elements"]
+gdb_continue_to_breakpoint "odd-elements"
+gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
+gdb_test "print pvla(1)" " = 1" "print first odd-element"
+gdb_test "print pvla(5)" " = 9" "print last odd-element"
+
+gdb_breakpoint [gdb_get_line_number "single-element"]
+gdb_continue_to_breakpoint "single-element"
+gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
+gdb_test "print pvla(1)" " = 5" "print one single-element"
diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
new file mode 100644
index 00000000000..22b8a65278e
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
@@ -0,0 +1,29 @@
+! Copyright 2016-2020 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 vla_stride
+  integer, target, allocatable :: vla (:)
+  integer, pointer :: pvla (:)
+
+  allocate(vla(10))
+  vla = (/ (I, I = 1,10) /)
+
+  pvla => vla(10:1:-1)
+  pvla => pvla(10:1:-1)
+  pvla => vla(1:10:2)   ! re-reverse-elements
+  pvla => vla(5:4:-2)   ! odd-elements
+
+  pvla => null()        ! single-element
+end program vla_stride
diff --git a/gdb/valarith.c b/gdb/valarith.c
index 79b148602bb..be0e0731bee 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -187,7 +187,7 @@ 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);
+  LONGEST elt_size = type_length_units (elt_type);
 
   /* Fetch the bit stride and convert it to a byte stride, assuming 8 bits
      in a byte.  */
@@ -199,7 +199,7 @@ value_subscripted_rvalue (struct value *array, LONGEST index, LONGEST lowerbound
       elt_size = stride / (unit_size * 8);
     }
 
-  ULONGEST elt_offs = elt_size * (index - lowerbound);
+  LONGEST elt_offs = elt_size * (index - lowerbound);
 
   if (index < lowerbound
       || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)

^ permalink raw reply	[flat|nested] 34+ messages in thread

* Re: [PATCH] Add gdb.fortran/vla-stride.exp and report a bug
  2020-01-19  1:59   ` Andrew Burgess
@ 2020-02-05 16:38     ` Sergio Durigan Junior
  2020-02-25 16:35       ` [PUSHED] gdb/fortran: Support negative array stride in one limited case Andrew Burgess
  0 siblings, 1 reply; 34+ messages in thread
From: Sergio Durigan Junior @ 2020-02-05 16:38 UTC (permalink / raw)
  To: Andrew Burgess; +Cc: gdb-patches, Joel Brobecker

On Saturday, January 18 2020, Andrew Burgess wrote:

> * Sergio Durigan Junior <sergiodj@redhat.com> [2020-01-13 22:46:33 -0500]:
>
>> On Thursday, November 14 2019, Andrew Burgess wrote:
>> 
>> > Change URL: https://gnutoolchain-gerrit.osci.io/r/c/binutils-gdb/+/627
>> > ......................................................................
>> >
>> > gdb/fortran: array stride support
>> > [...]
>> 
>> Hey Andrew,
>> 
>> I found a problem with this patch, and I'd like to know if you've
>> noticed this as well.  I first encountered the problem while doing
>> downstream work on Fedora GDB for Fedora Rawhide; as you are probably
>> aware, we carry *a lot* of local Fortran VLA patches on Fedora GDB (if
>> you're not aware about this, feel free to get in touch with me and I'll
>> be more than happy to explain the situation to you).  However, I am able
>> to reproduce the problem on upstream GDB as well.
>> 
>> On Fedora GDB, we carry a testcase called gdb.fortran/vla-stride.exp.  I'm
>> attaching it to this message.  One of its tests fails with:
>> 
>>   (gdb) print pvla
>>   Cannot access memory at address 0x426000
>>   FAIL: gdb.fortran/vla-stride.exp: print single-element
>
> Sergio,
>
> First, apologies for not replying sooner, I completely missed this
> mail.  My bad!

That's totally fine -- I also took too long to reply.

> Thanks for the bug report.  Yes I'm aware that Fedora carries some
> Fortran patches, its on my (ever growing) todo list that I should take
> a look at them one day.  It kind-of sucks that my top of tree GDB is
> sometimes not as good as my slightly older distro-installed GDB!

Hah, yeah :-).  It'd be great to have your help with the patches; let me
know when you can dedicate some time, and we can coordinate efforts.

> I put together a patch for this issue (see below) it passes your test
> case on my machine (with no other regressions), but it would be neat
> if you could confirm it resolves the issue for you.

Thanks a lot.  I've just confirmed that the patch indeed fixes the
issue.

> One question - I included your testcase in this patch, I just wanted
> to check that this is OK for upstream (w.r.t. copyright assignment, etc)?

So, as we discussed on IRC, I don't have the exact authorship
information for the testcase, but I think it was written by Bernhard
Heckel <bernhard dot heckel at intel dot com>.  I'm almost sure that
this was contributed by Intel, and if that's the case, then they have
copyright assignment on file with us, so it should be fine to push the
patch as is.

I'll let you know if I find more info on this, but apparently (based on
our IRC talk) you're going to write a new test anyway, so please don't
wait for me.

Cheers,

-- 
Sergio
GPG key ID: 237A 54B1 0287 28BF 00EF  31F4 D0EB 7628 65FC 5E36
Please send encrypted e-mail if possible
http://sergiodj.net/

^ permalink raw reply	[flat|nested] 34+ messages in thread

* [PUSHED] gdb/fortran: Support negative array stride in one limited case
  2020-02-05 16:38     ` [PATCH] Add gdb.fortran/vla-stride.exp and report a bug Sergio Durigan Junior
@ 2020-02-25 16:35       ` Andrew Burgess
  2020-08-06 10:41         ` Copyright status gdb.fortran/vla-stride.exp test-case Tom de Vries
  2020-12-12  6:33         ` [PUSHED] gdb/fortran: Support negative array stride in one limited case Simon Marchi
  0 siblings, 2 replies; 34+ messages in thread
From: Andrew Burgess @ 2020-02-25 16:35 UTC (permalink / raw)
  To: gdb-patches; +Cc: Andrew Burgess

I've pushed this fix now.  The exact patch I pushed is included below.


Thanks,
Andrew




---

This commit adds support for negative Fortran array strides in one
limited case, that is the case of a single element array with a
negative array stride.

The changes in this commit will be required in order for more general
negative array stride support to work correctly, however, right now
other problems in GDB prevent negative array strides from working in
the general case.

The reason negative array strides don't currently work in the general
case is that when dealing with such arrays, the base address for the
objects data is actually the highest addressed element, subsequent
elements are then accessed with a negative offset from that address,
and GDB is not currently happy with this configuration.

The changes here can be summarised as, stop treating signed values as
unsigned, specifically, the array stride, and offsets calculated using
the array stride.

This issue was identified on the mailing list by Sergio:

  https://sourceware.org/ml/gdb-patches/2020-01/msg00360.html

The test for this issue is a new one written by me as the copyright
status of the original test is currently unknown.

gdb/ChangeLog:

	* gdbtypes.c (create_array_type_with_stride): Handle negative
	array strides.
	* valarith.c (value_subscripted_rvalue): Likewise.

gdb/testsuite/ChangeLog:

	* gdb.fortran/derived-type-striding.exp: Add a new test.
	* gdb.fortran/derived-type-striding.f90: Add pointer variable for
	new test.
---
 gdb/ChangeLog                                       |  6 ++++++
 gdb/gdbtypes.c                                      | 17 +++++++++++++----
 gdb/testsuite/ChangeLog                             |  6 ++++++
 gdb/testsuite/gdb.fortran/derived-type-striding.exp |  2 ++
 gdb/testsuite/gdb.fortran/derived-type-striding.f90 |  2 ++
 gdb/valarith.c                                      |  4 ++--
 6 files changed, 31 insertions(+), 6 deletions(-)

diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 85758930491..ef110b30445 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1223,7 +1223,7 @@ create_array_type_with_stride (struct type *result_type,
 	  && !type_not_allocated (result_type)))
     {
       LONGEST low_bound, high_bound;
-      unsigned int stride;
+      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
@@ -1241,9 +1241,18 @@ 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 (stride > 0)
-	TYPE_LENGTH (result_type) =
-	  (stride * (high_bound - low_bound + 1) + 7) / 8;
+      else if (stride != 0)
+	{
+	  /* Ensure that the type length is always positive, even in the
+	     case where (for example in Fortran) we have a negative
+	     stride.  It is possible to have a single element array with a
+	     negative stride in Fortran (this doesn't mean anything
+	     special, it's still just a single element array) so do
+	     consider that case when touching this code.  */
+	  LONGEST element_count = abs (high_bound - low_bound + 1);
+	  TYPE_LENGTH (result_type)
+	    = ((abs (stride) * element_count) + 7) / 8;
+	}
       else
 	TYPE_LENGTH (result_type) =
 	  TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
diff --git a/gdb/testsuite/gdb.fortran/derived-type-striding.exp b/gdb/testsuite/gdb.fortran/derived-type-striding.exp
index 094843ca8b1..639dc4c9528 100644
--- a/gdb/testsuite/gdb.fortran/derived-type-striding.exp
+++ b/gdb/testsuite/gdb.fortran/derived-type-striding.exp
@@ -41,3 +41,5 @@ gdb_test "p point_dimension" "= \\\(2, 2, 2, 2, 2, 2, 2, 2, 2\\\)"
 # Test mixed type derived type.
 if { $gcc_with_broken_stride } { setup_kfail *-*-* gcc/92775 }
 gdb_test "p point_mixed_dimension" "= \\\(3, 3, 3, 3\\\)"
+
+gdb_test "p cloud_slice" " = \\\(\\\( x = 1, y = 2, z = 3 \\\)\\\)"
diff --git a/gdb/testsuite/gdb.fortran/derived-type-striding.f90 b/gdb/testsuite/gdb.fortran/derived-type-striding.f90
index 26829f51dc0..fb537579faa 100644
--- a/gdb/testsuite/gdb.fortran/derived-type-striding.f90
+++ b/gdb/testsuite/gdb.fortran/derived-type-striding.f90
@@ -28,9 +28,11 @@ program derived_type_member_stride
     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()
+    type(cartesian), dimension(:), pointer :: cloud_slice => null()
     cloud(:)%x = 1
     cloud(:)%y = 2
     cloud(:)%z = 3
+    cloud_slice => cloud(3:2:-2)
     point_dimension => cloud(1:9)%y
     mixed_cloud(:)%x = 1
     mixed_cloud(:)%y = 2
diff --git a/gdb/valarith.c b/gdb/valarith.c
index 79b148602bb..be0e0731bee 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -187,7 +187,7 @@ 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);
+  LONGEST elt_size = type_length_units (elt_type);
 
   /* Fetch the bit stride and convert it to a byte stride, assuming 8 bits
      in a byte.  */
@@ -199,7 +199,7 @@ value_subscripted_rvalue (struct value *array, LONGEST index, LONGEST lowerbound
       elt_size = stride / (unit_size * 8);
     }
 
-  ULONGEST elt_offs = elt_size * (index - lowerbound);
+  LONGEST elt_offs = elt_size * (index - lowerbound);
 
   if (index < lowerbound
       || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
-- 
2.14.5

^ permalink raw reply	[flat|nested] 34+ messages in thread

* Copyright status gdb.fortran/vla-stride.exp test-case
  2020-02-25 16:35       ` [PUSHED] gdb/fortran: Support negative array stride in one limited case Andrew Burgess
@ 2020-08-06 10:41         ` Tom de Vries
  2020-08-06 13:35           ` Andrew Burgess
  2020-12-12  6:33         ` [PUSHED] gdb/fortran: Support negative array stride in one limited case Simon Marchi
  1 sibling, 1 reply; 34+ messages in thread
From: Tom de Vries @ 2020-08-06 10:41 UTC (permalink / raw)
  To: Andrew Burgess, gdb-patches; +Cc: heckel_bernhard

[ was: Re: [PUSHED] gdb/fortran: Support negative array stride in one
limited case ]

On 2/25/20 5:35 PM, Andrew Burgess wrote:
> This issue was identified on the mailing list by Sergio:
> 
>   https://sourceware.org/ml/gdb-patches/2020-01/msg00360.html
> 
> The test for this issue is a new one written by me as the copyright
> status of the original test is currently unknown.

I just ran that test-case on master, and it passes, so it could be
committed from that point of view.

I've tracked down the test-case to commit 4efec01384 "vla: add stride
support to fortran arrays." on user branch
origin/users/bheckel/fortran-strides :
...
commit 4efec01384648183cff07a8d6f050e47074ecfcd
Author: Keven Boell <keven.boell@intel.com>
Date:   Wed May 28 14:44:11 2014 +0100

    vla: add stride support to fortran arrays.

    2014-05-28  Bernhard Heckel  <bernhard.heckel@intel.com>
                Sanimir Agovic  <sanimir.agovic@intel.com>
                Keven Boell  <keven.boell@intel.com>
...

It's not clear from the patch who contributed to the test-case.

Bernard Heckel is listed in MAINTAINERS, the others not, but they are
listed in both gdb and gdb/testsuite ChangeLogs.

That's as far as I can take it.  Perhaps someone can look up the
copyright assignment status.

Thanks,
- Tom

^ permalink raw reply	[flat|nested] 34+ messages in thread

* Re: Copyright status gdb.fortran/vla-stride.exp test-case
  2020-08-06 10:41         ` Copyright status gdb.fortran/vla-stride.exp test-case Tom de Vries
@ 2020-08-06 13:35           ` Andrew Burgess
  2020-08-18  9:50             ` Tom de Vries
  0 siblings, 1 reply; 34+ messages in thread
From: Andrew Burgess @ 2020-08-06 13:35 UTC (permalink / raw)
  To: Tom de Vries; +Cc: gdb-patches, heckel_bernhard

* Tom de Vries <tdevries@suse.de> [2020-08-06 12:41:36 +0200]:

> [ was: Re: [PUSHED] gdb/fortran: Support negative array stride in one
> limited case ]
> 
> On 2/25/20 5:35 PM, Andrew Burgess wrote:
> > This issue was identified on the mailing list by Sergio:
> > 
> >   https://sourceware.org/ml/gdb-patches/2020-01/msg00360.html
> > 
> > The test for this issue is a new one written by me as the copyright
> > status of the original test is currently unknown.
> 
> I just ran that test-case on master, and it passes, so it could be
> committed from that point of view.
> 
> I've tracked down the test-case to commit 4efec01384 "vla: add stride
> support to fortran arrays." on user branch
> origin/users/bheckel/fortran-strides :
> ...
> commit 4efec01384648183cff07a8d6f050e47074ecfcd
> Author: Keven Boell <keven.boell@intel.com>
> Date:   Wed May 28 14:44:11 2014 +0100
> 
>     vla: add stride support to fortran arrays.
> 
>     2014-05-28  Bernhard Heckel  <bernhard.heckel@intel.com>
>                 Sanimir Agovic  <sanimir.agovic@intel.com>
>                 Keven Boell  <keven.boell@intel.com>
> ...
> 
> It's not clear from the patch who contributed to the test-case.
> 
> Bernard Heckel is listed in MAINTAINERS, the others not, but they are
> listed in both gdb and gdb/testsuite ChangeLogs.
> 
> That's as far as I can take it.  Perhaps someone can look up the
> copyright assignment status.

I'm confused.  I thought the new test I wrote covered the issues
Sergio raised.  Is there some case that Bernard's test covers that is
not already covered by the existing Fortran tests?  What's the
motivation for tracking down the copyright status for this test?

Thanks,
Andrew


^ permalink raw reply	[flat|nested] 34+ messages in thread

* Re: Copyright status gdb.fortran/vla-stride.exp test-case
  2020-08-06 13:35           ` Andrew Burgess
@ 2020-08-18  9:50             ` Tom de Vries
  2020-08-18 10:12               ` Andrew Burgess
  0 siblings, 1 reply; 34+ messages in thread
From: Tom de Vries @ 2020-08-18  9:50 UTC (permalink / raw)
  To: Andrew Burgess; +Cc: gdb-patches, heckel_bernhard

On 8/6/20 3:35 PM, Andrew Burgess wrote:
> * Tom de Vries <tdevries@suse.de> [2020-08-06 12:41:36 +0200]:
> 
>> [ was: Re: [PUSHED] gdb/fortran: Support negative array stride in one
>> limited case ]
>>
>> On 2/25/20 5:35 PM, Andrew Burgess wrote:
>>> This issue was identified on the mailing list by Sergio:
>>>
>>>   https://sourceware.org/ml/gdb-patches/2020-01/msg00360.html
>>>
>>> The test for this issue is a new one written by me as the copyright
>>> status of the original test is currently unknown.
>>
>> I just ran that test-case on master, and it passes, so it could be
>> committed from that point of view.
>>
>> I've tracked down the test-case to commit 4efec01384 "vla: add stride
>> support to fortran arrays." on user branch
>> origin/users/bheckel/fortran-strides :
>> ...
>> commit 4efec01384648183cff07a8d6f050e47074ecfcd
>> Author: Keven Boell <keven.boell@intel.com>
>> Date:   Wed May 28 14:44:11 2014 +0100
>>
>>     vla: add stride support to fortran arrays.
>>
>>     2014-05-28  Bernhard Heckel  <bernhard.heckel@intel.com>
>>                 Sanimir Agovic  <sanimir.agovic@intel.com>
>>                 Keven Boell  <keven.boell@intel.com>
>> ...
>>
>> It's not clear from the patch who contributed to the test-case.
>>
>> Bernard Heckel is listed in MAINTAINERS, the others not, but they are
>> listed in both gdb and gdb/testsuite ChangeLogs.
>>
>> That's as far as I can take it.  Perhaps someone can look up the
>> copyright assignment status.
> 
> I'm confused.  I thought the new test I wrote covered the issues
> Sergio raised.

Right, I'm not questioning that.

> Is there some case that Bernard's test covers that is
> not already covered by the existing Fortran tests?

I don't know.  I assumed that your test covered the problem that was
reported, but not necessarily the whole test in which the problem was found.

>  What's the
> motivation for tracking down the copyright status for this test?

It's part of the fedora patches for gdb, and there is an ongoing effort
to move those to upstream gdb.  And I found that the test-case passed on
trunk, so that looked easy.

Thanks,
- Tom

^ permalink raw reply	[flat|nested] 34+ messages in thread

* Re: Copyright status gdb.fortran/vla-stride.exp test-case
  2020-08-18  9:50             ` Tom de Vries
@ 2020-08-18 10:12               ` Andrew Burgess
  0 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2020-08-18 10:12 UTC (permalink / raw)
  To: Tom de Vries; +Cc: gdb-patches, heckel_bernhard

* Tom de Vries <tdevries@suse.de> [2020-08-18 11:50:29 +0200]:

> On 8/6/20 3:35 PM, Andrew Burgess wrote:
> > * Tom de Vries <tdevries@suse.de> [2020-08-06 12:41:36 +0200]:
> > 
> >> [ was: Re: [PUSHED] gdb/fortran: Support negative array stride in one
> >> limited case ]
> >>
> >> On 2/25/20 5:35 PM, Andrew Burgess wrote:
> >>> This issue was identified on the mailing list by Sergio:
> >>>
> >>>   https://sourceware.org/ml/gdb-patches/2020-01/msg00360.html
> >>>
> >>> The test for this issue is a new one written by me as the copyright
> >>> status of the original test is currently unknown.
> >>
> >> I just ran that test-case on master, and it passes, so it could be
> >> committed from that point of view.
> >>
> >> I've tracked down the test-case to commit 4efec01384 "vla: add stride
> >> support to fortran arrays." on user branch
> >> origin/users/bheckel/fortran-strides :
> >> ...
> >> commit 4efec01384648183cff07a8d6f050e47074ecfcd
> >> Author: Keven Boell <keven.boell@intel.com>
> >> Date:   Wed May 28 14:44:11 2014 +0100
> >>
> >>     vla: add stride support to fortran arrays.
> >>
> >>     2014-05-28  Bernhard Heckel  <bernhard.heckel@intel.com>
> >>                 Sanimir Agovic  <sanimir.agovic@intel.com>
> >>                 Keven Boell  <keven.boell@intel.com>
> >> ...
> >>
> >> It's not clear from the patch who contributed to the test-case.
> >>
> >> Bernard Heckel is listed in MAINTAINERS, the others not, but they are
> >> listed in both gdb and gdb/testsuite ChangeLogs.
> >>
> >> That's as far as I can take it.  Perhaps someone can look up the
> >> copyright assignment status.
> > 
> > I'm confused.  I thought the new test I wrote covered the issues
> > Sergio raised.
> 
> Right, I'm not questioning that.
> 
> > Is there some case that Bernard's test covers that is
> > not already covered by the existing Fortran tests?
> 
> I don't know.  I assumed that your test covered the problem that was
> reported, but not necessarily the whole test in which the problem was found.
> 
> >  What's the
> > motivation for tracking down the copyright status for this test?
> 
> It's part of the fedora patches for gdb, and there is an ongoing effort
> to move those to upstream gdb.  And I found that the test-case passed on
> trunk, so that looked easy.

Thanks.  With this explanation everything becomes much clearer.

Andrew

^ permalink raw reply	[flat|nested] 34+ messages in thread

* Re: [PUSHED] gdb/fortran: Support negative array stride in one limited case
  2020-02-25 16:35       ` [PUSHED] gdb/fortran: Support negative array stride in one limited case Andrew Burgess
  2020-08-06 10:41         ` Copyright status gdb.fortran/vla-stride.exp test-case Tom de Vries
@ 2020-12-12  6:33         ` Simon Marchi
  2020-12-12 22:18           ` Andrew Burgess
  1 sibling, 1 reply; 34+ messages in thread
From: Simon Marchi @ 2020-12-12  6:33 UTC (permalink / raw)
  To: Andrew Burgess, gdb-patches

Hi Andrew,

Sorry to revive this thread.

I build my GDB with ASan, and I see the gdb.fortran/vla-type.exp test crashing GDB with:

ptype fivedynarr(2)
/home/smarchi/src/binutils-gdb/gdb/valarith.c:1171:10: runtime error: signed integer overflow: 16777216 * 140737351048816 cannot be represented in type 'long int'

Commit 5bbd8269fa8d ("gdb/fortran: array stride support") is the first one where it does
this.

Simon

On 2020-02-25 11:35 a.m., Andrew Burgess wrote:
> I've pushed this fix now.  The exact patch I pushed is included below.
> 
> 
> Thanks,
> Andrew
> 
> 
> 
> 
> ---
> 
> This commit adds support for negative Fortran array strides in one
> limited case, that is the case of a single element array with a
> negative array stride.
> 
> The changes in this commit will be required in order for more general
> negative array stride support to work correctly, however, right now
> other problems in GDB prevent negative array strides from working in
> the general case.
> 
> The reason negative array strides don't currently work in the general
> case is that when dealing with such arrays, the base address for the
> objects data is actually the highest addressed element, subsequent
> elements are then accessed with a negative offset from that address,
> and GDB is not currently happy with this configuration.
> 
> The changes here can be summarised as, stop treating signed values as
> unsigned, specifically, the array stride, and offsets calculated using
> the array stride.
> 
> This issue was identified on the mailing list by Sergio:
> 
>   https://sourceware.org/ml/gdb-patches/2020-01/msg00360.html
> 
> The test for this issue is a new one written by me as the copyright
> status of the original test is currently unknown.
> 
> gdb/ChangeLog:
> 
> 	* gdbtypes.c (create_array_type_with_stride): Handle negative
> 	array strides.
> 	* valarith.c (value_subscripted_rvalue): Likewise.
> 
> gdb/testsuite/ChangeLog:
> 
> 	* gdb.fortran/derived-type-striding.exp: Add a new test.
> 	* gdb.fortran/derived-type-striding.f90: Add pointer variable for
> 	new test.
> ---
>  gdb/ChangeLog                                       |  6 ++++++
>  gdb/gdbtypes.c                                      | 17 +++++++++++++----
>  gdb/testsuite/ChangeLog                             |  6 ++++++
>  gdb/testsuite/gdb.fortran/derived-type-striding.exp |  2 ++
>  gdb/testsuite/gdb.fortran/derived-type-striding.f90 |  2 ++
>  gdb/valarith.c                                      |  4 ++--
>  6 files changed, 31 insertions(+), 6 deletions(-)
> 
> diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
> index 85758930491..ef110b30445 100644
> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
> @@ -1223,7 +1223,7 @@ create_array_type_with_stride (struct type *result_type,
>  	  && !type_not_allocated (result_type)))
>      {
>        LONGEST low_bound, high_bound;
> -      unsigned int stride;
> +      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
> @@ -1241,9 +1241,18 @@ 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 (stride > 0)
> -	TYPE_LENGTH (result_type) =
> -	  (stride * (high_bound - low_bound + 1) + 7) / 8;
> +      else if (stride != 0)
> +	{
> +	  /* Ensure that the type length is always positive, even in the
> +	     case where (for example in Fortran) we have a negative
> +	     stride.  It is possible to have a single element array with a
> +	     negative stride in Fortran (this doesn't mean anything
> +	     special, it's still just a single element array) so do
> +	     consider that case when touching this code.  */
> +	  LONGEST element_count = abs (high_bound - low_bound + 1);
> +	  TYPE_LENGTH (result_type)
> +	    = ((abs (stride) * element_count) + 7) / 8;
> +	}
>        else
>  	TYPE_LENGTH (result_type) =
>  	  TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
> diff --git a/gdb/testsuite/gdb.fortran/derived-type-striding.exp b/gdb/testsuite/gdb.fortran/derived-type-striding.exp
> index 094843ca8b1..639dc4c9528 100644
> --- a/gdb/testsuite/gdb.fortran/derived-type-striding.exp
> +++ b/gdb/testsuite/gdb.fortran/derived-type-striding.exp
> @@ -41,3 +41,5 @@ gdb_test "p point_dimension" "= \\\(2, 2, 2, 2, 2, 2, 2, 2, 2\\\)"
>  # Test mixed type derived type.
>  if { $gcc_with_broken_stride } { setup_kfail *-*-* gcc/92775 }
>  gdb_test "p point_mixed_dimension" "= \\\(3, 3, 3, 3\\\)"
> +
> +gdb_test "p cloud_slice" " = \\\(\\\( x = 1, y = 2, z = 3 \\\)\\\)"
> diff --git a/gdb/testsuite/gdb.fortran/derived-type-striding.f90 b/gdb/testsuite/gdb.fortran/derived-type-striding.f90
> index 26829f51dc0..fb537579faa 100644
> --- a/gdb/testsuite/gdb.fortran/derived-type-striding.f90
> +++ b/gdb/testsuite/gdb.fortran/derived-type-striding.f90
> @@ -28,9 +28,11 @@ program derived_type_member_stride
>      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()
> +    type(cartesian), dimension(:), pointer :: cloud_slice => null()
>      cloud(:)%x = 1
>      cloud(:)%y = 2
>      cloud(:)%z = 3
> +    cloud_slice => cloud(3:2:-2)
>      point_dimension => cloud(1:9)%y
>      mixed_cloud(:)%x = 1
>      mixed_cloud(:)%y = 2
> diff --git a/gdb/valarith.c b/gdb/valarith.c
> index 79b148602bb..be0e0731bee 100644
> --- a/gdb/valarith.c
> +++ b/gdb/valarith.c
> @@ -187,7 +187,7 @@ 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);
> +  LONGEST elt_size = type_length_units (elt_type);
>  
>    /* Fetch the bit stride and convert it to a byte stride, assuming 8 bits
>       in a byte.  */
> @@ -199,7 +199,7 @@ value_subscripted_rvalue (struct value *array, LONGEST index, LONGEST lowerbound
>        elt_size = stride / (unit_size * 8);
>      }
>  
> -  ULONGEST elt_offs = elt_size * (index - lowerbound);
> +  LONGEST elt_offs = elt_size * (index - lowerbound);
>  
>    if (index < lowerbound
>        || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
> 

^ permalink raw reply	[flat|nested] 34+ messages in thread

* Re: [PUSHED] gdb/fortran: Support negative array stride in one limited case
  2020-12-12  6:33         ` [PUSHED] gdb/fortran: Support negative array stride in one limited case Simon Marchi
@ 2020-12-12 22:18           ` Andrew Burgess
  2020-12-13  0:51             ` Simon Marchi
  0 siblings, 1 reply; 34+ messages in thread
From: Andrew Burgess @ 2020-12-12 22:18 UTC (permalink / raw)
  To: Simon Marchi; +Cc: gdb-patches

* Simon Marchi <simon.marchi@polymtl.ca> [2020-12-12 01:33:21 -0500]:

> Hi Andrew,
> 
> Sorry to revive this thread.
> 
> I build my GDB with ASan, and I see the gdb.fortran/vla-type.exp test crashing GDB with:
> 
> ptype fivedynarr(2)
> /home/smarchi/src/binutils-gdb/gdb/valarith.c:1171:10: runtime error: signed integer overflow: 16777216 * 140737351048816 cannot be represented in type 'long int'
> 
> Commit 5bbd8269fa8d ("gdb/fortran: array stride support") is the first one where it does

Thanks for bringing this to my attention.  I'll take a look at this
next week.

Andrew


> this.
> 
> Simon
> 
> On 2020-02-25 11:35 a.m., Andrew Burgess wrote:
> > I've pushed this fix now.  The exact patch I pushed is included below.
> > 
> > 
> > Thanks,
> > Andrew
> > 
> > 
> > 
> > 
> > ---
> > 
> > This commit adds support for negative Fortran array strides in one
> > limited case, that is the case of a single element array with a
> > negative array stride.
> > 
> > The changes in this commit will be required in order for more general
> > negative array stride support to work correctly, however, right now
> > other problems in GDB prevent negative array strides from working in
> > the general case.
> > 
> > The reason negative array strides don't currently work in the general
> > case is that when dealing with such arrays, the base address for the
> > objects data is actually the highest addressed element, subsequent
> > elements are then accessed with a negative offset from that address,
> > and GDB is not currently happy with this configuration.
> > 
> > The changes here can be summarised as, stop treating signed values as
> > unsigned, specifically, the array stride, and offsets calculated using
> > the array stride.
> > 
> > This issue was identified on the mailing list by Sergio:
> > 
> >   https://sourceware.org/ml/gdb-patches/2020-01/msg00360.html
> > 
> > The test for this issue is a new one written by me as the copyright
> > status of the original test is currently unknown.
> > 
> > gdb/ChangeLog:
> > 
> > 	* gdbtypes.c (create_array_type_with_stride): Handle negative
> > 	array strides.
> > 	* valarith.c (value_subscripted_rvalue): Likewise.
> > 
> > gdb/testsuite/ChangeLog:
> > 
> > 	* gdb.fortran/derived-type-striding.exp: Add a new test.
> > 	* gdb.fortran/derived-type-striding.f90: Add pointer variable for
> > 	new test.
> > ---
> >  gdb/ChangeLog                                       |  6 ++++++
> >  gdb/gdbtypes.c                                      | 17 +++++++++++++----
> >  gdb/testsuite/ChangeLog                             |  6 ++++++
> >  gdb/testsuite/gdb.fortran/derived-type-striding.exp |  2 ++
> >  gdb/testsuite/gdb.fortran/derived-type-striding.f90 |  2 ++
> >  gdb/valarith.c                                      |  4 ++--
> >  6 files changed, 31 insertions(+), 6 deletions(-)
> > 
> > diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
> > index 85758930491..ef110b30445 100644
> > --- a/gdb/gdbtypes.c
> > +++ b/gdb/gdbtypes.c
> > @@ -1223,7 +1223,7 @@ create_array_type_with_stride (struct type *result_type,
> >  	  && !type_not_allocated (result_type)))
> >      {
> >        LONGEST low_bound, high_bound;
> > -      unsigned int stride;
> > +      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
> > @@ -1241,9 +1241,18 @@ 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 (stride > 0)
> > -	TYPE_LENGTH (result_type) =
> > -	  (stride * (high_bound - low_bound + 1) + 7) / 8;
> > +      else if (stride != 0)
> > +	{
> > +	  /* Ensure that the type length is always positive, even in the
> > +	     case where (for example in Fortran) we have a negative
> > +	     stride.  It is possible to have a single element array with a
> > +	     negative stride in Fortran (this doesn't mean anything
> > +	     special, it's still just a single element array) so do
> > +	     consider that case when touching this code.  */
> > +	  LONGEST element_count = abs (high_bound - low_bound + 1);
> > +	  TYPE_LENGTH (result_type)
> > +	    = ((abs (stride) * element_count) + 7) / 8;
> > +	}
> >        else
> >  	TYPE_LENGTH (result_type) =
> >  	  TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
> > diff --git a/gdb/testsuite/gdb.fortran/derived-type-striding.exp b/gdb/testsuite/gdb.fortran/derived-type-striding.exp
> > index 094843ca8b1..639dc4c9528 100644
> > --- a/gdb/testsuite/gdb.fortran/derived-type-striding.exp
> > +++ b/gdb/testsuite/gdb.fortran/derived-type-striding.exp
> > @@ -41,3 +41,5 @@ gdb_test "p point_dimension" "= \\\(2, 2, 2, 2, 2, 2, 2, 2, 2\\\)"
> >  # Test mixed type derived type.
> >  if { $gcc_with_broken_stride } { setup_kfail *-*-* gcc/92775 }
> >  gdb_test "p point_mixed_dimension" "= \\\(3, 3, 3, 3\\\)"
> > +
> > +gdb_test "p cloud_slice" " = \\\(\\\( x = 1, y = 2, z = 3 \\\)\\\)"
> > diff --git a/gdb/testsuite/gdb.fortran/derived-type-striding.f90 b/gdb/testsuite/gdb.fortran/derived-type-striding.f90
> > index 26829f51dc0..fb537579faa 100644
> > --- a/gdb/testsuite/gdb.fortran/derived-type-striding.f90
> > +++ b/gdb/testsuite/gdb.fortran/derived-type-striding.f90
> > @@ -28,9 +28,11 @@ program derived_type_member_stride
> >      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()
> > +    type(cartesian), dimension(:), pointer :: cloud_slice => null()
> >      cloud(:)%x = 1
> >      cloud(:)%y = 2
> >      cloud(:)%z = 3
> > +    cloud_slice => cloud(3:2:-2)
> >      point_dimension => cloud(1:9)%y
> >      mixed_cloud(:)%x = 1
> >      mixed_cloud(:)%y = 2
> > diff --git a/gdb/valarith.c b/gdb/valarith.c
> > index 79b148602bb..be0e0731bee 100644
> > --- a/gdb/valarith.c
> > +++ b/gdb/valarith.c
> > @@ -187,7 +187,7 @@ 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);
> > +  LONGEST elt_size = type_length_units (elt_type);
> >  
> >    /* Fetch the bit stride and convert it to a byte stride, assuming 8 bits
> >       in a byte.  */
> > @@ -199,7 +199,7 @@ value_subscripted_rvalue (struct value *array, LONGEST index, LONGEST lowerbound
> >        elt_size = stride / (unit_size * 8);
> >      }
> >  
> > -  ULONGEST elt_offs = elt_size * (index - lowerbound);
> > +  LONGEST elt_offs = elt_size * (index - lowerbound);
> >  
> >    if (index < lowerbound
> >        || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
> > 

^ permalink raw reply	[flat|nested] 34+ messages in thread

* Re: [PUSHED] gdb/fortran: Support negative array stride in one limited case
  2020-12-12 22:18           ` Andrew Burgess
@ 2020-12-13  0:51             ` Simon Marchi
  0 siblings, 0 replies; 34+ messages in thread
From: Simon Marchi @ 2020-12-13  0:51 UTC (permalink / raw)
  To: Andrew Burgess; +Cc: gdb-patches

On 2020-12-12 5:18 p.m., Andrew Burgess wrote:
> Thanks for bringing this to my attention.  I'll take a look at this
> next week.

Ok, I filed this bug, tentatively with the 11.1 target, so we don't forget about it.

https://sourceware.org/bugzilla/show_bug.cgi?id=27059

Simon

^ permalink raw reply	[flat|nested] 34+ messages in thread

end of thread, other threads:[~2020-12-13  0:51 UTC | newest]

Thread overview: 34+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-11-14 14:56 [review] gdb/fortran: array stride support Andrew Burgess (Code Review)
2019-11-15 22:36 ` Tom Tromey (Code Review)
2019-11-15 23:54 ` Andrew Burgess (Code Review)
2019-11-18 18:58 ` Tom Tromey (Code Review)
2019-11-18 21:47 ` [review v2] " Andrew Burgess (Code Review)
2019-11-18 21:50 ` Andrew Burgess (Code Review)
2019-11-18 21:55 ` [review v3] " Andrew Burgess (Code Review)
2019-11-22 10:10 ` [review v4] " Andrew Burgess (Code Review)
2019-11-22 10:12 ` Andrew Burgess (Code Review)
2019-11-22 13:06 ` Simon Marchi (Code Review)
2019-11-22 17:30 ` [review v5] " Andrew Burgess (Code Review)
2019-11-22 17:31 ` Andrew Burgess (Code Review)
2019-11-22 17:46 ` Simon Marchi (Code Review)
2019-11-28  0:45 ` [review v6] " Andrew Burgess (Code Review)
2019-11-29 23:32 ` [review v7] " Andrew Burgess (Code Review)
2019-11-29 23:35 ` Andrew Burgess (Code Review)
2019-11-30 21:47 ` [review v8] " Andrew Burgess (Code Review)
2019-11-30 22:10 ` [review v9] " Andrew Burgess (Code Review)
2019-11-30 22:11 ` Andrew Burgess (Code Review)
2019-12-01  0:09 ` Simon Marchi (Code Review)
2019-12-01  0:09 ` Simon Marchi (Code Review)
2019-12-01 22:33 ` [pushed] " Sourceware to Gerrit sync (Code Review)
2019-12-01 22:33 ` Sourceware to Gerrit sync (Code Review)
2020-01-14  4:11 ` [PATCH] Add gdb.fortran/vla-stride.exp and report a bug (was: Re: [review] gdb/fortran: array stride support) Sergio Durigan Junior
2020-01-19  1:59   ` Andrew Burgess
2020-02-05 16:38     ` [PATCH] Add gdb.fortran/vla-stride.exp and report a bug Sergio Durigan Junior
2020-02-25 16:35       ` [PUSHED] gdb/fortran: Support negative array stride in one limited case Andrew Burgess
2020-08-06 10:41         ` Copyright status gdb.fortran/vla-stride.exp test-case Tom de Vries
2020-08-06 13:35           ` Andrew Burgess
2020-08-18  9:50             ` Tom de Vries
2020-08-18 10:12               ` Andrew Burgess
2020-12-12  6:33         ` [PUSHED] gdb/fortran: Support negative array stride in one limited case Simon Marchi
2020-12-12 22:18           ` Andrew Burgess
2020-12-13  0:51             ` Simon Marchi

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).