From FEDORA_PATCHES Mon Sep 17 00:00:00 2001

From: Fedora GDB patches <invalid@email.com>

Date: Fri, 27 Oct 2017 21:07:50 +0200

Subject: gdb-vla-intel-fortran-strides.patch

;; VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests.

;;=push

git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides

dbfd7140bf4c0500d1f5d192be781f83f78f7922

 gdb/dwarf2loc.c                             |  46 ++-

 gdb/dwarf2loc.h                             |   6 +

 gdb/dwarf2read.c                            |  13 +-

 gdb/eval.c                                  | 391 +++++++++++++++++++++-----

 gdb/expprint.c                              |  20 +-

 gdb/expression.h                            |  18 +-

 gdb/f-exp.y                                 |  42 ++-

 gdb/f-valprint.c                            |   8 +-

 gdb/gdbtypes.c                              |  34 ++-

 gdb/gdbtypes.h                              |  18 +-

 gdb/parse.c                                 |  24 +-

 gdb/rust-exp.y                              |  12 +-

 gdb/rust-lang.c                             |  17 +-

 gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++

 gdb/testsuite/gdb.fortran/static-arrays.f90 |  55 ++++

 gdb/testsuite/gdb.fortran/vla-ptype.exp     |   4 +

 gdb/testsuite/gdb.fortran/vla-sizeof.exp    |   4 +

 gdb/testsuite/gdb.fortran/vla-stride.exp    |  44 +++

 gdb/testsuite/gdb.fortran/vla-stride.f90    |  29 ++

 gdb/testsuite/gdb.fortran/vla.f90           |  10 +

 gdb/valarith.c                              |  10 +-

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

 gdb/value.h                                 |   2 +

 23 files changed, 1242 insertions(+), 183 deletions(-)

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

--- a/gdb/eval.c

+++ b/gdb/eval.c

@@ -372,29 +372,324 @@ 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;

-  LONGEST low_bound, high_bound;

-  struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));

-  enum range_type range_type

-    = (enum range_type) longest_to_int (exp->elts[pc].longconst);

- 

-  *pos += 3;

-

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

+  int i, dim_count = 0;

+  struct value *new_array = array;

+  struct type *array_type = check_typedef (value_type (new_array));

+  struct type *elt_type;

+

+  typedef struct

+  {

+    enum range_type f90_range_type;

+    LONGEST low, high, stride;

+  } subscript_range;

+

+  typedef enum subscript_kind

+  {

+    SUBSCRIPT_RANGE,    /* e.g. "(lowbound:highbound)"  */

+    SUBSCRIPT_INDEX    /* e.g. "(literal)"  */

+  } kind;

+

+  /* 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_kind 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 element_range

+    {

+      subscript_range range;

+      LONGEST number;

+    } U;

+  } *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 = (struct subscript_store*) 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];

+

+      /* 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_RANGE)

+	{

+	  int pc = (*pos) + 1;

+	  subscript_range *range;

+

+	  index->kind = SUBSCRIPT_RANGE;

+	  range = &index->U.range;

+

+	  *pos += 3;

+	  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

+	     upper bound.  */

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

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

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

+	  /* 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

+	{

+	  struct value *val;

+

+	  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->U.number = value_as_long (val);

+	}

+

+    }

+

+  /* 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];

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

+

+	    /* If no lower bound was provided by the user, we take the

+	       default boundary.  Same for the high bound.  */

+	    if ((range->f90_range_type & SUBARRAY_LOW_BOUND) == 0)

+	      range->low = TYPE_LOW_BOUND (index_type);

+

+	    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

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

+

+	    /* 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

+	       range argument to allow the correct output representation.  */

+	    dim_count++;

+

+	    new_array

+	      = value_slice_1 (new_array, range->low,

+			       range->high - range->low + 1,

+			       range->stride, 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->U.number,

+					    f77_get_lowerbound (value_type

+								  (new_array)));

+	    else

+	      {

+		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 (_("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)"));

+

+		new_array = value_slice_1 (new_array,

+					   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

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

+

+      elt_type = TYPE_TARGET_TYPE (value_type (new_array));

-  return value_slice (array, low_bound, high_bound - low_bound + 1);

+      /* 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.  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];

+

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

+

+	      new_length /= index->U.range.stride;

+

+	      range_type

+		= create_static_range_type (NULL,

+					    elt_type,

+					    index->U.range.low,

+					    index->U.range.low + new_length);

+

+	      interim_array_type = create_array_type (NULL,

+						      elt_type,

+						      range_type);

+

+	      TYPE_CODE (interim_array_type)

+		= TYPE_CODE (value_type (new_array));

+

+	      v = allocate_value (interim_array_type);

+

+	      elt_type = value_type (v);

+	    }

+

+	}

+      value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (elt_type));

+      return v;

+    }

+

+  return new_array;

 }

@@ -1235,19 +1530,6 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,

   return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);

 }

-/* Helper for skipping all the arguments in an undetermined argument list.

-   This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST

-   case of evaluate_subexp_standard as multiple, but not all, code paths

-   require a generic skip.  */

-

-static void

-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,

-			   enum noside noside)

-{

-  for (int i = 0; i < nargs; ++i)

-    evaluate_subexp (NULL_TYPE, exp, pos, noside);

-}

-

 struct value *

 evaluate_subexp_standard (struct type *expect_type,

 			  struct expression *exp, int *pos,

@@ -1942,33 +2224,8 @@ evaluate_subexp_standard (struct type *expect_type,

       switch (code)

 	{

 	case TYPE_CODE_ARRAY:

-	  if (exp->elts[*pos].opcode == OP_RANGE)

-	    return value_f90_subarray (arg1, exp, pos, noside);

-	  else

-	    {

-	      if (noside == EVAL_SKIP)

-		{

-		  skip_undetermined_arglist (nargs, exp, pos, noside);

-		  /* Return the dummy value with the correct type.  */

-		  return arg1;

-		}

-	      goto multi_f77_subscript;

-	    }

-

 	case TYPE_CODE_STRING:

-	  if (exp->elts[*pos].opcode == OP_RANGE)

-	    return value_f90_subarray (arg1, exp, pos, noside);

-	  else

-	    {

-	      if (noside == EVAL_SKIP)

-		{

-		  skip_undetermined_arglist (nargs, exp, pos, noside);

-		  /* Return the dummy value with the correct type.  */

-		  return arg1;

-		}

-	      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:

@@ -2388,49 +2645,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)

@@ -3350,6 +3564,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/expprint.c b/gdb/expprint.c

--- a/gdb/expprint.c

+++ b/gdb/expprint.c

@@ -580,17 +580,14 @@ print_subexp_standard (struct expression *exp, int *pos,

 	  longest_to_int (exp->elts[pc + 1].longconst);

 	*pos += 2;

-	if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE

-	    || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)

+	if ((range_type & SUBARRAY_HIGH_BOUND_EXCLUSIVE)

+	    == SUBARRAY_HIGH_BOUND_EXCLUSIVE)

 	  fputs_filtered ("EXCLUSIVE_", stream);

 	fputs_filtered ("RANGE(", stream);

-	if (range_type == HIGH_BOUND_DEFAULT

-	    || range_type == NONE_BOUND_DEFAULT

-	    || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)

+	if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)

 	  print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);

 	fputs_filtered ("..", stream);

-	if (range_type == LOW_BOUND_DEFAULT

-	    || range_type == NONE_BOUND_DEFAULT)

+	if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)

 	  print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);

 	fputs_filtered (")", stream);

 	return;

@@ -1107,22 +1104,24 @@ dump_subexp_body_standard (struct expression *exp,

 	switch (range_type)

 	  {

-	  case BOTH_BOUND_DEFAULT:

+	  case SUBARRAY_NONE_BOUND:

 	    fputs_filtered ("Range '..'", stream);

 	    break;

-	  case LOW_BOUND_DEFAULT:

+	  case SUBARRAY_HIGH_BOUND:

 	    fputs_filtered ("Range '..EXP'", stream);

 	    break;

-	  case LOW_BOUND_DEFAULT_EXCLUSIVE:

-	    fputs_filtered ("ExclusiveRange '..EXP'", stream);

-	    break;

-	  case HIGH_BOUND_DEFAULT:

+	  case SUBARRAY_LOW_BOUND:

 	    fputs_filtered ("Range 'EXP..'", stream);

 	    break;

-	  case NONE_BOUND_DEFAULT:

+	  case (SUBARRAY_LOW_BOUND

+		| SUBARRAY_HIGH_BOUND

+		| SUBARRAY_HIGH_BOUND_EXCLUSIVE):

+	    fputs_filtered ("ExclusiveRange '..EXP'", stream);

+	    break;

+	  case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND):

 	    fputs_filtered ("Range 'EXP..EXP'", stream);

 	    break;

-	  case NONE_BOUND_DEFAULT_EXCLUSIVE:

+	  case (SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE):

 	    fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);

 	    break;

 	  default:

@@ -1130,11 +1129,9 @@ dump_subexp_body_standard (struct expression *exp,

 	    break;

 	  }

-	if (range_type == HIGH_BOUND_DEFAULT

-	    || range_type == NONE_BOUND_DEFAULT)

+	if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)

 	  elt = dump_subexp (exp, stream, elt);

-	if (range_type == LOW_BOUND_DEFAULT

-	    || range_type == NONE_BOUND_DEFAULT)

+	if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)

 	  elt = dump_subexp (exp, stream, elt);

       }

       break;

diff --git a/gdb/expression.h b/gdb/expression.h

--- a/gdb/expression.h

+++ b/gdb/expression.h

@@ -167,28 +167,27 @@ extern void dump_raw_expression (struct expression *,

 				 struct ui_file *, const char *);

 extern void dump_prefix_expression (struct expression *, struct ui_file *);

-/* In an OP_RANGE expression, either bound could be empty, indicating

-   that its value is by default that of the corresponding bound of the

-   array or string.  Also, the upper end of the range can be exclusive

-   or inclusive.  So we have six sorts of subrange.  This enumeration

-   type is to identify this.  */

+/* In an OP_RANGE expression, either bound can be provided by the

+   user, or not.  In addition to this, the user can also specify a

+   stride value to indicated only certain elements of the array.

+   Also, the upper end of the range can be exclusive or inclusive.

+   This enumeration type is to identify this.  */

 enum range_type

-{

-  /* Neither the low nor the high bound was given -- so this refers to

-     the entire available range.  */

-  BOTH_BOUND_DEFAULT,

-  /* The low bound was not given and the high bound is inclusive.  */

-  LOW_BOUND_DEFAULT,

-  /* The high bound was not given and the low bound in inclusive.  */

-  HIGH_BOUND_DEFAULT,

-  /* Both bounds were given and both are inclusive.  */

-  NONE_BOUND_DEFAULT,

-  /* The low bound was not given and the high bound is exclusive.  */

-  NONE_BOUND_DEFAULT_EXCLUSIVE,

-  /* Both bounds were given.  The low bound is inclusive and the high

-     bound is exclusive.  */

-  LOW_BOUND_DEFAULT_EXCLUSIVE,

-};

+  {

+    SUBARRAY_NONE_BOUND = 0x0,		/* "( : )"  */

+    SUBARRAY_LOW_BOUND = 0x1,		/* "(low:)"  */

+    SUBARRAY_HIGH_BOUND = 0x2,		/* "(:high)"  */

+    SUBARRAY_STRIDE = 0x4,		/* "(::stride)"  */

+    /* The low bound was not given and the high bound is exclusive.

+       In this case we always use (SUBARRAY_HIGH_BOUND |

+       SUBARRAY_HIGH_BOUND_EXCLUSIVE).  */

+    SUBARRAY_HIGH_BOUND_EXCLUSIVE = 0x8,

+    /* Both bounds were given.  The low bound is inclusive and the high

+       bound is exclusive.  In this case, we use (SUBARRAY_LOW_BOUND |

+       SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE).  */

+    // SUBARRAY_LOW_BOUND_EXCLUSIVE = (SUBARRAY_LOW_BOUND

+    // 				    | SUBARRAY_HIGH_BOUND_EXCLUSIVE),

+  };

 #endif /* !defined (EXPRESSION_H) */

diff --git a/gdb/f-exp.y b/gdb/f-exp.y

--- a/gdb/f-exp.y

+++ b/gdb/f-exp.y

@@ -282,31 +282,63 @@ arglist :	subrange

 arglist	:	arglist ',' exp   %prec ABOVE_COMMA

 			{ pstate->arglist_len++; }

+	|	arglist ',' subrange	%prec ABOVE_COMMA

+			{ pstate->arglist_len++; }

 	;

 /* There are four sorts of subrange types in F90.  */

 subrange:	exp ':' exp	%prec ABOVE_COMMA

-			{ write_exp_elt_opcode (pstate, OP_RANGE); 

-			  write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);

+			{ write_exp_elt_opcode (pstate, OP_RANGE);

+			  write_exp_elt_longcst (pstate,

+						 SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND);

 			  write_exp_elt_opcode (pstate, OP_RANGE); }

 	;

 subrange:	exp ':'	%prec ABOVE_COMMA

 			{ write_exp_elt_opcode (pstate, OP_RANGE);

-			  write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);

+			  write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND);

 			  write_exp_elt_opcode (pstate, OP_RANGE); }

 	;

 subrange:	':' exp	%prec ABOVE_COMMA

 			{ write_exp_elt_opcode (pstate, OP_RANGE);

-			  write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);

+			  write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND);

 			  write_exp_elt_opcode (pstate, OP_RANGE); }

 	;

 subrange:	':'	%prec ABOVE_COMMA

 			{ write_exp_elt_opcode (pstate, OP_RANGE);

-			  write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);

+			  write_exp_elt_longcst (pstate, SUBARRAY_NONE_BOUND);

+			  write_exp_elt_opcode (pstate, OP_RANGE); }

+	;

+

+/* Each subrange type can have a stride argument.  */

+subrange:	exp ':' exp ':' exp %prec ABOVE_COMMA

+			{ write_exp_elt_opcode (pstate, OP_RANGE);

+			  write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND

+						 | SUBARRAY_HIGH_BOUND

+						 | SUBARRAY_STRIDE);

+			  write_exp_elt_opcode (pstate, OP_RANGE); }

+	;

+

+subrange:	exp ':' ':' exp %prec ABOVE_COMMA

+			{ write_exp_elt_opcode (pstate, OP_RANGE);

+			  write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND

+						 | SUBARRAY_STRIDE);

+			  write_exp_elt_opcode (pstate, OP_RANGE); }

+	;

+

+subrange:	':' exp ':' exp %prec ABOVE_COMMA

+			{ write_exp_elt_opcode (pstate, OP_RANGE);

+			  write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND

+						 | SUBARRAY_STRIDE);

+			  write_exp_elt_opcode (pstate, OP_RANGE); }

+	;

+

+subrange:	':' ':' exp %prec ABOVE_COMMA

+			{ write_exp_elt_opcode (pstate, OP_RANGE);

+			  write_exp_elt_longcst (pstate, SUBARRAY_STRIDE);

 			  write_exp_elt_opcode (pstate, OP_RANGE); }

 	;

diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c

--- a/gdb/f-valprint.c

+++ b/gdb/f-valprint.c

@@ -129,6 +129,11 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,

 	byte_stride = dim_size;

       size_t offs = 0;

+      if (byte_stride)

+        dim_size = byte_stride;

+      else

+        dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));

+

       for (i = lowerbound;

 	   (i < upperbound + 1 && (*elts) < options->print_max);

 	   i++)

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

--- a/gdb/gdbtypes.c

+++ b/gdb/gdbtypes.c

@@ -936,7 +936,7 @@ create_range_type (struct type *result_type, struct type *index_type,

   TYPE_RANGE_DATA (result_type)->high = *high_bound;

   TYPE_RANGE_DATA (result_type)->bias = bias;

-  /* Initialize the stride to be a constant, the value will already be zero

+  /* bias the stride to be a constant, the value will already be zero

      thanks to the use of TYPE_ZALLOC above.  */

   TYPE_RANGE_DATA (result_type)->stride.kind = PROP_CONST;