rpms/gdb
7
0
Fork 0
Code Issues Pull Requests Releases Activity
b774b86094
gdb/gdb-vla-intel-fortran-strides.patch

1788 lines
65 KiB
Diff
Raw Normal View History

RHEL 9.0.0 Alpha bootstrap The content of this branch was automatically imported from Fedora ELN with the following as its source: https://src.fedoraproject.org/rpms/gdb#6aff62077bcb16ebf2ba3c498634bce35eda276b
2020-10-14 22:46:23 +00:00
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;
@@ -1001,7 +1001,8 @@ create_static_range_type (struct type *result_type, struct type *index_type,
high.kind = PROP_CONST;
high.data.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;
}
@@ -1236,6 +1237,7 @@ create_array_type_with_stride (struct type *result_type,
if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
low_bound = high_bound = 0;
element_type = check_typedef (element_type);
+
/* Be careful when setting the array length. Ada arrays can be
empty arrays with the high_bound being smaller than the low_bound.
In such cases, the array length should be zero. */
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -803,7 +803,6 @@ struct main_type
/* * Union member used for range types. */
struct range_bounds *bounds;
-
} flds_bnds;
/* * Slot to point to additional language-specific fields of this
@@ -1365,6 +1364,15 @@ extern bool set_type_align (struct type *, ULONGEST);
#define TYPE_BIT_STRIDE(range_type) \
(TYPE_RANGE_DATA(range_type)->stride.data.const_val \
* (TYPE_RANGE_DATA(range_type)->flag_is_byte_stride ? 8 : 1))
+#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) \
@@ -1400,6 +1408,9 @@ extern bool set_type_align (struct type *, ULONGEST);
TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
#define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
+#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
+ (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0)
+
#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
(TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
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
@@ -1224,13 +1224,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 (NULL_TYPE, 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 (NULL_TYPE, 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);
@@ -1319,7 +1317,7 @@ rust_compute_range (struct type *type, struct value *range,
*low = 0;
*high = 0;
- *kind = BOTH_BOUND_DEFAULT;
+ *kind = SUBARRAY_NONE_BOUND;
if (TYPE_NFIELDS (type) == 0)
return;
@@ -1327,15 +1325,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_NFIELDS (type) > 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))
@@ -1353,7 +1350,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;
@@ -1451,7 +1448,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"));
@@ -1469,7 +1466,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
@@ -32,7 +32,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
@@ -41,7 +42,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)
@@ -49,7 +50,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
@@ -58,7 +60,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
@@ -3797,13 +3797,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 (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
&& TYPE_CODE (array_type) != TYPE_CODE_STRING)
error (_("cannot take slice of non-array"));
@@ -3813,45 +3842,155 @@ value_slice (struct value *array, int lowbound, int length)
if (type_not_associated (array_type))
error (_("array not associated"));
- 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)
+ {
+ 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));
+ }
+
+ /* 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;
- if (lowbound < lowerbound || length < 0
- || lowbound + length - 1 > upperbound)
- error (_("slice out of range"));
+ 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"));
+
+ /* 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 = 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_INDEX_TYPE (TYPE_TARGET_TYPE (array_type));
+ slice_range_size = ary_low_bound + (row_count * elem_count) - 1;
+ 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 (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 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 = create_array_type (NULL,
- element_type,
- slice_range_type);
- TYPE_CODE (slice_type) = TYPE_CODE (array_type);
+ TYPE_CODE (slice_type) = TYPE_CODE (array_type);
- 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)
+ 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);
+
+ /* 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;
}
/* Create a value for a FORTRAN complex number. Currently most of the
diff --git a/gdb/value.h b/gdb/value.h
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -1145,6 +1145,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);
+
extern struct value *value_literal_complex (struct value *, struct value *,
struct type *);
Reference in New Issue Copy Permalink