gdb/gdb-fortran-stride-intel-5of6.patch

RE: [ping] [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides
https://sourceware.org/ml/gdb-patches/2016-07/msg00009.html

From 1189098c3cacc2ee69021de1a83ad3328821d755 Mon Sep 17 00:00:00 2001
From: Christoph Weinmann <christoph.t.weinmann@intel.com>
Date: Wed, 1 Jun 2016 15:04:01 +0200
Subject: [PATCH 5/6] fortran: calculate elements of a subarray using a
 provided stride value

The stride value can be a positive or negative integer, but may
not be zero.  If no stride is provided, use the default value
1 to print all elements inside the range.

1| program prog
2|   integer :: ary(10) = (/ (i, i=1, 10) /)
3| end program prog

(gdb) print ary(1:10:2)
$3 = (1, 3, 5, 7, 9)

2013-11-27  Christoph Weinmann  <christoph.t.weinmann>

	* eval.c (value_f90_subarray): Add range size calculation
	for stride based ranges, and evaluation of user stride
	parameters.  Add check for matching user input to array
	bounds.
	* valops.c (value_slice): Add call parameter with default
	stride value for calling value_slice_1.
	* valops.c (value_slice_1): Add function parameter for
	stride length in the return subarray.  Calculate array
	elements based on stride value.
	* value.h: Add stride parameter to declaration of
	value_slice_1.


Signed-off-by: Christoph Weinmann <christoph.t.weinmann@intel.com>
---
 gdb/eval.c   | 102 ++++++++++++++++++++++++++++++++++++++++++++++++-----------
 gdb/valops.c |  83 +++++++++++++++++++++++++++++++++++-------------
 gdb/value.h  |   2 +-
 3 files changed, 145 insertions(+), 42 deletions(-)

diff --git a/gdb/eval.c b/gdb/eval.c
index b5aaf1c..1f27b6f 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -477,7 +477,7 @@ value_f90_subarray (struct value *array, struct expression *exp,
 	  range = &index->U.range;
 
 	  *pos += 3;
-	  range->f90_range_type = (enum range_type) longest_to_int (exp->elts[pc].longconst);
+	  range->f90_range_type = (enum range_type) exp->elts[pc].longconst;
 
 	  /* If a lower bound was provided by the user, the bit has been
 	     set and we can assign the value from the elt stack.  Same for
@@ -499,6 +499,10 @@ value_f90_subarray (struct value *array, struct expression *exp,
 	  /* Assign the default stride value '1'.  */
 	  else
 	    range->stride = 1;
+
+	  /* Check the provided stride value is illegal, aka '0'.  */
+	  if (range->stride == 0)
+	    error (_("Stride must not be 0"));
 	}
       /* User input is an index.  E.g.: "p arry(5)".  */
       else
@@ -515,10 +519,8 @@ value_f90_subarray (struct value *array, struct expression *exp,
 
     }
 
-  /* Traverse the array from right to left and evaluate each corresponding
-     user input.  VALUE_SUBSCRIPT is called for every index, until a range
-     expression is evaluated.  After a range expression has been evaluated,
-     every subsequent expression is also treated as a range.  */
+  /* Traverse the array from right to left and set the high and low bounds
+     for later use.  */
   for (i = nargs - 1; i >= 0; i--)
     {
       struct subscript_store *index = &subscript_array[i];
@@ -551,6 +553,48 @@ value_f90_subarray (struct value *array, struct expression *exp,
 		|| range->high > TYPE_HIGH_BOUND (index_type))
 	      error (_("provided bound(s) outside array bound(s)"));
 
+	    /* For a negative stride the lower boundary must be larger than the
+	       upper boundary.
+	       For a positive stride the lower boundary must be smaller than the
+	       upper boundary.  */
+	    if ((range->stride < 0 && range->low < range->high)
+		|| (range->stride > 0 && range->low > range->high))
+	      error (_("Wrong value provided for stride and boundaries"));
+
+	  }
+	  break;
+
+	case SUBSCRIPT_INDEX:
+	  break;
+
+	}
+
+       array_type = TYPE_TARGET_TYPE (array_type);
+    }
+
+  /* Reset ARRAY_TYPE before slicing.*/
+  array_type = check_typedef (value_type (new_array));
+
+  /* Traverse the array from right to left and evaluate each corresponding
+     user input.  VALUE_SUBSCRIPT is called for every index, until a range
+     expression is evaluated.  After a range expression has been evaluated,
+     every subsequent expression is also treated as a range.  */
+  for (i = nargs - 1; i >= 0; i--)
+    {
+      struct subscript_store *index = &subscript_array[i];
+      struct type *index_type = TYPE_INDEX_TYPE (array_type);
+
+      switch (index->kind)
+	{
+	case SUBSCRIPT_RANGE:
+	  {
+
+	    /* When we hit the first range specified by the user, we must
+	       treat any subsequent user entry as a range.  We simply
+	       increment DIM_COUNT which tells us how many times we are
+	       calling VALUE_SLICE_1.  */
+	    subscript_range *range = &index->U.range;
+
 	    /* DIM_COUNT counts every user argument that is treated as a range.
 	       This is necessary for expressions like 'print array(7, 8:9).
 	       Here the first argument is a literal, but must be treated as a
@@ -558,10 +602,9 @@ value_f90_subarray (struct value *array, struct expression *exp,
 	    dim_count++;
 
 	    new_array
-	      = value_slice_1 (new_array,
-			       longest_to_int (range->low),
-			       longest_to_int (range->high - range->low + 1),
-			       dim_count);
+	      = value_slice_1 (new_array, range->low,
+			       range->high - range->low + 1,
+			       range->stride, dim_count);
 	  }
 	  break;
 
@@ -580,21 +623,32 @@ value_f90_subarray (struct value *array, struct expression *exp,
 								  (new_array)));
 	    else
 	      {
-		/* Check for valid index input.  */
+		dim_count++;
+
+		/* We might end up here, because we have to treat the provided
+		   index like a range. But now VALUE_SUBSCRIPTED_RVALUE
+		   cannot do the range checks for us. So we have to make sure
+		   ourselves that the user provided index is inside the
+		   array bounds.  Throw an error if not.  */
 		if (index->U.number < TYPE_LOW_BOUND (index_type)
-		    || index->U.number > TYPE_HIGH_BOUND (index_type))
-		  error (_("error no such vector element"));
+		    && index->U.number > TYPE_HIGH_BOUND (index_type))
+		  error (_("provided bound(s) outside array bound(s)"));
+
+		if (index->U.number > TYPE_LOW_BOUND (index_type)
+		    && index->U.number > TYPE_HIGH_BOUND (index_type))
+		  error (_("provided bound(s) outside array bound(s)"));
 
-		dim_count++;
 		new_array = value_slice_1 (new_array,
-					   longest_to_int (index->U.number),
-					   1, /* length is '1' element  */
+					   index->U.number,
+					   1, /* COUNT is '1' element  */
+					   1, /* STRIDE set to '1'  */
 					   dim_count);
 	      }
 
 	  }
 	  break;
 	}
+      array_type = TYPE_TARGET_TYPE (array_type);
     }
 
   /* With DIM_COUNT > 1 we currently have a one dimensional array, but expect
@@ -620,7 +674,9 @@ value_f90_subarray (struct value *array, struct expression *exp,
 	 the output array.  So we traverse the SUBSCRIPT_ARRAY again, looking
 	 for a range entry.  When we find one, we use the range info to create
 	 an additional range_type to set the correct bounds and dimensions for
-	 the output array.  */
+	 the output array.  In addition, we may have a stride value that is not
+	 '1', forcing us to adjust the number of elements in a range, according
+	 to the stride value.  */
       for (i = 0; i < nargs; i++)
 	{
 	  struct subscript_store *index = &subscript_array[i];
@@ -629,12 +685,20 @@ value_f90_subarray (struct value *array, struct expression *exp,
 	    {
 	      struct type *range_type, *interim_array_type;
 
+	      int new_length;
+
+	      /* The length of a sub-dimension with all elements between the
+		 bounds plus the start element itself.  It may be modified by
+		 a user provided stride value.  */
+	      new_length = index->U.range.high - index->U.range.low;
+
+	      new_length /= index->U.range.stride;
+
 	      range_type
 		= create_static_range_type (NULL,
 					    elt_type,
-					    1,
-					    index->U.range.high
-					      - index->U.range.low + 1);
+					    index->U.range.low,
+					    index->U.range.low + new_length);
 
 	      interim_array_type = create_array_type (NULL,
 						      elt_type,
diff --git a/gdb/valops.c b/gdb/valops.c
index fbc7dcb..ded8efc 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -3766,10 +3766,13 @@ value_of_this_silent (const struct language_defn *lang)
 struct value *
 value_slice (struct value *array, int lowbound, int length)
 {
-  /* Pass unaltered arguments to VALUE_SLICE_1, plus a CALL_COUNT of '1' as we
-     are only considering the highest dimension, or we are working on a one
-     dimensional array.  So we call VALUE_SLICE_1 exactly once.  */
-  return value_slice_1 (array, lowbound, length, 1);
+  /* Pass unaltered arguments to VALUE_SLICE_1, plus a default stride
+     value of '1', which returns every element between LOWBOUND and
+     (LOWBOUND + LENGTH).  We also provide a default CALL_COUNT of '1'
+     as we are only considering the highest dimension, or we are
+     working on a one dimensional array.  So we call VALUE_SLICE_1
+     exactly once.  */
+  return value_slice_1 (array, lowbound, length, 1, 1);
 }
 
 /* VALUE_SLICE_1 is called for each array dimension to calculate the number
@@ -3785,7 +3788,8 @@ value_slice (struct value *array, int lowbound, int length)
    ranges in the calling function.  */
 
 struct value *
-value_slice_1 (struct value *array, int lowbound, int length, int call_count)
+value_slice_1 (struct value *array, int lowbound, int length,
+	       int stride_length, int call_count)
 {
   struct type *slice_range_type, *slice_type, *range_type;
   struct type *array_type = check_typedef (value_type (array));
@@ -3808,14 +3812,24 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)
      attributes of the underlying type.  */
   if (call_count > 1)
     {
+      ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (elt_type));
+      ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (elt_type));
       elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
       row_count = TYPE_LENGTH (array_type)
 		    / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
     }
 
-  elem_count = length;
+  /* With a stride of '1', the number of elements per result row is equal to
+     the LENGTH of the subarray.  With non-default stride values, we skip
+     elements, but have to add the start element to the total number of
+     elements per row.  */
+  if (stride_length == 1)
+    elem_count = length;
+  else
+    elem_count = ((length - 1) / stride_length) + 1;
+
   elt_size = TYPE_LENGTH (elt_type);
-  elt_offs = longest_to_int (lowbound - ary_low_bound);
+  elt_offs = lowbound - ary_low_bound;
   elt_stride = TYPE_LENGTH (TYPE_INDEX_TYPE (array_type));
 
   elt_offs *= elt_size;
@@ -3858,8 +3872,9 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)
   {
     struct type *element_type;
 
-    /* When CALL_COUNT equals 1 we can use the legacy code for subarrays.  */
-    if (call_count == 1)
+    /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy
+       code for subarrays.  */
+    if (call_count == 1 && stride_length == 1)
       {
 	element_type = TYPE_TARGET_TYPE (array_type);
 
@@ -3880,29 +3895,53 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)
 	  }
 
       }
-    /* When CALL_COUNT is larger than 1 we are working on a range of ranges.
-       So we copy the relevant elements into the new array we return.  */
+    /* With a CALL_COUNT or STRIDE_LENGTH are greater than 1 we are working
+       on a range of ranges.  So we copy the relevant elements into the
+       new array we return.  */
     else
       {
+	int j, offs_store = elt_offs;
 	LONGEST dst_offset = 0;
 	LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
 
-	element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type));
+	if (call_count == 1)
+	  {
+	    /* When CALL_COUNT is equal to 1 we are working on the current range
+	       and use these elements directly.  */
+	    element_type = TYPE_TARGET_TYPE (array_type);
+	  }
+	else
+	  {
+	    /* Working on an array of arrays, the type of the elements is the type
+	       of the subarrays' type.  */
+	    element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type));
+	  }
+
 	slice_type = create_array_type (NULL, element_type, slice_range_type);
 
-	TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type));
+	 /* If we have a one dimensional array, we copy its TYPE_CODE.  For a
+	    multi dimensional array we copy the embedded type's TYPE_CODE.  */
+	if (call_count == 1)
+	  TYPE_CODE (slice_type) = TYPE_CODE (array_type);
+	else
+	  TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type));
 
 	v = allocate_value (slice_type);
-	for (i = 0; i < longest_to_int (row_count); i++)
+
+	/* Iterate through the rows of the outer array and set the new offset
+	   for each row.  */
+	for (i = 0; i < row_count; i++)
 	  {
-	    /* Fetches the contents of ARRAY and copies them into V.  */
-	    value_contents_copy (v,
-				 dst_offset,
-				 array,
-				 elt_offs,
-				 elt_size * elem_count);
-	    elt_offs += src_row_length;
-	    dst_offset += elt_size * elem_count;
+	    elt_offs = offs_store + i * src_row_length;
+
+	    /* Iterate through the elements in each row to copy only those.  */
+	    for (j = 1; j <= elem_count; j++)
+	      {
+		/* Fetches the contents of ARRAY and copies them into V.  */
+		value_contents_copy (v, dst_offset, array, elt_offs, elt_size);
+		elt_offs += elt_size * stride_length;
+		dst_offset += elt_size;
+	      }
 	  }
       }
 
diff --git a/gdb/value.h b/gdb/value.h
index 95588af..e417639 100644
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -1056,7 +1056,7 @@ extern struct value *varying_to_slice (struct value *);
 
 extern struct value *value_slice (struct value *, int, int);
 
-extern struct value *value_slice_1 (struct value *, int, int, int);
+extern struct value *value_slice_1 (struct value *, int, int, int, int);
 
 extern struct value *value_literal_complex (struct value *, struct value *,
 					    struct type *);
-- 
2.5.5