http://sourceware.org/ml/gdb-patches/2016-02/msg00844.html

Subject: [PATCH v2 5/6] fortran: calculate subarray with stride values.

From: Christoph Weinmann <christoph.t.weinmann@intel.com>

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

 gdb/valops.c |  87 +++++++++++++++++++++++++++++++++-------------

 gdb/value.h  |   2 +-

 3 files changed, 152 insertions(+), 48 deletions(-)

diff --git a/gdb/eval.c b/gdb/eval.c

index 308ada3..d01b579 100644

--- a/gdb/eval.c

+++ b/gdb/eval.c

@@ -437,8 +437,8 @@ value_f90_subarray (struct value *array, struct expression *exp,

     {

       struct subscript_range

       {

-        enum f90_range_type f90_range_type;

-        LONGEST low, high, stride;

+	enum f90_range_type f90_range_type;

+	LONGEST low, high, stride;

       }

       range;

       LONGEST number;

@@ -475,7 +475,7 @@ value_f90_subarray (struct value *array, struct expression *exp,

 	  range = &index->range;

 	  *pos += 3;

-	  range->f90_range_type = longest_to_int (exp->elts[pc].longconst);

+	  range->f90_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

@@ -484,6 +484,7 @@ value_f90_subarray (struct value *array, struct expression *exp,

 	      == SUBARRAY_LOW_BOUND)

 	    range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp,

 							 pos, noside));

+

 	  if ((range->f90_range_type & SUBARRAY_HIGH_BOUND)

 	      == SUBARRAY_HIGH_BOUND)

 	    range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp,

@@ -496,6 +497,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

@@ -512,10 +517,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];

@@ -548,6 +551,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.  */

+	    struct subscript_range *range = &index->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

@@ -555,10 +600,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;

@@ -572,27 +616,38 @@ value_f90_subarray (struct value *array, struct expression *exp,

 	       to get the value offset right.  */

 	    if (dim_count == 0)

 	      new_array

-	        = value_subscripted_rvalue (new_array, index->number,

+		= value_subscripted_rvalue (new_array, index->number,

 					    f77_get_lowerbound (value_type

 								  (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->number < TYPE_LOW_BOUND (index_type)

-		    || index->number > TYPE_HIGH_BOUND (index_type))

-		  error (_("error no such vector element"));

+		    && index->number < TYPE_HIGH_BOUND (index_type))

+		  error (_("provided bound(s) outside array bound(s)"));

+

+		if (index->number > TYPE_LOW_BOUND (index_type)

+		    && index->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->number),

-					   1, /* length is '1' element  */

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

      an array of arrays, depending on how many ranges have been provided by

@@ -617,7 +672,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];

@@ -625,12 +682,20 @@ value_f90_subarray (struct value *array, struct expression *exp,

 	  if (index->kind == SUBSCRIPT_RANGE)

 	    {

 	      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->range.high - index->range.low;

+

+	      new_length /= index->range.stride;

 	      range_type

 		= create_static_range_type (NULL,

-				     temp_type,

-				     1,

-				     index->range.high - index->range.low + 1);

+					    temp_type,

+					    index->range.low,

+					    index->range.low + new_length);

 	      interim_array_type = create_array_type (NULL,

 						      temp_type,

diff --git a/gdb/valops.c b/gdb/valops.c

index 09ea877..83c8462 100644

--- a/gdb/valops.c

+++ b/gdb/valops.c

@@ -3759,10 +3759,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);

 }

 /* CALL_COUNT is used to determine if we are calling the function once, e.g.

@@ -3776,7 +3779,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));

@@ -3799,14 +3803,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;

@@ -3825,7 +3839,7 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)

   if (call_count == 1)

     {

       range_type = TYPE_INDEX_TYPE (array_type);

-      slice_range_size = elem_count;

+      slice_range_size = ary_low_bound + elem_count - 1;

       /* Check if the array bounds are valid.  */

       if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0)

@@ -3837,7 +3851,7 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)

   else

     {

       range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type));

-      slice_range_size = (ary_low_bound + row_count - 1) * (elem_count);

+      slice_range_size = ary_low_bound + (row_count * elem_count) - 1;

       ary_low_bound = TYPE_LOW_BOUND (range_type);

     }

@@ -3849,8 +3863,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);

@@ -3871,29 +3886,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 3400460..c18ef2e 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.0