+++ /dev/null
-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
-@@ -371,29 +371,323 @@ 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 (value_type (array)->index_type ());
-- 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 = range->bounds ()->low.const_val ();
-- else
-- low_bound = value_as_long (evaluate_subexp (nullptr, 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 (nullptr, exp,
-+ pos, noside));
-+ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND)
-+ == SUBARRAY_HIGH_BOUND)
-+ range->high = value_as_long (evaluate_subexp (nullptr, 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 (nullptr, 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 = range->bounds ()->high.const_val ();
-- else
-- high_bound = value_as_long (evaluate_subexp (nullptr, 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 = array_type->index_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 = index_type->bounds ()->low.const_val ();
-+
-+ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0)
-+ range->high = index_type->bounds ()->high.const_val ();
-+
-+ /* Both user provided low and high bound have to be inside the
-+ array bounds. Throw an error if not. */
-+ if (range->low < index_type->bounds ()->low.const_val ()
-+ || range->low > index_type->bounds ()->high.const_val ()
-+ || range->high < index_type->bounds ()->low.const_val ()
-+ || range->high > index_type->bounds ()->high.const_val ())
-+ 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 = array_type->index_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 < index_type->bounds ()->low.const_val ()
-+ && index->U.number > index_type->bounds ()->high.const_val ())
-+ error (_("provided bound(s) outside array bound(s)"));
-+
-+ if (index->U.number > index_type->bounds ()->low.const_val ()
-+ && index->U.number > index_type->bounds ()->high.const_val ())
-+ 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);
-+
-+ interim_array_type->set_code ( value_type (new_array)->code ());
-+
-+ 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;
- }
-
-
-@@ -1233,19 +1527,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 (nullptr, exp, pos, noside);
--}
--
- /* Return true if type is integral or reference to integral */
-
- static bool
-@@ -1953,33 +2234,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:
-@@ -2400,49 +2656,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 (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
-@@ -3360,6 +3573,9 @@ calc_f77_array_dims (struct type *array_type)
- int ndimen = 1;
- struct type *tmp_type;
-
-+ if (array_type->code () == TYPE_CODE_STRING)
-+ return 1;
-+
- if ((array_type->code () != 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
-@@ -576,17 +576,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;
-@@ -1103,22 +1100,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:
-@@ -1126,11 +1125,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
-@@ -1006,7 +1006,8 @@ create_static_range_type (struct type *result_type, struct type *index_type,
- low.set_const_val (low_bound);
- high.set_const_val (high_bound);
-
-- result_type = create_range_type (result_type, index_type, &low, &high, 0);
-+ result_type = create_range_type (result_type, index_type,
-+ &low, &high, 0);
-
- return result_type;
- }
-diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
---- a/gdb/gdbtypes.h
-+++ b/gdb/gdbtypes.h
-@@ -1615,6 +1615,15 @@ extern unsigned type_align (struct type *);
- space in struct type. */
- extern bool set_type_align (struct type *, ULONGEST);
-
-+#define TYPE_BYTE_STRIDE(range_type) \
-+ TYPE_RANGE_DATA(range_type)->stride.data.const_val
-+#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
-+ TYPE_RANGE_DATA(range_type)->stride.data.locexpr
-+#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
-+ TYPE_RANGE_DATA(range_type)->stride.data.loclist
-+#define TYPE_BYTE_STRIDE_KIND(range_type) \
-+ TYPE_RANGE_DATA(range_type)->stride.kind
-+
- /* Property accessors for the type data location. */
- #define TYPE_DATA_LOCATION(thistype) \
- ((thistype)->dyn_prop (DYN_PROP_DATA_LOCATION))
-@@ -1633,6 +1642,26 @@ extern bool set_type_align (struct type *, ULONGEST);
- #define TYPE_ASSOCIATED_PROP(thistype) \
- ((thistype)->dyn_prop (DYN_PROP_ASSOCIATED))
-
-+/* Accessors for struct range_bounds data attached to an array type's
-+ index type. */
-+
-+#define TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED(arraytype) \
-+ ((arraytype)->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED)
-+#define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
-+ (arraytype->index_type ()->bounds ().low.kind () == PROP_UNDEFINED)
-+#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
-+ (TYPE_BYTE_STRIDE(arraytype->index_type ()) == 0)
-+
-+
-+#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
-+ (TYPE_HIGH_BOUND((arraytype)->index_type ()))
-+
-+#define TYPE_ARRAY_LOWER_BOUND_VALUE(arraytype) \
-+ (TYPE_LOW_BOUND((arraytype)->index_type ()))
-+
-+#define TYPE_ARRAY_BIT_STRIDE(arraytype) \
-+ (TYPE_BIT_STRIDE((arraytype)->index_type ()))
-+
- /* C++ */
-
- #define TYPE_SELF_TYPE(thistype) internal_type_self_type (thistype)
-diff --git a/gdb/parse.c b/gdb/parse.c
---- a/gdb/parse.c
-+++ b/gdb/parse.c
-@@ -919,24 +919,20 @@ operator_length_standard (const struct expression *expr, int endpos,
-
- case OP_RANGE:
- oplen = 3;
-+ args = 0;
- range_type = (enum range_type)
- longest_to_int (expr->elts[endpos - 2].longconst);
-
-- switch (range_type)
-- {
-- case LOW_BOUND_DEFAULT:
-- case LOW_BOUND_DEFAULT_EXCLUSIVE:
-- case HIGH_BOUND_DEFAULT:
-- args = 1;
-- break;
-- case BOTH_BOUND_DEFAULT:
-- args = 0;
-- break;
-- case NONE_BOUND_DEFAULT:
-- case NONE_BOUND_DEFAULT_EXCLUSIVE:
-- 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++;
-+
-+ if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
-+ args++;
-
- break;
-
-diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
---- a/gdb/rust-exp.y
-+++ b/gdb/rust-exp.y
-@@ -2492,24 +2492,28 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
-
- case OP_RANGE:
- {
-- enum range_type kind = BOTH_BOUND_DEFAULT;
-+ enum range_type kind = SUBARRAY_NONE_BOUND;
-
- if (operation->left.op != NULL)
- {
- convert_ast_to_expression (operation->left.op, top);
-- kind = HIGH_BOUND_DEFAULT;
-+ kind = SUBARRAY_LOW_BOUND;
- }
- if (operation->right.op != NULL)
- {
- convert_ast_to_expression (operation->right.op, top);
-- if (kind == BOTH_BOUND_DEFAULT)
-- kind = (operation->inclusive
-- ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE);
-+ if (kind == SUBARRAY_NONE_BOUND)
-+ {
-+ kind = (range_type) SUBARRAY_HIGH_BOUND;
-+ if (!operation->inclusive)
-+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE);
-+ }
- else
- {
-- gdb_assert (kind == HIGH_BOUND_DEFAULT);
-- kind = (operation->inclusive
-- ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE);
-+ gdb_assert (kind == SUBARRAY_LOW_BOUND);
-+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND);
-+ if (!operation->inclusive)
-+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE);
- }
- }
- else
-diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
---- a/gdb/rust-lang.c
-+++ b/gdb/rust-lang.c
-@@ -1082,13 +1082,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
- kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
- *pos += 3;
-
-- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT
-- || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
-+ if ((kind & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
- low = evaluate_subexp (nullptr, exp, pos, noside);
-- if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE
-- || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
-+ if ((kind & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
- high = evaluate_subexp (nullptr, exp, pos, noside);
-- bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT);
-+ bool inclusive = (!((kind & SUBARRAY_HIGH_BOUND_EXCLUSIVE) == SUBARRAY_HIGH_BOUND_EXCLUSIVE));
-
- if (noside == EVAL_SKIP)
- return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
-@@ -1177,7 +1175,7 @@ rust_compute_range (struct type *type, struct value *range,
-
- *low = 0;
- *high = 0;
-- *kind = BOTH_BOUND_DEFAULT;
-+ *kind = SUBARRAY_NONE_BOUND;
-
- if (type->num_fields () == 0)
- return;
-@@ -1185,15 +1183,14 @@ rust_compute_range (struct type *type, struct value *range,
- i = 0;
- if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0)
- {
-- *kind = HIGH_BOUND_DEFAULT;
-+ *kind = SUBARRAY_LOW_BOUND;
- *low = value_as_long (value_field (range, 0));
- ++i;
- }
- if (type->num_fields () > i
- && strcmp (TYPE_FIELD_NAME (type, i), "end") == 0)
- {
-- *kind = (*kind == BOTH_BOUND_DEFAULT
-- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
-+ *kind = (range_type) (*kind | SUBARRAY_HIGH_BOUND);
- *high = value_as_long (value_field (range, i));
-
- if (rust_inclusive_range_type_p (type))
-@@ -1211,7 +1208,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
- struct type *rhstype;
- LONGEST low, high_bound;
- /* Initialized to appease the compiler. */
-- enum range_type kind = BOTH_BOUND_DEFAULT;
-+ enum range_type kind = SUBARRAY_NONE_BOUND;
- LONGEST high = 0;
- int want_slice = 0;
-
-@@ -1309,7 +1306,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
- error (_("Cannot subscript non-array type"));
-
- if (want_slice
-- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT))
-+ && ((kind & SUBARRAY_LOW_BOUND) != SUBARRAY_LOW_BOUND))
- low = low_bound;
- if (low < 0)
- error (_("Index less than zero"));
-@@ -1327,7 +1324,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
- CORE_ADDR addr;
- struct value *addrval, *tem;
-
-- if (kind == BOTH_BOUND_DEFAULT || kind == HIGH_BOUND_DEFAULT)
-+ if ((kind & SUBARRAY_HIGH_BOUND) != SUBARRAY_HIGH_BOUND)
- high = high_bound;
- if (high < 0)
- error (_("High index less than zero"));
-diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp
-new file mode 100644
---- /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
---- /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
-diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
---- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
-+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
-@@ -35,7 +35,8 @@ gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1"
- gdb_test "print sizeof(vla1(3,2,1))" \
- "no such vector element \\(vector not allocated\\)" \
- "print sizeof non-allocated indexed vla1"
--gdb_test "print sizeof(vla1(3:4,2,1))" "array not allocated" \
-+gdb_test "print sizeof(vla1(3:4,2,1))" \
-+ "provided bound\\(s\\) outside array bound\\(s\\)" \
- "print sizeof non-allocated sliced vla1"
-
- # Try to access value in allocated VLA
-@@ -44,7 +45,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
- gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
- gdb_test "print sizeof(vla1(3,2,1))" "4" \
- "print sizeof element from allocated vla1"
--gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
-+gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
- "print sizeof sliced vla1"
-
- # Try to access values in undefined pointer to VLA (dangling)
-@@ -52,7 +53,8 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
- gdb_test "print sizeof(pvla(3,2,1))" \
- "no such vector element \\(vector not associated\\)" \
- "print sizeof non-associated indexed pvla"
--gdb_test "print sizeof(pvla(3:4,2,1))" "array not associated" \
-+gdb_test "print sizeof(pvla(3:4,2,1))" \
-+ "provided bound\\(s\\) outside array bound\\(s\\)" \
- "print sizeof non-associated sliced pvla"
-
- # Try to access values in pointer to VLA and compare them
-@@ -61,7 +63,8 @@ gdb_continue_to_breakpoint "pvla-associated"
- gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
- gdb_test "print sizeof(pvla(3,2,1))" "4" \
- "print sizeof element from associated pvla"
--gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
-+
-+gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
-
- gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
- gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
-diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
-new file mode 100644
---- /dev/null
-+++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
-@@ -0,0 +1,47 @@
-+# Copyright 2016 Free Software Foundation, Inc.
-+
-+# This program is free software; you can redistribute it and/or modify
-+# it under the terms of the GNU General Public License as published by
-+# the Free Software Foundation; either version 3 of the License, or
-+# (at your option) any later version.
-+#
-+# This program is distributed in the hope that it will be useful,
-+# but WITHOUT ANY WARRANTY; without even the implied warranty of
-+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+# GNU General Public License for more details.
-+#
-+# You should have received a copy of the GNU General Public License
-+# along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+standard_testfile ".f90"
-+
-+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
-+ {debug f90 quiet}] } {
-+ return -1
-+}
-+
-+if ![runto MAIN__] then {
-+ perror "couldn't run to breakpoint MAIN__"
-+ continue
-+}
-+
-+gdb_test_no_output "set max-value-size unlimited" \
-+ "set max-value-size to unlimited"
-+
-+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
-+gdb_continue_to_breakpoint "re-reverse-elements"
-+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
-+ "print re-reverse-elements"
-+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
-+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
-+
-+gdb_breakpoint [gdb_get_line_number "odd-elements"]
-+gdb_continue_to_breakpoint "odd-elements"
-+gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
-+gdb_test "print pvla(1)" " = 1" "print first odd-element"
-+gdb_test "print pvla(5)" " = 9" "print last odd-element"
-+
-+gdb_breakpoint [gdb_get_line_number "single-element"]
-+gdb_continue_to_breakpoint "single-element"
-+gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
-+gdb_test "print pvla(1)" " = 5" "print one single-element"
-diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
-new file mode 100644
---- /dev/null
-+++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
-@@ -0,0 +1,29 @@
-+! Copyright 2016 Free Software Foundation, Inc.
-+!
-+! This program is free software; you can redistribute it and/or modify
-+! it under the terms of the GNU General Public License as published by
-+! the Free Software Foundation; either version 3 of the License, or
-+! (at your option) any later version.
-+!
-+! This program is distributed in the hope that it will be useful,
-+! but WITHOUT ANY WARRANTY; without even the implied warranty of
-+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+! GNU General Public License for more details.
-+!
-+! You should have received a copy of the GNU General Public License
-+! along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+program vla_stride
-+ integer, target, allocatable :: vla (:)
-+ integer, pointer :: pvla (:)
-+
-+ allocate(vla(10))
-+ vla = (/ (I, I = 1,10) /)
-+
-+ pvla => vla(10:1:-1)
-+ pvla => pvla(10:1:-1)
-+ pvla => vla(1:10:2) ! re-reverse-elements
-+ pvla => vla(5:4:-2) ! odd-elements
-+
-+ pvla => null() ! single-element
-+end program vla_stride
-diff --git a/gdb/valops.c b/gdb/valops.c
---- a/gdb/valops.c
-+++ b/gdb/valops.c
-@@ -3756,13 +3756,42 @@ 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 default stride
-+ value of '1', which returns every element between LOWBOUND and
-+ (LOWBOUND + LENGTH). We also provide a default CALL_COUNT of '1'
-+ as we are only considering the highest dimension, or we are
-+ working on a one dimensional array. So we call VALUE_SLICE_1
-+ exactly once. */
-+ return value_slice_1 (array, lowbound, length, 1, 1);
-+}
-+
-+/* VALUE_SLICE_1 is called for each array dimension to calculate the number
-+ of elements as defined by the subscript expression.
-+ 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 stride_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 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 (array_type->code () != TYPE_CODE_ARRAY
- && array_type->code () != TYPE_CODE_STRING)
- error (_("cannot take slice of non-array"));
-@@ -3772,45 +3801,155 @@ value_slice (struct value *array, int lowbound, int length)
- if (type_not_associated (array_type))
- error (_("array not associated"));
-
-- range_type = array_type->index_type ();
-- if (!get_discrete_bounds (range_type, &lowerbound, &upperbound))
-- error (_("slice from bad array or bitstring"));
-+ ary_low_bound = array_type->index_type ()->bounds ()->low.const_val ();
-+ ary_high_bound = array_type->index_type ()->bounds ()->high.const_val ();
-+
-+ /* When we are working on a multi-dimensional array, we need to get the
-+ attributes of the underlying type. */
-+ if (call_count > 1)
-+ {
-+ ary_low_bound = elt_type->index_type ()->bounds ()->low.const_val ();
-+ ary_high_bound = elt_type->index_type ()->bounds ()->high.const_val ();
-+ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
-+ row_count = TYPE_LENGTH (array_type)
-+ / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
-+ }
-+
-+ /* 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 = lowbound - ary_low_bound;
-+
-+ elt_offs *= elt_size;
-
-- if (lowbound < lowerbound || length < 0
-- || lowbound + length - 1 > upperbound)
-- error (_("slice out of range"));
-+ /* 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"));
-+
-+ /* 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 = array_type->index_type ();
-+ 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)
-+ 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_TARGET_TYPE (array_type)->index_type ();
-+ slice_range_size = ary_low_bound + (row_count * elem_count) - 1;
-+ ary_low_bound = range_type->bounds ()->low.const_val ();
-+ }
-
- /* FIXME-type-allocation: need a way to free this type when we are
-- done with it. */
-- slice_range_type = create_static_range_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;
-
-- slice_type = create_array_type (NULL,
-- element_type,
-- slice_range_type);
-- slice_type->set_code (array_type->code ());
-+ /* 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);
-+
-+ slice_type = create_array_type (NULL, element_type, slice_range_type);
-+
-+ slice_type->set_code (array_type->code ());
-
-- if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
-- slice = allocate_value_lazy (slice_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));
-+ }
-+
-+ }
-+ /* 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
- {
-- slice = allocate_value (slice_type);
-- value_contents_copy (slice, 0, array, offset,
-- type_length_units (slice_type));
-+ int j, offs_store = elt_offs;
-+ LONGEST dst_offset = 0;
-+ LONGEST src_row_length = TYPE_LENGTH (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);
-+
-+ /* 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)
-+ slice_type->set_code (array_type->code ());
-+ else
-+ slice_type->set_code ((TYPE_TARGET_TYPE (array_type)->code ()));
-+
-+ v = allocate_value (slice_type);
-+
-+ /* Iterate through the rows of the outer array and set the new offset
-+ for each row. */
-+ for (i = 0; i < row_count; i++)
-+ {
-+ 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;
-+ }
-+ }
- }
-
-- set_value_component_location (slice, array);
-- set_value_offset (slice, value_offset (array) + offset);
-+ set_value_component_location (v, array);
-+ if (VALUE_LVAL (v) == lval_register)
-+ {
-+ VALUE_REGNUM (v) = VALUE_REGNUM (array);
-+ VALUE_NEXT_FRAME_ID (v) = VALUE_NEXT_FRAME_ID (array);
-+ }
-+ set_value_offset (v, value_offset (array) + elt_offs);
- }
-
-- return slice;
-+ return v;
- }
-
- /* See value.h. */
-diff --git a/gdb/value.h b/gdb/value.h
---- a/gdb/value.h
-+++ b/gdb/value.h
-@@ -1144,6 +1144,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, int);
-+
- /* Create a complex number. The type is the complex type; the values
- are cast to the underlying scalar type before the complex number is
- created. */
projects / packages / gdb.git / blobdiff