[PATCH v2 4/6] fortran: enable parsing of stride parameter for subranges

[PATCH v2 4/6] fortran: enable parsing of stride parameter for subranges

[christoph.t.weinmann]

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

Allow the user to provide a stride parameter for Fortran
subarrays.  The stride parameter can be any integer except
'0'.  The default stride value is '1'.

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

	* eval.c (value_f90_subarray): Add expression evaluation
	for a stride parameter in a Fortran range expression.
	* f-exp.y: Add yacc rules for writing info on the elt stack
	when the user provided a stride argument.
	* f-lang.h (F90_RANGE): Add field to enum to show when a
	stride was provided by the user.
	* parse.c (operator_length_standard): Check if a stride
	value was provided, and increment argument counter
	accordingly.


Signed-off-by: Christoph Weinmann <christoph.t.weinmann@intel.com>
---
 gdb/eval.c   | 10 +++++++++-
 gdb/f-exp.y  | 33 +++++++++++++++++++++++++++++++--
 gdb/f-lang.h |  5 +++--
 gdb/parse.c  |  3 +++
 4 files changed, 46 insertions(+), 5 deletions(-)

diff --git a/gdb/eval.c b/gdb/eval.c
index 9b8b051..308ada3 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -438,7 +438,7 @@ value_f90_subarray (struct value *array, struct expression *exp,
       struct subscript_range
       {
         enum f90_range_type f90_range_type;
-        LONGEST low, high;
+        LONGEST low, high, stride;
       }
       range;
       LONGEST number;
@@ -488,6 +488,14 @@ value_f90_subarray (struct value *array, struct expression *exp,
 	      == SUBARRAY_HIGH_BOUND)
 	    range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp,
 							  pos, noside));
+
+	  /* Assign the user's stride value if provided.  */
+	  if ((range->f90_range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
+	    range->stride = value_as_long (evaluate_subexp (NULL_TYPE, exp,
+							    pos, noside));
+	  /* Assign the default stride value '1'.  */
+	  else
+	    range->stride = 1;
 	}
       /* User input is an index.  E.g.: "p arry(5)".  */
       else
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index b1206de..5151fee 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -316,8 +316,8 @@ arglist	:	arglist ',' exp   %prec ABOVE_COMMA
 
 subrange:	exp ':' exp	%prec ABOVE_COMMA
 			{ write_exp_elt_opcode (pstate, OP_F90_RANGE);
-			  write_exp_elt_longcst (pstate,
-						 SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND);
+			  write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
+						 | SUBARRAY_HIGH_BOUND);
 			  write_exp_elt_opcode (pstate, OP_F90_RANGE); }
 	;
 
@@ -339,6 +339,35 @@ subrange:	':'	%prec ABOVE_COMMA
 			  write_exp_elt_opcode (pstate, OP_F90_RANGE); }
 	;
 
+/* Each subrange type can have a stride argument.  */
+subrange:	exp ':' exp ':' exp %prec ABOVE_COMMA
+			{ write_exp_elt_opcode (pstate, OP_F90_RANGE);
+			  write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
+						 | SUBARRAY_HIGH_BOUND
+						 | SUBARRAY_STRIDE);
+			  write_exp_elt_opcode (pstate, OP_F90_RANGE); }
+	;
+
+subrange:	exp ':' ':' exp %prec ABOVE_COMMA
+			{ write_exp_elt_opcode (pstate, OP_F90_RANGE);
+			  write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
+						 | SUBARRAY_STRIDE);
+			  write_exp_elt_opcode (pstate, OP_F90_RANGE); }
+	;
+
+subrange:	':' exp ':' exp %prec ABOVE_COMMA
+			{ write_exp_elt_opcode (pstate, OP_F90_RANGE);
+			  write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND
+						 | SUBARRAY_STRIDE);
+			  write_exp_elt_opcode (pstate, OP_F90_RANGE); }
+	;
+
+subrange:	':' ':' exp %prec ABOVE_COMMA
+			{ write_exp_elt_opcode (pstate, OP_F90_RANGE);
+			  write_exp_elt_longcst (pstate, SUBARRAY_STRIDE);
+			  write_exp_elt_opcode (pstate, OP_F90_RANGE); }
+	;
+
 complexnum:     exp ',' exp 
                 	{ }                          
         ;
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 4d56bf7..0ad57af 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -44,8 +44,9 @@ extern void f_val_print (struct type *, const gdb_byte *, int, CORE_ADDR,
    
 enum f90_range_type
   {
-    SUBARRAY_LOW_BOUND = 0x1,		/* "(low:)"  */
-    SUBARRAY_HIGH_BOUND = 0x2		/* "(:high)"  */
+    SUBARRAY_LOW_BOUND = 0x1,		/* "(low:)" or "(low::)" */
+    SUBARRAY_HIGH_BOUND = 0x2,		/* "(:high)" or "(:high:)"  */
+    SUBARRAY_STRIDE = 0x4		/* "(::stride)"  */
   };
 
 /* A common block.  */
diff --git a/gdb/parse.c b/gdb/parse.c
index d500279..07248c3 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -1018,6 +1018,9 @@ operator_length_standard (const struct expression *expr, int endpos,
       if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
 	args++;
 
+      if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
+	args++;
+
       break;
 
     default:
-- 
2.5.0

[PATCH v2 3/6] fortran: change subrange enum to bit field

[christoph.t.weinmann]

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

Change Fortran subrange enum for subrange expressions to
represent a bitfield for easier manipulation.  Consequently
also change occurences and evaluation of said enum.  The
behaviour of GDB is unchanged.

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

	* eval.c (value_f90_subarray): Change evaluation of the
	subarray boundaries.  Set boundaries to be either user
	provided (bit in f90_range_type was set) or take the
	default value if the boundary was not provided by the user.
	* f-exp.y (subrange): Change rules for subrange expressions
	to write the relevant bit sequence onto the elt stack.
	* f-lang.h (f90_range_type): Change the enum to use bit
	values for each boundary, if set by the user.
	* parse.c (operator_length_standard): In case of
	OP_F90_RANGE change the calculation of the number of
	arguments on the elt stack, depending on the number of
	boundaries provided by the user.


Signed-off-by: Christoph Weinmann <christoph.t.weinmann@intel.com>
---
 gdb/eval.c   | 14 ++++++--------
 gdb/f-exp.y  | 11 ++++++-----
 gdb/f-lang.h |  6 ++----
 gdb/parse.c  | 21 ++++++++-------------
 4 files changed, 22 insertions(+), 30 deletions(-)

diff --git a/gdb/eval.c b/gdb/eval.c
index 164d7ab..9b8b051 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -480,12 +480,12 @@ value_f90_subarray (struct value *array, struct expression *exp,
 	  /* 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
 	     upper bound.  */
-	  if ((range->f90_range_type == HIGH_BOUND_DEFAULT)
-	      || range->f90_range_type == NONE_BOUND_DEFAULT)
+	  if ((range->f90_range_type & SUBARRAY_LOW_BOUND)
+	      == SUBARRAY_LOW_BOUND)
 	    range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp,
 							 pos, noside));
-	  if ((range->f90_range_type == LOW_BOUND_DEFAULT)
-	      || range->f90_range_type == NONE_BOUND_DEFAULT)
+	  if ((range->f90_range_type & SUBARRAY_HIGH_BOUND)
+	      == SUBARRAY_HIGH_BOUND)
 	    range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp,
 							  pos, noside));
 	}
@@ -526,12 +526,10 @@ value_f90_subarray (struct value *array, struct expression *exp,
 
 	    /* If no lower bound was provided by the user, we take the
 	       default boundary.  Same for the high bound.  */
-	    if ((range->f90_range_type == LOW_BOUND_DEFAULT)
-		|| (range->f90_range_type == BOTH_BOUND_DEFAULT))
+	    if ((range->f90_range_type & SUBARRAY_LOW_BOUND) == 0)
 	      range->low = TYPE_LOW_BOUND (index_type);
 
-	    if ((range->f90_range_type == HIGH_BOUND_DEFAULT)
-		|| (range->f90_range_type == BOTH_BOUND_DEFAULT))
+	    if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0)
 	      range->high = TYPE_HIGH_BOUND (index_type);
 
 	    /* Both user provided low and high bound have to be inside the
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 9343abb..b1206de 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -315,26 +315,27 @@ arglist	:	arglist ',' exp   %prec ABOVE_COMMA
 /* There are four sorts of subrange types in F90.  */
 
 subrange:	exp ':' exp	%prec ABOVE_COMMA
-			{ write_exp_elt_opcode (pstate, OP_F90_RANGE); 
-			  write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
+			{ write_exp_elt_opcode (pstate, OP_F90_RANGE);
+			  write_exp_elt_longcst (pstate,
+						 SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND);
 			  write_exp_elt_opcode (pstate, OP_F90_RANGE); }
 	;
 
 subrange:	exp ':'	%prec ABOVE_COMMA
 			{ write_exp_elt_opcode (pstate, OP_F90_RANGE);
-			  write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
+			  write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND);
 			  write_exp_elt_opcode (pstate, OP_F90_RANGE); }
 	;
 
 subrange:	':' exp	%prec ABOVE_COMMA
 			{ write_exp_elt_opcode (pstate, OP_F90_RANGE);
-			  write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
+			  write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND);
 			  write_exp_elt_opcode (pstate, OP_F90_RANGE); }
 	;
 
 subrange:	':'	%prec ABOVE_COMMA
 			{ write_exp_elt_opcode (pstate, OP_F90_RANGE);
-			  write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
+			  write_exp_elt_longcst (pstate, 0);
 			  write_exp_elt_opcode (pstate, OP_F90_RANGE); }
 	;
 
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index eeca107..4d56bf7 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -44,10 +44,8 @@ extern void f_val_print (struct type *, const gdb_byte *, int, CORE_ADDR,
    
 enum f90_range_type
   {
-    BOTH_BOUND_DEFAULT,		/* "(:)"  */
-    LOW_BOUND_DEFAULT,		/* "(:high)"  */
-    HIGH_BOUND_DEFAULT,		/* "(low:)"  */
-    NONE_BOUND_DEFAULT		/* "(low:high)"  */
+    SUBARRAY_LOW_BOUND = 0x1,		/* "(low:)"  */
+    SUBARRAY_HIGH_BOUND = 0x2		/* "(:high)"  */
   };
 
 /* A common block.  */
diff --git a/gdb/parse.c b/gdb/parse.c
index 4191fc6..d500279 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -1006,22 +1006,17 @@ operator_length_standard (const struct expression *expr, int endpos,
 
     case OP_F90_RANGE:
       oplen = 3;
+      args = 0;
       range_type = (enum f90_range_type)
 	longest_to_int (expr->elts[endpos - 2].longconst);
 
-      switch (range_type)
-	{
-	case LOW_BOUND_DEFAULT:
-	case HIGH_BOUND_DEFAULT:
-	  args = 1;
-	  break;
-	case BOTH_BOUND_DEFAULT:
-	  args = 0;
-	  break;
-	case NONE_BOUND_DEFAULT:
-	  args = 2;
-	  break;
-	}
+      /* Increment the argument counter for each argument
+	 provided by the user.  */
+      if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
+	args++;
+
+      if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
+	args++;
 
       break;
 
-- 
2.5.0

[PATCH v2 2/6] fortran: combine subarray and string computation

[christoph.t.weinmann]

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

Strings only have one dimension, but the element computation is
identical to the subarray computation for ranges and indices.

2013-11-26  Christoph Weinmann  <christoph.t.weinmann@intel.com>

	* eval.c (evaluate_subexp_standard): Call
	value_f90_subarray for print expressions on array and
	string types.


Signed-off-by: Christoph Weinmann <christoph.t.weinmann@intel.com>
---
 gdb/eval.c | 10 +---------
 1 file changed, 1 insertion(+), 9 deletions(-)

diff --git a/gdb/eval.c b/gdb/eval.c
index c9f325f..164d7ab 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -2034,16 +2034,8 @@ evaluate_subexp_standard (struct type *expect_type,
       switch (code)
 	{
 	case TYPE_CODE_ARRAY:
-	  return value_f90_subarray (arg1, exp, pos, nargs, noside);
-
 	case TYPE_CODE_STRING:
-	  if (exp->elts[*pos].opcode == OP_F90_RANGE)
-	    return value_f90_subarray (arg1, exp, pos, 1, noside);
-	  else
-	    {
-	      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
-	      return value_subscript (arg1, value_as_long (arg2));
-	    }
+	  return  value_f90_subarray (arg1, exp, pos, nargs, noside);
 
 	case TYPE_CODE_PTR:
 	case TYPE_CODE_FUNC:
-- 
2.5.0

[PATCH v2 1/6] fortran: allow multi-dimensional subarrays

[christoph.t.weinmann]

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

Add an argument count for subrange expressions in Fortran.
Based on the counted value calculate a new array with the
elements specified by the user.  First parse the user input,
secondly copy the desired array values into the return
array, thirdly re-create the necessary ranges and bounds.

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

(gdb) print ary(2:4,1:3)
old> Syntax error in expression near ':3'
new> $3 = ( ( 21, 31, 41) ( 22, 32, 42) ( 23, 33, 43) )

2013-11-25  Christoph Weinmann  <christoph.t.weinmann@intel.com>

	* eval.c (multi_f77_subscript): Remove function.
	* eval.c (evaluate_subrange_expr): When evaluating
	an array or string expression, call
	value_f90_subarray.
	* eval.c (value_f90_subarray): Add argument parsing
	and compute result array based on user input.
	* f-exp.y: Increment argument counter for every subrange
	expression entered by the user.
	* valops.c (value_slice): Call value_slice_1 with
	additional default argument.
	* valops.c (value_slice_1): Add functionality to
	copy and return result values based on input.
	* value.h: Add function definition.


Signed-off-by: Christoph Weinmann <christoph.t.weinmann@intel.com>
---
 gdb/eval.c   | 309 ++++++++++++++++++++++++++++++++++++++++++++++-------------
 gdb/f-exp.y  |   2 +
 gdb/valops.c | 157 ++++++++++++++++++++++++------
 gdb/value.h  |   2 +
 4 files changed, 375 insertions(+), 95 deletions(-)

diff --git a/gdb/eval.c b/gdb/eval.c
index 78ad946..c9f325f 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -399,29 +399,253 @@ init_array_element (struct value *array, struct value *element,
   return index;
 }
 
+/* Evaluates any operation on Fortran arrays or strings with at least
+   one user provided parameter.  Expects the input ARRAY to be either
+   an array, or a string.  Evaluates EXP by incrementing POS, and
+   writes the content from the elt stack into a local struct.  NARGS
+   specifies number of literal or range arguments the user provided.
+   NARGS must be the same number as ARRAY has dimensions.  */
+
 static struct value *
-value_f90_subarray (struct value *array,
-		    struct expression *exp, int *pos, enum noside noside)
+value_f90_subarray (struct value *array, struct expression *exp,
+		    int *pos, int nargs, enum noside noside)
 {
-  int pc = (*pos) + 1;
+  int i, dim_count = 0;
   LONGEST low_bound, high_bound;
   struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
-  enum f90_range_type range_type
-    = (enum f90_range_type) longest_to_int (exp->elts[pc].longconst);
- 
-  *pos += 3;
+  struct value *new_array = array;
+  struct type *array_type = check_typedef (value_type (new_array));
+  struct type *temp_type;
+
+  /* Local struct to hold user data for Fortran subarray dimensions.  */
+  struct subscript_store
+  {
+    /* For every dimension, we are either working on a range or an index
+       expression, so we store this info separately for later.  */
+    enum
+    {
+      SUBSCRIPT_RANGE,    /* e.g. "(lowbound:highbound)"  */
+      SUBSCRIPT_INDEX    /* e.g. "(literal)"  */
+    } kind;
+
+    /* We also store either the lower and upper bound info, or the index
+       number.  Before evaluation of the input values, we do not know if we are
+       actually working on a range of ranges, or an index in a range.  So as a
+       first step we store all input in a union.  The array calculation itself
+       deals with this later on.  */
+    union
+    {
+      struct subscript_range
+      {
+        enum f90_range_type f90_range_type;
+        LONGEST low, high;
+      }
+      range;
+      LONGEST number;
+    };
+  } *subscript_array;
+
+  /* Check if the number of arguments provided by the user matches
+     the number of dimension of the array.  A string has only one
+     dimension.  */
+  if (nargs != calc_f77_array_dims (value_type (new_array)))
+    error (_("Wrong number of subscripts"));
+
+  subscript_array = alloca (sizeof (*subscript_array) * nargs);
+
+  /* Parse the user input into the SUBSCRIPT_ARRAY to store it.  We need
+     to evaluate it first, as the input is from left-to-right.  The
+     array is stored from right-to-left.  So we have to use the user
+     input in reverse order.  Later on, we need the input information to
+     re-calculate the output array.  For multi-dimensional arrays, we
+     can be dealing with any possible combination of ranges and indices
+     for every dimension.  */
+  for (i = 0; i < nargs; i++)
+    {
+      struct subscript_store *index = &subscript_array[i];
 
-  if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
-    low_bound = TYPE_LOW_BOUND (range);
-  else
-    low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+      /* The user input is a range, with or without lower and upper bound.
+	 E.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc.  */
+      if (exp->elts[*pos].opcode == OP_F90_RANGE)
+	{
+	  int pc = (*pos) + 1;
+	  struct subscript_range *range;
+
+	  index->kind = SUBSCRIPT_RANGE;
+	  range = &index->range;
+
+	  *pos += 3;
+	  range->f90_range_type = longest_to_int (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
+	     upper bound.  */
+	  if ((range->f90_range_type == HIGH_BOUND_DEFAULT)
+	      || range->f90_range_type == NONE_BOUND_DEFAULT)
+	    range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp,
+							 pos, noside));
+	  if ((range->f90_range_type == LOW_BOUND_DEFAULT)
+	      || range->f90_range_type == NONE_BOUND_DEFAULT)
+	    range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp,
+							  pos, noside));
+	}
+      /* User input is an index.  E.g.: "p arry(5)".  */
+      else
+	{
+	  struct value *val;
 
-  if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
-    high_bound = TYPE_HIGH_BOUND (range);
-  else
-    high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+	  index->kind = SUBSCRIPT_INDEX;
+
+	  /* Evaluate each subscript; it must be a legal integer in F77.  This
+	     ensures the validity of the provided index.  */
+	  val = evaluate_subexp_with_coercion (exp, pos, noside);
+	  index->number = value_as_long (val);
+	}
+
+    }
+
+  /* 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;
+
+	    /* If no lower bound was provided by the user, we take the
+	       default boundary.  Same for the high bound.  */
+	    if ((range->f90_range_type == LOW_BOUND_DEFAULT)
+		|| (range->f90_range_type == BOTH_BOUND_DEFAULT))
+	      range->low = TYPE_LOW_BOUND (index_type);
+
+	    if ((range->f90_range_type == HIGH_BOUND_DEFAULT)
+		|| (range->f90_range_type == BOTH_BOUND_DEFAULT))
+	      range->high = TYPE_HIGH_BOUND (index_type);
+
+	    /* Both user provided low and high bound have to be inside the
+	       array bounds.  Throw an error if not.  */
+	    if (range->low < TYPE_LOW_BOUND (index_type)
+		|| range->low > TYPE_HIGH_BOUND (index_type)
+		|| range->high < TYPE_LOW_BOUND (index_type)
+		|| range->high > TYPE_HIGH_BOUND (index_type))
+	      error (_("provided bound(s) outside array bound(s)"));
+
+	    /* 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
+	       range argument to allow the correct output representation.  */
+	    dim_count++;
+
+	    new_array
+	      = value_slice_1 (new_array,
+			       longest_to_int (range->low),
+			       longest_to_int (range->high - range->low + 1),
+			       dim_count);
+	  }
+	  break;
+
+	case SUBSCRIPT_INDEX:
+	  {
+	    /* DIM_COUNT only stays '0' when no range argument was processed
+	       before, starting from the last dimension.  This way we can
+	       reduce the number of dimensions from the result array.
+	       However, if a range has been processed before an index, we
+	       treat the index like a range with equal low- and high bounds
+	       to get the value offset right.  */
+	    if (dim_count == 0)
+	      new_array
+	        = value_subscripted_rvalue (new_array, index->number,
+					    f77_get_lowerbound (value_type
+								  (new_array)));
+	    else
+	      {
+		/* Check for valid index input.  */
+		if (index->number < TYPE_LOW_BOUND (index_type)
+		    || index->number > TYPE_HIGH_BOUND (index_type))
+		  error (_("error no such vector element"));
+
+		dim_count++;
+		new_array = value_slice_1 (new_array,
+					   longest_to_int (index->number),
+					   1, /* length is '1' element  */
+					   dim_count);
+	      }
+
+	  }
+	  break;
+	}
+    }
+
+  /* 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
+     the user.  So we need to rebuild the array dimensions for printing it
+     correctly.
+     Starting from right to left in the user input, after we hit the first
+     range argument every subsequent argument is also treated as a range.
+     E.g.:
+     "p ary(3, 7, 2:15)" in Fortran has only 1 dimension, but we calculated 3
+     ranges.
+     "p ary(3, 7:12, 4)" in Fortran has only 1 dimension, but we calculated 2
+     ranges.
+     "p ary(2:4, 5, 7)" in Fortran has only 1 dimension, and we calculated 1
+     range.  */
+  if (dim_count > 1)
+    {
+      struct value *v = NULL;
 
-  return value_slice (array, low_bound, high_bound - low_bound + 1);
+      temp_type = TYPE_TARGET_TYPE (value_type (new_array));
+
+      /* Every SUBSCRIPT_RANGE in the user input signifies an actual range in
+	 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.  */
+      for (i = 0; i < nargs; i++)
+	{
+	  struct subscript_store *index = &subscript_array[i];
+
+	  if (index->kind == SUBSCRIPT_RANGE)
+	    {
+	      struct type *range_type, *interim_array_type;
+
+	      range_type
+		= create_static_range_type (NULL,
+				     temp_type,
+				     1,
+				     index->range.high - index->range.low + 1);
+
+	      interim_array_type = create_array_type (NULL,
+						      temp_type,
+						      range_type);
+
+	      /* For some reason the type code of the contents is missing, so
+		 reset it from the original array.  */
+	      TYPE_CODE (interim_array_type)
+		= TYPE_CODE (value_type (new_array));
+
+	      v = allocate_value (interim_array_type);
+
+	      temp_type = value_type (v);
+	    }
+
+	}
+      value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (temp_type));
+      return v;
+    }
+
+  return new_array;
 }
 
 
@@ -1810,14 +2034,11 @@ evaluate_subexp_standard (struct type *expect_type,
       switch (code)
 	{
 	case TYPE_CODE_ARRAY:
-	  if (exp->elts[*pos].opcode == OP_F90_RANGE)
-	    return value_f90_subarray (arg1, exp, pos, noside);
-	  else
-	    goto multi_f77_subscript;
+	  return value_f90_subarray (arg1, exp, pos, nargs, noside);
 
 	case TYPE_CODE_STRING:
 	  if (exp->elts[*pos].opcode == OP_F90_RANGE)
-	    return value_f90_subarray (arg1, exp, pos, noside);
+	    return value_f90_subarray (arg1, exp, pos, 1, noside);
 	  else
 	    {
 	      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
@@ -2222,49 +2443,6 @@ evaluate_subexp_standard (struct type *expect_type,
 	}
       return (arg1);
 
-    multi_f77_subscript:
-      {
-	LONGEST subscript_array[MAX_FORTRAN_DIMS];
-	int ndimensions = 1, i;
-	struct value *array = arg1;
-
-	if (nargs > MAX_FORTRAN_DIMS)
-	  error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
-
-	ndimensions = calc_f77_array_dims (type);
-
-	if (nargs != ndimensions)
-	  error (_("Wrong number of subscripts"));
-
-	gdb_assert (nargs > 0);
-
-	/* Now that we know we have a legal array subscript expression 
-	   let us actually find out where this element exists in the array.  */
-
-	/* Take array indices left to right.  */
-	for (i = 0; i < nargs; i++)
-	  {
-	    /* Evaluate each subscript; it must be a legal integer in F77.  */
-	    arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
-
-	    /* Fill in the subscript array.  */
-
-	    subscript_array[i] = value_as_long (arg2);
-	  }
-
-	/* Internal type of array is arranged right to left.  */
-	for (i = nargs; i > 0; i--)
-	  {
-	    struct type *array_type = check_typedef (value_type (array));
-	    LONGEST index = subscript_array[i - 1];
-
-	    array = value_subscripted_rvalue (array, index,
-					      f77_get_lowerbound (array_type));
-	  }
-
-	return array;
-      }
-
     case BINOP_LOGICAL_AND:
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
@@ -3121,6 +3299,9 @@ calc_f77_array_dims (struct type *array_type)
   int ndimen = 1;
   struct type *tmp_type;
 
+  if (TYPE_CODE (array_type) == TYPE_CODE_STRING)
+    return 1;
+
   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
     error (_("Can't get dimensions for a non-array type"));
 
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 4faac32..9343abb 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -308,6 +308,8 @@ arglist :	subrange
    
 arglist	:	arglist ',' exp   %prec ABOVE_COMMA
 			{ arglist_len++; }
+	|	arglist ',' subrange	%prec ABOVE_COMMA
+			{ arglist_len++; }
 	;
 
 /* There are four sorts of subrange types in F90.  */
diff --git a/gdb/valops.c b/gdb/valops.c
index 5a244a9..09ea877 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -3759,56 +3759,151 @@ 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);
+}
+
+/* CALL_COUNT is used to determine if we are calling the function once, e.g.
+   we are working on the current dimension of ARRAY, or if we are calling
+   the function repeatedly.  In the later case we need to take elements
+   from the TARGET_TYPE of ARRAY.
+   With a CALL_COUNT greater than 1 we calculate the offsets for every element
+   that should be in the result array.  Then we fetch the contents and then
+   copy them into the result array.  The result array will have one dimension
+   less than the input array, so later on we need to recreate the indices and
+   ranges in the calling function.  */
+
+struct value *
+value_slice_1 (struct value *array, int lowbound, int length, int call_count)
+{
   struct type *slice_range_type, *slice_type, *range_type;
-  LONGEST lowerbound, upperbound;
-  struct value *slice;
-  struct type *array_type;
+  struct type *array_type = check_typedef (value_type (array));
+  struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
+  unsigned int elt_size, elt_offs;
+  LONGEST elt_stride, ary_high_bound, ary_low_bound;
+  struct value *v;
+  int slice_range_size, i = 0, row_count = 1, elem_count = 1;
 
-  array_type = check_typedef (value_type (array));
+  /* Check for legacy code if we are actually dealing with an array or
+     string.  */
   if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
       && TYPE_CODE (array_type) != TYPE_CODE_STRING)
     error (_("cannot take slice of non-array"));
 
-  range_type = TYPE_INDEX_TYPE (array_type);
-  if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
-    error (_("slice from bad array or bitstring"));
+  ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (array_type));
+  ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (array_type));
+
+  /* When we are working on a multi-dimensional array, we need to get the
+     attributes of the underlying type.  */
+  if (call_count > 1)
+    {
+      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;
+  elt_size = TYPE_LENGTH (elt_type);
+  elt_offs = longest_to_int (lowbound - ary_low_bound);
+  elt_stride = TYPE_LENGTH (TYPE_INDEX_TYPE (array_type));
+
+  elt_offs *= elt_size;
+
+  /* Check for valid user input.  In case of Fortran this was already done
+     in the calling function.  */
+  if (call_count == 1
+	&& (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
+	      && elt_offs >= TYPE_LENGTH (array_type)))
+    error (_("no such vector element"));
 
-  if (lowbound < lowerbound || length < 0
-      || lowbound + length - 1 > upperbound)
-    error (_("slice out of range"));
+  /* CALL_COUNT is 1 when we are dealing either with the highest dimension
+     of the array, or a one dimensional array.  Set RANGE_TYPE accordingly.
+     In both cases we calculate how many rows/elements will be in the output
+     array by setting slice_range_size.  */
+  if (call_count == 1)
+    {
+      range_type = TYPE_INDEX_TYPE (array_type);
+      slice_range_size = elem_count;
+
+      /* Check if the array bounds are valid.  */
+      if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0)
+	error (_("slice from bad array or bitstring"));
+    }
+  /* When CALL_COUNT is greater than 1, we are dealing with an array of arrays.
+     So we need to get the type below the current one and set the RANGE_TYPE
+     accordingly.  */
+  else
+    {
+      range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type));
+      slice_range_size = (ary_low_bound + row_count - 1) * (elem_count);
+      ary_low_bound = TYPE_LOW_BOUND (range_type);
+    }
 
   /* FIXME-type-allocation: need a way to free this type when we are
-     done with it.  */
-  slice_range_type = create_static_range_type ((struct type *) NULL,
-					       TYPE_TARGET_TYPE (range_type),
-					       lowbound,
-					       lowbound + length - 1);
+      done with it.  */
 
+  slice_range_type = create_static_range_type (NULL, TYPE_TARGET_TYPE (range_type),
+					ary_low_bound, slice_range_size);
   {
-    struct type *element_type = TYPE_TARGET_TYPE (array_type);
-    LONGEST offset
-      = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type));
+    struct type *element_type;
+
+    /* When CALL_COUNT equals 1 we can use the legacy code for subarrays.  */
+    if (call_count == 1)
+      {
+	element_type = TYPE_TARGET_TYPE (array_type);
 
-    slice_type = create_array_type ((struct type *) NULL,
-				    element_type,
-				    slice_range_type);
-    TYPE_CODE (slice_type) = TYPE_CODE (array_type);
+	slice_type = create_array_type (NULL, element_type, slice_range_type);
+
+	TYPE_CODE (slice_type) = TYPE_CODE (array_type);
+
+	if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
+	  v = allocate_value_lazy (slice_type);
+	else
+	  {
+	    v = allocate_value (slice_type);
+	    value_contents_copy (v,
+				 value_embedded_offset (v),
+				 array,
+				 value_embedded_offset (array) + elt_offs,
+				 elt_size * longest_to_int (length));
+	  }
 
-    if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
-      slice = allocate_value_lazy (slice_type);
+      }
+    /* 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.  */
     else
       {
-	slice = allocate_value (slice_type);
-	value_contents_copy (slice, 0, array, offset,
-			     type_length_units (slice_type));
+	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));
+	slice_type = create_array_type (NULL, element_type, slice_range_type);
+
+	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++)
+	  {
+	    /* 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;
+	  }
       }
 
-    set_value_component_location (slice, array);
-    VALUE_FRAME_ID (slice) = VALUE_FRAME_ID (array);
-    set_value_offset (slice, value_offset (array) + offset);
+    set_value_component_location (v, array);
+    VALUE_REGNUM (v) = VALUE_REGNUM (array);
+    VALUE_FRAME_ID (v) = VALUE_FRAME_ID (array);
+    set_value_offset (v, value_offset (array) + elt_offs);
   }
 
-  return slice;
+  return v;
 }
 
 /* Create a value for a FORTRAN complex number.  Currently most of the
diff --git a/gdb/value.h b/gdb/value.h
index 2eac5ef..3400460 100644
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -1056,6 +1056,8 @@ 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_literal_complex (struct value *, struct value *,
 					    struct type *);
 
-- 
2.5.0

[PATCH v2 0/6] fortran: multi-dimensional subarrays with strides

[christoph.t.weinmann]

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

Hi Jan, all,

I reworked a patch series I was working on some time ago.  At that time I was
blocked by missing legal paperwork, and if I am right this obstacle no longer
exists.
The series starts with enabling subarray printing for multi-dimensional arrays,
and then adds the ability to print certain subarray elements specified by
stride values.
To Jan parts of it may look familiar, I think.

I found and fixed an issue with the start index when slicing an array with neg-
ative indices.  And I also updated the tests, which were causing failures on 32
bit OSes.  The array dimensions in the test were wrong, so this was addressed.

Additional feedback is very much appreciated!

Thanks,
Christoph

Christoph Weinmann (6):
  fortran: allow multi-dimensional subarrays
  fortran: combine subarray and string computation
  fortran: change subrange enum to bit field
  fortran: enable parsing of stride parameter for subranges
  fortran: calculate subarray with stride values.
  fortran: test cases for subarray strides and slices

 gdb/eval.c                                  | 386 ++++++++++++++++++++-----
 gdb/f-exp.y                                 |  42 ++-
 gdb/f-lang.h                                |   7 +-
 gdb/parse.c                                 |  24 +-
 gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/static-arrays.f90 |  55 ++++
 gdb/valops.c                                | 196 +++++++++++--
 gdb/value.h                                 |   2 +
 8 files changed, 1009 insertions(+), 124 deletions(-)
 create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.exp
 create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.f90

-- 
2.5.0

[PATCH v2 6/6] fortran: test cases for subarray strides and slices

[christoph.t.weinmann]

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

Add test cases for subarray creation with range, literal and
stride value permutations for one, two, and three dimensional
arrays.

2013-12-04  Christoph Weinmann  <christoph.t.weinmann@intel.com>

testsuite/gdb.fortran/
	* static-arrays.exp: New test.
	* static-arrays.f90: New file.


Signed-off-by: Christoph Weinmann <christoph.t.weinmann@intel.com>
---
 gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/static-arrays.f90 |  55 ++++
 2 files changed, 476 insertions(+)
 create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.exp
 create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.f90

diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp
new file mode 100644
index 0000000..cc9ecc0
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/static-arrays.exp
@@ -0,0 +1,421 @@
+# Copyright 2015 Free Software Foundation, Inc.
+#
+# Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
+#
+# 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 static-arrays.f90
+
+if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+gdb_breakpoint [gdb_get_line_number "BP1"]
+gdb_continue_to_breakpoint "BP1" ".*BP1.*"
+
+# Tests subarrays of one dimensional arrays with subrange variations
+gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \
+		"print ar1."
+gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \
+		"print ar1\(4:7\)"
+gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \
+		"print ar1\(8:\)"
+gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \
+		"print ar1\(:3\)"
+gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \
+		"print ar1\(:\)"
+
+# Check assignment
+gdb_test_no_output "set \$my_ary = ar1\(3:8\)"
+gdb_test "print \$my_ary" \
+		"\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \
+		"Assignment of subarray to variable"
+gdb_test_no_output "set ar1\(5\) = 42"
+		gdb_test "print ar1\(3:8\)" \
+		"\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \
+		"print ar1\(3:8\) after assignment"
+gdb_test "print \$my_ary" \
+		"\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \
+		"Assignment of subarray to variable after original array changed"
+
+# Test for subarrays of one dimensional arrays with literals
+		gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \
+		"print ar1\(3\)"
+
+# Tests for subranges of 2 dimensional arrays with subrange variations
+gdb_test "print ar2\(2:3, 3:4\)" \
+		"\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \
+		"print ar2\(2:3, 3:4\)."
+gdb_test "print ar2\(8:9,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
+		"print ar2\(8:9,8:\)"
+gdb_test "print ar2\(8:9,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \
+		"print ar2\(8:9,:2\)"
+
+gdb_test "print ar2\(8:,8:9\)" \
+		"\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
+		"print ar2\(8:,8:9\)"
+gdb_test "print ar2\(8:,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
+		"print ar2\(8:,8:\)"
+gdb_test "print ar2\(8:,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \
+		"print ar2\(8:,:2\)"
+
+gdb_test "print ar2\(:2,2:3\)" \
+		"\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \
+		"print ar2\(:2,2:3\)"
+gdb_test "print ar2\(:2,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \
+		"print ar2\(:2,8:\)"
+gdb_test "print ar2\(:2,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \
+		"print ar2\(:2,:2\)"
+
+# Test subranges of 2 dimensional arrays with literals and subrange variations
+gdb_test "print ar2\(7, 3:6\)" \
+		"\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \
+		"print ar2\(7, 3:6\)"
+gdb_test "print ar2\(7,8:\)" \
+		"\\$\[0-9\]+ = \\(78, 79\\)" \
+		"print ar2\(7,8:\)"
+gdb_test "print ar2\(7,:2\)" \
+		"\\$\[0-9\]+ = \\(71, 72\\)" \
+		"print ar2\(7,:2\)"
+
+gdb_test "print ar2\(7:8,4\)" \
+		"\\$\[0-9\]+ = \\(74, 84\\)" \
+		"print ar2(7:8,4\)"
+gdb_test "print ar2\(8:,4\)" \
+		"\\$\[0-9\]+ = \\(84, 94\\)" \
+		"print ar2\(8:,4\)"
+gdb_test "print ar2\(:2,4\)" \
+		"\\$\[0-9\]+ = \\(14, 24\\)" \
+		"print ar2\(:2,4\)"
+gdb_test "print ar2\(3,4\)" \
+		"\\$\[0-9\]+ = 34" \
+		"print ar2\(3,4\)"
+
+# Test subarrays of 3 dimensional arrays with literals and subrange variations
+gdb_test "print ar3\(2:4,3:4,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\)\
+		 \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \
+		"print ar3\(2:4,3:4,7:8\)"
+gdb_test "print ar3\(2:3,4:5,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\(\
+		 \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \
+		"print ar3\(2:3,4:5,8:\)"
+gdb_test "print ar3\(2:3,4:5,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\(\
+		 \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \
+		"print ar3\(2:3,4:5,:2\)"
+
+gdb_test "print ar3\(2:3,8:,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\(\
+		 \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \
+		"print ar3\(2:3,8:,7:8\)"
+gdb_test "print ar3\(2:3,8:,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\(\
+		 \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \
+		"print ar3\(2:3,8:,8:\)"
+gdb_test "print ar3\(2:3,8:,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\(\
+		 \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \
+		"print ar3\(2:3,8:,:2\)"
+
+gdb_test "print ar3\(2:3,:2,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\(\
+		 \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \
+		"print ar3\(2:3,:2,7:8\)"
+gdb_test "print ar3\(2:3,:2,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\(\
+		 \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \
+		"print ar3\(2:3,:2,8:\)"
+gdb_test "print ar3\(2:3,:2,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\(\
+		 \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \
+		"print ar3\(2:3,:2,:2\)"
+
+gdb_test "print ar3\(8:,3:4,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\(\
+		 \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \
+		"print ar3\(8:,3:4,7:8\)"
+gdb_test "print ar3\(8:,4:5,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\(\
+		 \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \
+		"print ar3\(8:,4:5,8:\)"
+gdb_test "print ar3\(8:,4:5,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\(\
+		 \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \
+		"print ar3\(8:,4:5,:2\)"
+
+gdb_test "print ar3\(8:,8:,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\(\
+		 \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \
+		"print ar3\(8:,8:,7:8\)"
+gdb_test "print ar3\(8:,8:,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\(\
+		 \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \
+		"print ar3\(8:,8:,8:\)"
+gdb_test "print ar3\(8:,8:,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\(\
+		 \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \
+		"print ar3\(8:,8:,:2\)"
+
+gdb_test "print ar3\(8:,:2,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\(\
+		 \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \
+		"print ar3\(8:,:2,7:8\)"
+gdb_test "print ar3\(8:,:2,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\(\
+		 \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \
+		"print ar3\(8:,:2,8:\)"
+gdb_test "print ar3\(8:,:2,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\(\
+		 \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \
+		"print ar3\(8:,:2,:2\)"
+
+
+gdb_test "print ar3\(:2,3:4,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\(\
+		 \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \
+		"print ar3 \(:2,3:4,7:8\)."
+gdb_test "print ar3\(:2,3:4,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\(\
+		 \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \
+		"print ar3\(:2,3:4,8:\)"
+gdb_test "print ar3\(:2,3:4,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\(\
+		 \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \
+		"print ar3\(:2,3:4,:2\)"
+
+gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\(\
+		 197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \
+		"print ar3\(:2,8:,7:8\)"
+gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198,\
+		 298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \
+		"print ar3\(:2,8:,8:\)"
+gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191,\
+		 291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \
+		"print ar3\(:2,8:,:2\)"
+
+gdb_test "print ar3\(:2,:2,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\(\
+		 \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \
+		"print ar3\(:2,:2,7:8\)"
+gdb_test "print ar3\(:2,:2,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\(\
+		 \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \
+		"print ar3\(:2,:2,8:\)"
+gdb_test "print ar3\(:2,:2,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\(\
+		 \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \
+		"print ar3\(:2,:2,:2\)"
+
+#Tests for subarrays of 3 dimensional arrays with literals and subranges
+gdb_test "print ar3\(3,3:4,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \
+		"print ar3\(3,3:4,7:8\)"
+gdb_test "print ar3\(3,4:5,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \
+		"print ar3\(3,4:5,8:\)"
+gdb_test "print ar3\(3,4:5,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \
+		"print ar3\(3,4:5,:2\)"
+gdb_test "print ar3\(3,4:5,3\)" \
+		"\\$\[0-9\]+ = \\(343, 353\\)" \
+		"print ar3\(3,4:5,3\)"
+
+gdb_test "print ar3\(2,8:,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \
+		"print ar3\(2,8:,7:8\)"
+gdb_test "print ar3\(2,8:,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \
+		"print ar3\(2,8:,8:\)"
+gdb_test "print ar3\(2,8:,:2\)"\
+		"\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \
+		"print ar3\(2,8:,:2\)"
+gdb_test "print ar3\(2,8:,3\)" \
+		"\\$\[0-9\]+ = \\(283, 293\\)" \
+		"print ar3\(2,8:,3\)"
+
+gdb_test "print ar3\(2,:2,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \
+		"print ar3\(2,:2,7:8\)"
+gdb_test "print ar3\(2,:2,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \
+		"print ar3\(2,:2,8:\)"
+gdb_test "print ar3\(2,:2,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \
+		"print ar3\(2,:2,:2\)"
+gdb_test "print ar3\(2,:2,3\)" \
+		"\\$\[0-9\]+ = \\(213, 223\\)" \
+		"print ar3\(2,:2,3\)"
+
+gdb_test "print ar3\(3,4,7:8\)" \
+		"\\$\[0-9\]+ = \\(347, 348\\)" \
+		"print ar3\(3,4,7:8\)"
+gdb_test "print ar3\(3,4,8:\)" \
+		"\\$\[0-9\]+ = \\(348, 349\\)" \
+i		"print ar3\(3,4,8:\)"
+gdb_test "print ar3\(3,4,:2\)" \
+		"\\$\[0-9\]+ = \\(341, 342\\)" \
+		"print ar3\(3,4,:2\)"
+gdb_test "print ar3\(5,6,7\)" \
+		"\\$\[0-9\]+ = 567" \
+		"print ar3\(5,6,7\)"
+
+gdb_test "print ar3\(3:4,6,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \
+		"print ar3\(3:4,6,7:8\)"
+gdb_test "print ar3\(3:4,6,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \
+		"print ar3\(3:4,6,8:\)"
+gdb_test "print ar3\(3:4,6,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \
+		"print ar3\(3:4,6,:2\)"
+gdb_test "print ar3\(3:4,6,5\)" \
+		"\\$\[0-9\]+ = \\(365, 465\\)" \
+		"print ar3\(3:4,6,5\)"
+
+gdb_test "print ar3\(8:,6,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \
+		"print ar3\(8:,6,7:8\)"
+gdb_test "print ar3\(8:,6,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \
+		"print ar3\(8:,6,8:\)"
+gdb_test "print ar3\(8:,6,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \
+		"print ar3\(8:,6,:2\)"
+gdb_test "print ar3\(8:,6,5\)" \
+		"\\$\[0-9\]+ = \\(865, 965\\)" \
+		"print ar3\(8:,6,5\)"
+
+gdb_test "print ar3\(:2,6,7:8\)" \
+		"\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \
+		"print ar3\(:2,6,7:8\)"
+gdb_test "print ar3\(:2,6,8:\)" \
+		"\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \
+		"print ar3\(:2,6,8:\)"
+gdb_test "print ar3\(:2,6,:2\)" \
+		"\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \
+		"print ar3\(:2,6,:2\)"
+gdb_test "print ar3\(:2,6,5\)" \
+		"\\$\[0-9\]+ = \\(165, 265\\)" \
+		"print ar3\(:2,6,5\)"
+
+gdb_test "print ar3\(3:4,5:6,4\)" \
+		"\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \
+		"print ar2\(3:4,5:6,4\)"
+gdb_test "print ar3\(8:,5:6,4\)" \
+		"\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \
+		"print ar2\(8:,5:6,4\)"
+gdb_test "print ar3\(:2,5:6,4\)" \
+		"\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \
+		"print ar2\(:2,5:6,4\)"
+
+# Stride > 1
+gdb_test "print ar1\(2:6:2\)" \
+		"\\$\[0-9\]+ = \\(2, 4, 6\\)" \
+		"print ar1\(2:6:2\)"
+gdb_test "print ar2\(2:6:2,3:4\)" \
+		"\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \
+		"print ar2\(2:6:2,3:4\)"
+gdb_test "print ar2\(2:6:2,3\)" \
+		"\\$\[0-9\]+ = \\(23, 43, 63\\)" \
+		"print ar2\(2:6:2,3\)"
+gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\)\
+		 \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \
+		"print ar3\(2:6:2,3:5:2,4:7:3\)"
+gdb_test "print ar3\(2:6:2,5,4:7:3\)" \
+		"\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\)\
+		 \\)" \
+		"print ar3\(2:6:2,5,4:7:3\)"
+
+# Stride < 0
+gdb_test "print ar1\(8:2:-2\)" \
+		"\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \
+		"print ar1\(8:2:-2\)"
+gdb_test "print ar2\(8:2:-2,3:4\)" \
+		"\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\)\
+		 \\)" \
+		"print ar2\(8:2:-2,3:4\)"
+gdb_test "print ar2\(2:6:2,3\)" \
+		"\\$\[0-9\]+ = \\(23, 43, 63\\)" \
+		"print ar2\(2:6:2,3\)"
+gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\(\
+		 \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \
+		"print ar3\(2:3,7:3:-4,4:7:3\)"
+gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \
+		"\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\)\
+		 \\)" \
+		"print ar3\(2:6:2,5,7:4:-3\)"
+
+# Tests with negative and mixed indices
+gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \
+		"\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\)\
+		 \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262,\
+		 362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292,\
+		 392, 492\\) \\) \\)" \
+		"print ar4(2:4, -2:1, -15:-14)"
+
+gdb_test "p ar4\(7,-6:2:3,-7\)" \
+                "\\$\[0-9\]+ = \\(729, 759, 789\\)" \
+                "print ar4(7,-6:2:3,-7)"
+
+gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \
+                "\\$\[0-9\]+ = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760,\
+		 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727,\
+		 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587,\
+		 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554,\
+		 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521,\
+		 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\)\
+		 \\)" \
+                "print ar4(9:2:-2, -6:2:3, -6:-15:-3)"
+
+gdb_test "p ar4\(:,:,:\)" \
+                "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711,\
+		 811, .*" \
+                "print ar4(:,:,:)"
+
+# Provoke error messages for bad user input
+gdb_test "print ar1\(0:4\)" \
+		"provided bound\\(s\\) outside array bound\\(s\\)" \
+		"print ar1\(0:4\)"
+gdb_test "print ar1\(8:12\)" \
+		"provided bound\\(s\\) outside array bound\\(s\\)" \
+		"print ar1\(8:12\)"
+gdb_test "print ar1\(8:2:\)" \
+		"A syntax error in expression, near `\\)'." \
+		"print ar1\(8:2:\)"
+gdb_test "print ar1\(8:2:2\)" \
+		"Wrong value provided for stride and boundaries" \
+		"print ar1\(8:2:2\)"
+gdb_test "print ar1\(2:8:-2\)" \
+		"Wrong value provided for stride and boundaries" \
+		"print ar1\(2:8:-2\)"
+gdb_test "print ar1\(2:7:0\)" \
+		"Stride must not be 0" \
+		"print ar1\(2:7:0\)"
+gdb_test "print ar1\(3:7\) = 42" \
+		"Invalid cast." \
+		"Assignment of value to subarray"
diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90
new file mode 100644
index 0000000..f22fcbe
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/static-arrays.f90
@@ -0,0 +1,55 @@
+! Copyright 2015 Free Software Foundation, Inc.
+!
+! Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
+!
+! 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 sub
+  integer, dimension(9) :: ar1
+  integer, dimension(9,9) :: ar2
+  integer, dimension(9,9,9) :: ar3
+  integer, dimension(10,-7:3, -15:-5) :: ar4
+  integer :: i,j,k
+
+  ar1 = 1
+  ar2 = 1
+  ar3 = 1
+  ar4 = 4
+
+  ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...)))
+  do i = 1, 9, 1
+    ar1(i) = i
+    do j = 1, 9, 1
+      ar2(i,j) = i*10 + j
+      do k = 1, 9, 1
+        ar3(i,j,k) = i*100 + j*10 + k
+      end do
+    end do
+  end do
+
+  do i = 1, 10, 1
+    do j = -7, 3, 1
+      do k = -15, -5, 1
+        ar4(i,j,k) = i*100 + (j+8)*10 + (k+16)
+      end do
+    end do
+  end do
+
+  ar1(1) = 11  !BP1
+  return
+end
+
+program testprog
+  call sub
+end
-- 
2.5.0

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

[christoph.t.weinmann]

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

Re: [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides

[Jan Kratochvil]

Hi Christoph,

On Fri, 26 Feb 2016 14:10:53 +0100, christoph.t.weinmann@intel.com wrote:
> I found and fixed an issue with the start index when slicing an array with neg-
> ative indices.  And I also updated the tests, which were causing failures on 32
> bit OSes.  The array dimensions in the test were wrong, so this was addressed.

FYI I see no regressions on x86_64/i686 against the previous version:
	http://pkgs.fedoraproject.org/cgit/rpms/gdb.git/commit/?id=fdbd5e346bf50f7d37fd53c5520bcea74d7ed59b


Thanks,
Jan