diff mbox

[V4,17/18] vla: add stride support to fortran arrays.

Message ID 1421243390-24015-18-git-send-email-keven.boell@intel.com
State New
Headers show

Commit Message

Keven Boell Jan. 14, 2015, 1:49 p.m. UTC
Add stride support for dynamic fortran arrays.
Add tests for dynamic array stride use-cases.

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

	* dwarf2read.c (read_subrange_type): Read dynamic
	stride attributes.
	* gdbtypes.c (create_array_type_with_stride): Add
	stride support
	(create_range_type): Add stride parameter.
	(create_static_range_type): Pass default stride
	parameter.
	(resolve_dynamic_range): Evaluate stride baton.
	(resolve_dynamic_type): Adjust data location with
	the value of byte stride.
	* gdbtypes.h (TYPE_BYTE_STRIDE): New macro.
	(TYPE_BYTE_STRIDE_BLOCK): New macro.
	(TYPE_BYTE_STRIDE_LOCLIST): New macro.
	(TYPE_BYTE_STRIDE_KIND): New macro.
	* valarith.c (value_subscripted_rvalue): Use stride.

testsuite/gdb.fortran/:

	* vla-stride.exp: New file.
	* vla-stride.f90: New file.



Signed-off-by: Keven Boell <keven.boell@intel.com>
---
 gdb/dwarf2read.c                         |   13 +++++++--
 gdb/f-valprint.c                         |    8 +++++-
 gdb/gdbtypes.c                           |   39 ++++++++++++++++++++++----
 gdb/gdbtypes.h                           |   17 ++++++++++++
 gdb/testsuite/gdb.fortran/vla-stride.exp |   44 ++++++++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/vla-stride.f90 |   30 ++++++++++++++++++++
 gdb/valarith.c                           |   14 +++++++++-
 7 files changed, 155 insertions(+), 10 deletions(-)
 create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.exp
 create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.f90
diff mbox

Patch

diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index cfb22fe..6ee07e8 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -14773,7 +14773,7 @@  read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
   struct type *base_type, *orig_base_type;
   struct type *range_type;
   struct attribute *attr;
-  struct dynamic_prop low, high;
+  struct dynamic_prop low, high, stride;
   int low_default_is_valid;
   int high_bound_is_count = 0;
   const char *name;
@@ -14793,7 +14793,9 @@  read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
 
   low.kind = PROP_CONST;
   high.kind = PROP_CONST;
+  stride.kind = PROP_CONST;
   high.data.const_val = 0;
+  stride.data.const_val = 0;
 
   /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow
      omitting DW_AT_lower_bound.  */
@@ -14826,6 +14828,13 @@  read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
       break;
     }
 
+  attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
+  if (attr)
+    if (!attr_to_dynamic_prop (attr, die, cu, &stride, NULL, 0))
+        complaint (&symfile_complaints, _("Missing DW_AT_byte_stride "
+                  "- DIE at 0x%x [in module %s]"),
+             die->offset.sect_off, objfile_name (cu->objfile));
+
   attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
   if (attr)
     attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0);
@@ -14902,7 +14911,7 @@  read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
       && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
     high.data.const_val |= negative_mask;
 
-  range_type = create_range_type (NULL, orig_base_type, &low, &high);
+  range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride);
 
   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 40fa319..8cea9f7 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -121,8 +121,14 @@  f77_print_array_1 (int nss, int ndimensions, struct type *type,
 
   if (nss != ndimensions)
     {
-      size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+      size_t dim_size;
       size_t offs = 0;
+      LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
+
+      if (byte_stride)
+        dim_size = byte_stride;
+      else
+        dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
 
       for (i = lowerbound;
 	   (i < upperbound + 1 && (*elts) < options->print_max);
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 967b9e5..dbfbadb 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -815,7 +815,8 @@  allocate_stub_method (struct type *type)
 struct type *
 create_range_type (struct type *result_type, struct type *index_type,
 		   const struct dynamic_prop *low_bound,
-		   const struct dynamic_prop *high_bound)
+		   const struct dynamic_prop *high_bound,
+		   const struct dynamic_prop *stride)
 {
   if (result_type == NULL)
     result_type = alloc_type_copy (index_type);
@@ -830,6 +831,7 @@  create_range_type (struct type *result_type, struct type *index_type,
     TYPE_ZALLOC (result_type, sizeof (struct range_bounds));
   TYPE_RANGE_DATA (result_type)->low = *low_bound;
   TYPE_RANGE_DATA (result_type)->high = *high_bound;
+  TYPE_RANGE_DATA (result_type)->stride = *stride;
 
   if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
     TYPE_UNSIGNED (result_type) = 1;
@@ -858,7 +860,7 @@  struct type *
 create_static_range_type (struct type *result_type, struct type *index_type,
 			  LONGEST low_bound, LONGEST high_bound)
 {
-  struct dynamic_prop low, high;
+  struct dynamic_prop low, high, stride;
 
   low.kind = PROP_CONST;
   low.data.const_val = low_bound;
@@ -866,7 +868,11 @@  create_static_range_type (struct type *result_type, struct type *index_type,
   high.kind = PROP_CONST;
   high.data.const_val = high_bound;
 
-  result_type = create_range_type (result_type, index_type, &low, &high);
+  stride.kind = PROP_CONST;
+  stride.data.const_val = 0;
+
+  result_type = create_range_type (result_type, index_type,
+                                   &low, &high, &stride);
 
   return result_type;
 }
@@ -1023,16 +1029,21 @@  create_array_type_with_stride (struct type *result_type,
   if (has_static_range (TYPE_RANGE_DATA (range_type))
       && dwarf2_address_data_valid (result_type))
     {
-      LONGEST low_bound, high_bound;
+      LONGEST low_bound, high_bound, byte_stride;
 
       if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
 	low_bound = high_bound = 0;
       CHECK_TYPEDEF (element_type);
+
+      byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
+
       /* Be careful when setting the array length.  Ada arrays can be
 	 empty arrays with the high_bound being smaller than the low_bound.
 	 In such cases, the array length should be zero.  */
       if (high_bound < low_bound)
 	TYPE_LENGTH (result_type) = 0;
+      else if (byte_stride > 0)
+	TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1);
       else if (bit_stride > 0)
 	TYPE_LENGTH (result_type) =
 	  (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
@@ -1732,7 +1743,7 @@  resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr)
   struct type *static_range_type;
   const struct dynamic_prop *prop;
   const struct dwarf2_locexpr_baton *baton;
-  struct dynamic_prop low_bound, high_bound;
+  struct dynamic_prop low_bound, high_bound, stride;
   struct type *range_copy = copy_type (dyn_range_type);
 
   gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
@@ -1764,10 +1775,17 @@  resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr)
       high_bound.kind = PROP_UNDEFINED;
       high_bound.data.const_val = 0;
     }
+  
+  prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
+  if (dwarf2_evaluate_property (prop, addr, &value))
+    {
+      stride.kind = PROP_CONST;
+      stride.data.const_val = value;
+    }
 
   static_range_type = create_range_type (range_copy,
 					 TYPE_TARGET_TYPE (range_copy),
-					 &low_bound, &high_bound);
+					 &low_bound, &high_bound, &stride);
   TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
   return static_range_type;
 }
@@ -1988,6 +2006,15 @@  resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr,
   prop = TYPE_DATA_LOCATION (resolved_type);
   if (dwarf2_evaluate_property (prop, addr, &value))
     {
+      struct type *range_type = TYPE_INDEX_TYPE (resolved_type);
+
+      /* Adjust the data location with the value of byte stride if set, which
+         can describe the separation between successive elements along the
+         dimension.  */
+      if (TYPE_BYTE_STRIDE (range_type) < 0)
+        value += (TYPE_HIGH_BOUND (range_type) - TYPE_LOW_BOUND (range_type))
+                  * TYPE_BYTE_STRIDE (range_type);
+
       TYPE_DATA_LOCATION_ADDR (resolved_type) = value;
       TYPE_DATA_LOCATION_KIND (resolved_type) = PROP_CONST;
     }
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 6a8a74d..ad90da2 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -660,6 +660,10 @@  struct main_type
 
       struct dynamic_prop high;
 
+      /* * Stride of range.  */
+
+      struct dynamic_prop stride;
+
       /* True if HIGH range bound contains the number of elements in the
 	 subrange. This affects how the final hight bound is computed.  */
 
@@ -1210,6 +1214,15 @@  extern void allocate_gnat_aux_type (struct type *);
   TYPE_RANGE_DATA(range_type)->high.kind
 #define TYPE_LOW_BOUND_KIND(range_type) \
   TYPE_RANGE_DATA(range_type)->low.kind
+#define TYPE_BYTE_STRIDE(range_type) \
+  TYPE_RANGE_DATA(range_type)->stride.data.const_val
+#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
+  TYPE_RANGE_DATA(range_type)->stride.data.locexpr
+#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
+  TYPE_RANGE_DATA(range_type)->stride.data.loclist
+#define TYPE_BYTE_STRIDE_KIND(range_type) \
+  TYPE_RANGE_DATA(range_type)->stride.kind
+
 
 /* Attribute accessors for the type data location.  */
 #define TYPE_DATA_LOCATION(thistype) \
@@ -1241,6 +1254,9 @@  extern void allocate_gnat_aux_type (struct type *);
    TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
 #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
    TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
+#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
+   (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0)
+
 
 #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
    (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
@@ -1711,6 +1727,7 @@  extern struct type *create_array_type_with_stride
 
 extern struct type *create_range_type (struct type *, struct type *,
 				       const struct dynamic_prop *,
+				       const struct dynamic_prop *,
 				       const struct dynamic_prop *);
 
 extern struct type *create_array_type (struct type *, struct type *,
diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
new file mode 100644
index 0000000..6df7951
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
@@ -0,0 +1,44 @@ 
+# Copyright 2015 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 0000000..a073235
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
@@ -0,0 +1,30 @@ 
+! Copyright 2015 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 2 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, write to the Free Software
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+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 e2af354..bf54d03 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -193,9 +193,21 @@  value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound)
   struct type *array_type = check_typedef (value_type (array));
   struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
   unsigned int elt_size = TYPE_LENGTH (elt_type);
-  unsigned int elt_offs = elt_size * longest_to_int (index - lowerbound);
+  unsigned int elt_offs = longest_to_int (index - lowerbound);
+  LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
   struct value *v;
 
+  if (elt_stride > 0)
+    elt_offs *= elt_stride;
+  else if (elt_stride < 0)
+    {
+      int offs = (elt_offs + 1) * elt_stride;
+
+      elt_offs = TYPE_LENGTH (array_type) + offs;
+    }
+  else
+    elt_offs *= elt_size;
+
   if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
 			     && elt_offs >= TYPE_LENGTH (array_type)))
     {