1 From FEDORA_PATCHES Mon Sep 17 00:00:00 2001
2 From: Fedora GDB patches <invalid@email.com>
3 Date: Fri, 27 Oct 2017 21:07:50 +0200
4 Subject: gdb-vla-intel-fortran-strides.patch
6 ;; VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests.
9 git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides
10 dbfd7140bf4c0500d1f5d192be781f83f78f7922
12 gdb/dwarf2loc.c | 46 ++-
14 gdb/dwarf2read.c | 13 +-
15 gdb/eval.c | 391 +++++++++++++++++++++-----
16 gdb/expprint.c | 20 +-
17 gdb/expression.h | 18 +-
19 gdb/f-valprint.c | 8 +-
20 gdb/gdbtypes.c | 34 ++-
21 gdb/gdbtypes.h | 18 +-
23 gdb/rust-exp.y | 12 +-
24 gdb/rust-lang.c | 17 +-
25 gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++
26 gdb/testsuite/gdb.fortran/static-arrays.f90 | 55 ++++
27 gdb/testsuite/gdb.fortran/vla-ptype.exp | 4 +
28 gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +
29 gdb/testsuite/gdb.fortran/vla-stride.exp | 44 +++
30 gdb/testsuite/gdb.fortran/vla-stride.f90 | 29 ++
31 gdb/testsuite/gdb.fortran/vla.f90 | 10 +
32 gdb/valarith.c | 10 +-
33 gdb/valops.c | 197 +++++++++++--
35 23 files changed, 1242 insertions(+), 183 deletions(-)
37 diff --git a/gdb/eval.c b/gdb/eval.c
40 @@ -372,29 +372,324 @@ init_array_element (struct value *array, struct value *element,
44 +/* Evaluates any operation on Fortran arrays or strings with at least
45 + one user provided parameter. Expects the input ARRAY to be either
46 + an array, or a string. Evaluates EXP by incrementing POS, and
47 + writes the content from the elt stack into a local struct. NARGS
48 + specifies number of literal or range arguments the user provided.
49 + NARGS must be the same number as ARRAY has dimensions. */
52 -value_f90_subarray (struct value *array,
53 - struct expression *exp, int *pos, enum noside noside)
54 +value_f90_subarray (struct value *array, struct expression *exp,
55 + int *pos, int nargs, enum noside noside)
57 - int pc = (*pos) + 1;
58 - LONGEST low_bound, high_bound;
59 - struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
60 - enum range_type range_type
61 - = (enum range_type) longest_to_int (exp->elts[pc].longconst);
65 - if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
66 - low_bound = TYPE_LOW_BOUND (range);
68 - low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
69 + int i, dim_count = 0;
70 + struct value *new_array = array;
71 + struct type *array_type = check_typedef (value_type (new_array));
72 + struct type *elt_type;
76 + enum range_type f90_range_type;
77 + LONGEST low, high, stride;
80 + typedef enum subscript_kind
82 + SUBSCRIPT_RANGE, /* e.g. "(lowbound:highbound)" */
83 + SUBSCRIPT_INDEX /* e.g. "(literal)" */
86 + /* Local struct to hold user data for Fortran subarray dimensions. */
87 + struct subscript_store
89 + /* For every dimension, we are either working on a range or an index
90 + expression, so we store this info separately for later. */
91 + enum subscript_kind kind;
93 + /* We also store either the lower and upper bound info, or the index
94 + number. Before evaluation of the input values, we do not know if we are
95 + actually working on a range of ranges, or an index in a range. So as a
96 + first step we store all input in a union. The array calculation itself
97 + deals with this later on. */
100 + subscript_range range;
103 + } *subscript_array;
105 + /* Check if the number of arguments provided by the user matches
106 + the number of dimension of the array. A string has only one
108 + if (nargs != calc_f77_array_dims (value_type (new_array)))
109 + error (_("Wrong number of subscripts"));
111 + subscript_array = (struct subscript_store*) alloca (sizeof (*subscript_array) * nargs);
113 + /* Parse the user input into the SUBSCRIPT_ARRAY to store it. We need
114 + to evaluate it first, as the input is from left-to-right. The
115 + array is stored from right-to-left. So we have to use the user
116 + input in reverse order. Later on, we need the input information to
117 + re-calculate the output array. For multi-dimensional arrays, we
118 + can be dealing with any possible combination of ranges and indices
119 + for every dimension. */
120 + for (i = 0; i < nargs; i++)
122 + struct subscript_store *index = &subscript_array[i];
124 + /* The user input is a range, with or without lower and upper bound.
125 + E.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc. */
126 + if (exp->elts[*pos].opcode == OP_RANGE)
128 + int pc = (*pos) + 1;
129 + subscript_range *range;
131 + index->kind = SUBSCRIPT_RANGE;
132 + range = &index->U.range;
135 + range->f90_range_type = (enum range_type) exp->elts[pc].longconst;
137 + /* If a lower bound was provided by the user, the bit has been
138 + set and we can assign the value from the elt stack. Same for
140 + if ((range->f90_range_type & SUBARRAY_LOW_BOUND)
141 + == SUBARRAY_LOW_BOUND)
142 + range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp,
144 + if ((range->f90_range_type & SUBARRAY_HIGH_BOUND)
145 + == SUBARRAY_HIGH_BOUND)
146 + range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp,
149 + /* Assign the user's stride value if provided. */
150 + if ((range->f90_range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
151 + range->stride = value_as_long (evaluate_subexp (NULL_TYPE, exp,
154 + /* Assign the default stride value '1'. */
158 - if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
159 - high_bound = TYPE_HIGH_BOUND (range);
161 - high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
162 + /* Check the provided stride value is illegal, aka '0'. */
163 + if (range->stride == 0)
164 + error (_("Stride must not be 0"));
166 + /* User input is an index. E.g.: "p arry(5)". */
171 + index->kind = SUBSCRIPT_INDEX;
173 + /* Evaluate each subscript; it must be a legal integer in F77. This
174 + ensures the validity of the provided index. */
175 + val = evaluate_subexp_with_coercion (exp, pos, noside);
176 + index->U.number = value_as_long (val);
181 + /* Traverse the array from right to left and set the high and low bounds
183 + for (i = nargs - 1; i >= 0; i--)
185 + struct subscript_store *index = &subscript_array[i];
186 + struct type *index_type = TYPE_INDEX_TYPE (array_type);
188 + switch (index->kind)
190 + case SUBSCRIPT_RANGE:
193 + /* When we hit the first range specified by the user, we must
194 + treat any subsequent user entry as a range. We simply
195 + increment DIM_COUNT which tells us how many times we are
196 + calling VALUE_SLICE_1. */
197 + subscript_range *range = &index->U.range;
199 + /* If no lower bound was provided by the user, we take the
200 + default boundary. Same for the high bound. */
201 + if ((range->f90_range_type & SUBARRAY_LOW_BOUND) == 0)
202 + range->low = TYPE_LOW_BOUND (index_type);
204 + if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0)
205 + range->high = TYPE_HIGH_BOUND (index_type);
207 + /* Both user provided low and high bound have to be inside the
208 + array bounds. Throw an error if not. */
209 + if (range->low < TYPE_LOW_BOUND (index_type)
210 + || range->low > TYPE_HIGH_BOUND (index_type)
211 + || range->high < TYPE_LOW_BOUND (index_type)
212 + || range->high > TYPE_HIGH_BOUND (index_type))
213 + error (_("provided bound(s) outside array bound(s)"));
215 + /* For a negative stride the lower boundary must be larger than the
217 + For a positive stride the lower boundary must be smaller than the
219 + if ((range->stride < 0 && range->low < range->high)
220 + || (range->stride > 0 && range->low > range->high))
221 + error (_("Wrong value provided for stride and boundaries"));
226 + case SUBSCRIPT_INDEX:
231 + array_type = TYPE_TARGET_TYPE (array_type);
234 + /* Reset ARRAY_TYPE before slicing.*/
235 + array_type = check_typedef (value_type (new_array));
237 + /* Traverse the array from right to left and evaluate each corresponding
238 + user input. VALUE_SUBSCRIPT is called for every index, until a range
239 + expression is evaluated. After a range expression has been evaluated,
240 + every subsequent expression is also treated as a range. */
241 + for (i = nargs - 1; i >= 0; i--)
243 + struct subscript_store *index = &subscript_array[i];
244 + struct type *index_type = TYPE_INDEX_TYPE (array_type);
246 + switch (index->kind)
248 + case SUBSCRIPT_RANGE:
251 + /* When we hit the first range specified by the user, we must
252 + treat any subsequent user entry as a range. We simply
253 + increment DIM_COUNT which tells us how many times we are
254 + calling VALUE_SLICE_1. */
255 + subscript_range *range = &index->U.range;
257 + /* DIM_COUNT counts every user argument that is treated as a range.
258 + This is necessary for expressions like 'print array(7, 8:9).
259 + Here the first argument is a literal, but must be treated as a
260 + range argument to allow the correct output representation. */
264 + = value_slice_1 (new_array, range->low,
265 + range->high - range->low + 1,
266 + range->stride, dim_count);
270 + case SUBSCRIPT_INDEX:
272 + /* DIM_COUNT only stays '0' when no range argument was processed
273 + before, starting from the last dimension. This way we can
274 + reduce the number of dimensions from the result array.
275 + However, if a range has been processed before an index, we
276 + treat the index like a range with equal low- and high bounds
277 + to get the value offset right. */
278 + if (dim_count == 0)
280 + = value_subscripted_rvalue (new_array, index->U.number,
281 + f77_get_lowerbound (value_type
287 + /* We might end up here, because we have to treat the provided
288 + index like a range. But now VALUE_SUBSCRIPTED_RVALUE
289 + cannot do the range checks for us. So we have to make sure
290 + ourselves that the user provided index is inside the
291 + array bounds. Throw an error if not. */
292 + if (index->U.number < TYPE_LOW_BOUND (index_type)
293 + && index->U.number > TYPE_HIGH_BOUND (index_type))
294 + error (_("provided bound(s) outside array bound(s)"));
296 + if (index->U.number > TYPE_LOW_BOUND (index_type)
297 + && index->U.number > TYPE_HIGH_BOUND (index_type))
298 + error (_("provided bound(s) outside array bound(s)"));
300 + new_array = value_slice_1 (new_array,
302 + 1, /* COUNT is '1' element */
303 + 1, /* STRIDE set to '1' */
310 + array_type = TYPE_TARGET_TYPE (array_type);
313 + /* With DIM_COUNT > 1 we currently have a one dimensional array, but expect
314 + an array of arrays, depending on how many ranges have been provided by
315 + the user. So we need to rebuild the array dimensions for printing it
317 + Starting from right to left in the user input, after we hit the first
318 + range argument every subsequent argument is also treated as a range.
320 + "p ary(3, 7, 2:15)" in Fortran has only 1 dimension, but we calculated 3
322 + "p ary(3, 7:12, 4)" in Fortran has only 1 dimension, but we calculated 2
324 + "p ary(2:4, 5, 7)" in Fortran has only 1 dimension, and we calculated 1
328 + struct value *v = NULL;
330 + elt_type = TYPE_TARGET_TYPE (value_type (new_array));
332 - return value_slice (array, low_bound, high_bound - low_bound + 1);
333 + /* Every SUBSCRIPT_RANGE in the user input signifies an actual range in
334 + the output array. So we traverse the SUBSCRIPT_ARRAY again, looking
335 + for a range entry. When we find one, we use the range info to create
336 + an additional range_type to set the correct bounds and dimensions for
337 + the output array. In addition, we may have a stride value that is not
338 + '1', forcing us to adjust the number of elements in a range, according
339 + to the stride value. */
340 + for (i = 0; i < nargs; i++)
342 + struct subscript_store *index = &subscript_array[i];
344 + if (index->kind == SUBSCRIPT_RANGE)
346 + struct type *range_type, *interim_array_type;
350 + /* The length of a sub-dimension with all elements between the
351 + bounds plus the start element itself. It may be modified by
352 + a user provided stride value. */
353 + new_length = index->U.range.high - index->U.range.low;
355 + new_length /= index->U.range.stride;
358 + = create_static_range_type (NULL,
360 + index->U.range.low,
361 + index->U.range.low + new_length);
363 + interim_array_type = create_array_type (NULL,
367 + TYPE_CODE (interim_array_type)
368 + = TYPE_CODE (value_type (new_array));
370 + v = allocate_value (interim_array_type);
372 + elt_type = value_type (v);
376 + value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (elt_type));
384 @@ -1235,19 +1530,6 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
385 return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
388 -/* Helper for skipping all the arguments in an undetermined argument list.
389 - This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
390 - case of evaluate_subexp_standard as multiple, but not all, code paths
391 - require a generic skip. */
394 -skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
395 - enum noside noside)
397 - for (int i = 0; i < nargs; ++i)
398 - evaluate_subexp (NULL_TYPE, exp, pos, noside);
402 evaluate_subexp_standard (struct type *expect_type,
403 struct expression *exp, int *pos,
404 @@ -1942,33 +2224,8 @@ evaluate_subexp_standard (struct type *expect_type,
407 case TYPE_CODE_ARRAY:
408 - if (exp->elts[*pos].opcode == OP_RANGE)
409 - return value_f90_subarray (arg1, exp, pos, noside);
412 - if (noside == EVAL_SKIP)
414 - skip_undetermined_arglist (nargs, exp, pos, noside);
415 - /* Return the dummy value with the correct type. */
418 - goto multi_f77_subscript;
421 case TYPE_CODE_STRING:
422 - if (exp->elts[*pos].opcode == OP_RANGE)
423 - return value_f90_subarray (arg1, exp, pos, noside);
426 - if (noside == EVAL_SKIP)
428 - skip_undetermined_arglist (nargs, exp, pos, noside);
429 - /* Return the dummy value with the correct type. */
432 - arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
433 - return value_subscript (arg1, value_as_long (arg2));
435 + return value_f90_subarray (arg1, exp, pos, nargs, noside);
439 @@ -2388,49 +2645,6 @@ evaluate_subexp_standard (struct type *expect_type,
443 - multi_f77_subscript:
445 - LONGEST subscript_array[MAX_FORTRAN_DIMS];
446 - int ndimensions = 1, i;
447 - struct value *array = arg1;
449 - if (nargs > MAX_FORTRAN_DIMS)
450 - error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
452 - ndimensions = calc_f77_array_dims (type);
454 - if (nargs != ndimensions)
455 - error (_("Wrong number of subscripts"));
457 - gdb_assert (nargs > 0);
459 - /* Now that we know we have a legal array subscript expression
460 - let us actually find out where this element exists in the array. */
462 - /* Take array indices left to right. */
463 - for (i = 0; i < nargs; i++)
465 - /* Evaluate each subscript; it must be a legal integer in F77. */
466 - arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
468 - /* Fill in the subscript array. */
470 - subscript_array[i] = value_as_long (arg2);
473 - /* Internal type of array is arranged right to left. */
474 - for (i = nargs; i > 0; i--)
476 - struct type *array_type = check_typedef (value_type (array));
477 - LONGEST index = subscript_array[i - 1];
479 - array = value_subscripted_rvalue (array, index,
480 - f77_get_lowerbound (array_type));
486 case BINOP_LOGICAL_AND:
487 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
488 if (noside == EVAL_SKIP)
489 @@ -3350,6 +3564,9 @@ calc_f77_array_dims (struct type *array_type)
491 struct type *tmp_type;
493 + if (TYPE_CODE (array_type) == TYPE_CODE_STRING)
496 if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
497 error (_("Can't get dimensions for a non-array type"));
499 diff --git a/gdb/expprint.c b/gdb/expprint.c
502 @@ -580,17 +580,14 @@ print_subexp_standard (struct expression *exp, int *pos,
503 longest_to_int (exp->elts[pc + 1].longconst);
506 - if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE
507 - || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)
508 + if ((range_type & SUBARRAY_HIGH_BOUND_EXCLUSIVE)
509 + == SUBARRAY_HIGH_BOUND_EXCLUSIVE)
510 fputs_filtered ("EXCLUSIVE_", stream);
511 fputs_filtered ("RANGE(", stream);
512 - if (range_type == HIGH_BOUND_DEFAULT
513 - || range_type == NONE_BOUND_DEFAULT
514 - || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)
515 + if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
516 print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
517 fputs_filtered ("..", stream);
518 - if (range_type == LOW_BOUND_DEFAULT
519 - || range_type == NONE_BOUND_DEFAULT)
520 + if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
521 print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
522 fputs_filtered (")", stream);
524 @@ -1107,22 +1104,24 @@ dump_subexp_body_standard (struct expression *exp,
528 - case BOTH_BOUND_DEFAULT:
529 + case SUBARRAY_NONE_BOUND:
530 fputs_filtered ("Range '..'", stream);
532 - case LOW_BOUND_DEFAULT:
533 + case SUBARRAY_HIGH_BOUND:
534 fputs_filtered ("Range '..EXP'", stream);
536 - case LOW_BOUND_DEFAULT_EXCLUSIVE:
537 - fputs_filtered ("ExclusiveRange '..EXP'", stream);
539 - case HIGH_BOUND_DEFAULT:
540 + case SUBARRAY_LOW_BOUND:
541 fputs_filtered ("Range 'EXP..'", stream);
543 - case NONE_BOUND_DEFAULT:
544 + case (SUBARRAY_LOW_BOUND
545 + | SUBARRAY_HIGH_BOUND
546 + | SUBARRAY_HIGH_BOUND_EXCLUSIVE):
547 + fputs_filtered ("ExclusiveRange '..EXP'", stream);
549 + case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND):
550 fputs_filtered ("Range 'EXP..EXP'", stream);
552 - case NONE_BOUND_DEFAULT_EXCLUSIVE:
553 + case (SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE):
554 fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
557 @@ -1130,11 +1129,9 @@ dump_subexp_body_standard (struct expression *exp,
561 - if (range_type == HIGH_BOUND_DEFAULT
562 - || range_type == NONE_BOUND_DEFAULT)
563 + if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
564 elt = dump_subexp (exp, stream, elt);
565 - if (range_type == LOW_BOUND_DEFAULT
566 - || range_type == NONE_BOUND_DEFAULT)
567 + if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
568 elt = dump_subexp (exp, stream, elt);
571 diff --git a/gdb/expression.h b/gdb/expression.h
572 --- a/gdb/expression.h
573 +++ b/gdb/expression.h
574 @@ -167,28 +167,27 @@ extern void dump_raw_expression (struct expression *,
575 struct ui_file *, const char *);
576 extern void dump_prefix_expression (struct expression *, struct ui_file *);
578 -/* In an OP_RANGE expression, either bound could be empty, indicating
579 - that its value is by default that of the corresponding bound of the
580 - array or string. Also, the upper end of the range can be exclusive
581 - or inclusive. So we have six sorts of subrange. This enumeration
582 - type is to identify this. */
583 +/* In an OP_RANGE expression, either bound can be provided by the
584 + user, or not. In addition to this, the user can also specify a
585 + stride value to indicated only certain elements of the array.
586 + Also, the upper end of the range can be exclusive or inclusive.
587 + This enumeration type is to identify this. */
591 - /* Neither the low nor the high bound was given -- so this refers to
592 - the entire available range. */
593 - BOTH_BOUND_DEFAULT,
594 - /* The low bound was not given and the high bound is inclusive. */
596 - /* The high bound was not given and the low bound in inclusive. */
597 - HIGH_BOUND_DEFAULT,
598 - /* Both bounds were given and both are inclusive. */
599 - NONE_BOUND_DEFAULT,
600 - /* The low bound was not given and the high bound is exclusive. */
601 - NONE_BOUND_DEFAULT_EXCLUSIVE,
602 - /* Both bounds were given. The low bound is inclusive and the high
603 - bound is exclusive. */
604 - LOW_BOUND_DEFAULT_EXCLUSIVE,
607 + SUBARRAY_NONE_BOUND = 0x0, /* "( : )" */
608 + SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */
609 + SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */
610 + SUBARRAY_STRIDE = 0x4, /* "(::stride)" */
611 + /* The low bound was not given and the high bound is exclusive.
612 + In this case we always use (SUBARRAY_HIGH_BOUND |
613 + SUBARRAY_HIGH_BOUND_EXCLUSIVE). */
614 + SUBARRAY_HIGH_BOUND_EXCLUSIVE = 0x8,
615 + /* Both bounds were given. The low bound is inclusive and the high
616 + bound is exclusive. In this case, we use (SUBARRAY_LOW_BOUND |
617 + SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE). */
618 + // SUBARRAY_LOW_BOUND_EXCLUSIVE = (SUBARRAY_LOW_BOUND
619 + // | SUBARRAY_HIGH_BOUND_EXCLUSIVE),
622 #endif /* !defined (EXPRESSION_H) */
623 diff --git a/gdb/f-exp.y b/gdb/f-exp.y
626 @@ -282,31 +282,63 @@ arglist : subrange
628 arglist : arglist ',' exp %prec ABOVE_COMMA
629 { pstate->arglist_len++; }
630 + | arglist ',' subrange %prec ABOVE_COMMA
631 + { pstate->arglist_len++; }
634 /* There are four sorts of subrange types in F90. */
636 subrange: exp ':' exp %prec ABOVE_COMMA
637 - { write_exp_elt_opcode (pstate, OP_RANGE);
638 - write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
639 + { write_exp_elt_opcode (pstate, OP_RANGE);
640 + write_exp_elt_longcst (pstate,
641 + SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND);
642 write_exp_elt_opcode (pstate, OP_RANGE); }
645 subrange: exp ':' %prec ABOVE_COMMA
646 { write_exp_elt_opcode (pstate, OP_RANGE);
647 - write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
648 + write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND);
649 write_exp_elt_opcode (pstate, OP_RANGE); }
652 subrange: ':' exp %prec ABOVE_COMMA
653 { write_exp_elt_opcode (pstate, OP_RANGE);
654 - write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
655 + write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND);
656 write_exp_elt_opcode (pstate, OP_RANGE); }
659 subrange: ':' %prec ABOVE_COMMA
660 { write_exp_elt_opcode (pstate, OP_RANGE);
661 - write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
662 + write_exp_elt_longcst (pstate, SUBARRAY_NONE_BOUND);
663 + write_exp_elt_opcode (pstate, OP_RANGE); }
666 +/* Each subrange type can have a stride argument. */
667 +subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
668 + { write_exp_elt_opcode (pstate, OP_RANGE);
669 + write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
670 + | SUBARRAY_HIGH_BOUND
671 + | SUBARRAY_STRIDE);
672 + write_exp_elt_opcode (pstate, OP_RANGE); }
675 +subrange: exp ':' ':' exp %prec ABOVE_COMMA
676 + { write_exp_elt_opcode (pstate, OP_RANGE);
677 + write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
678 + | SUBARRAY_STRIDE);
679 + write_exp_elt_opcode (pstate, OP_RANGE); }
682 +subrange: ':' exp ':' exp %prec ABOVE_COMMA
683 + { write_exp_elt_opcode (pstate, OP_RANGE);
684 + write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND
685 + | SUBARRAY_STRIDE);
686 + write_exp_elt_opcode (pstate, OP_RANGE); }
689 +subrange: ':' ':' exp %prec ABOVE_COMMA
690 + { write_exp_elt_opcode (pstate, OP_RANGE);
691 + write_exp_elt_longcst (pstate, SUBARRAY_STRIDE);
692 write_exp_elt_opcode (pstate, OP_RANGE); }
695 diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
696 --- a/gdb/f-valprint.c
697 +++ b/gdb/f-valprint.c
698 @@ -129,6 +129,11 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
699 byte_stride = dim_size;
703 + dim_size = byte_stride;
705 + dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
708 (i < upperbound + 1 && (*elts) < options->print_max);
710 diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
713 @@ -936,7 +936,7 @@ create_range_type (struct type *result_type, struct type *index_type,
714 TYPE_RANGE_DATA (result_type)->high = *high_bound;
715 TYPE_RANGE_DATA (result_type)->bias = bias;
717 - /* Initialize the stride to be a constant, the value will already be zero
718 + /* bias the stride to be a constant, the value will already be zero
719 thanks to the use of TYPE_ZALLOC above. */
720 TYPE_RANGE_DATA (result_type)->stride.kind = PROP_CONST;
722 @@ -1001,7 +1001,8 @@ create_static_range_type (struct type *result_type, struct type *index_type,
723 high.kind = PROP_CONST;
724 high.data.const_val = high_bound;
726 - result_type = create_range_type (result_type, index_type, &low, &high, 0);
727 + result_type = create_range_type (result_type, index_type,
732 @@ -1236,6 +1237,7 @@ create_array_type_with_stride (struct type *result_type,
733 if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
734 low_bound = high_bound = 0;
735 element_type = check_typedef (element_type);
737 /* Be careful when setting the array length. Ada arrays can be
738 empty arrays with the high_bound being smaller than the low_bound.
739 In such cases, the array length should be zero. */
740 diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
743 @@ -803,7 +803,6 @@ struct main_type
744 /* * Union member used for range types. */
746 struct range_bounds *bounds;
750 /* * Slot to point to additional language-specific fields of this
751 @@ -1365,6 +1364,15 @@ extern bool set_type_align (struct type *, ULONGEST);
752 #define TYPE_BIT_STRIDE(range_type) \
753 (TYPE_RANGE_DATA(range_type)->stride.data.const_val \
754 * (TYPE_RANGE_DATA(range_type)->flag_is_byte_stride ? 8 : 1))
755 +#define TYPE_BYTE_STRIDE(range_type) \
756 + TYPE_RANGE_DATA(range_type)->stride.data.const_val
757 +#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
758 + TYPE_RANGE_DATA(range_type)->stride.data.locexpr
759 +#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
760 + TYPE_RANGE_DATA(range_type)->stride.data.loclist
761 +#define TYPE_BYTE_STRIDE_KIND(range_type) \
762 + TYPE_RANGE_DATA(range_type)->stride.kind
765 /* Property accessors for the type data location. */
766 #define TYPE_DATA_LOCATION(thistype) \
767 @@ -1400,6 +1408,9 @@ extern bool set_type_align (struct type *, ULONGEST);
768 TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
769 #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
770 TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
771 +#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
772 + (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0)
775 #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
776 (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
777 diff --git a/gdb/parse.c b/gdb/parse.c
780 @@ -919,24 +919,20 @@ operator_length_standard (const struct expression *expr, int endpos,
785 range_type = (enum range_type)
786 longest_to_int (expr->elts[endpos - 2].longconst);
788 - switch (range_type)
790 - case LOW_BOUND_DEFAULT:
791 - case LOW_BOUND_DEFAULT_EXCLUSIVE:
792 - case HIGH_BOUND_DEFAULT:
795 - case BOTH_BOUND_DEFAULT:
798 - case NONE_BOUND_DEFAULT:
799 - case NONE_BOUND_DEFAULT_EXCLUSIVE:
803 + /* Increment the argument counter for each argument
804 + provided by the user. */
805 + if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
808 + if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
811 + if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
816 diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
819 @@ -2492,24 +2492,28 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
823 - enum range_type kind = BOTH_BOUND_DEFAULT;
824 + enum range_type kind = SUBARRAY_NONE_BOUND;
826 if (operation->left.op != NULL)
828 convert_ast_to_expression (operation->left.op, top);
829 - kind = HIGH_BOUND_DEFAULT;
830 + kind = SUBARRAY_LOW_BOUND;
832 if (operation->right.op != NULL)
834 convert_ast_to_expression (operation->right.op, top);
835 - if (kind == BOTH_BOUND_DEFAULT)
836 - kind = (operation->inclusive
837 - ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE);
838 + if (kind == SUBARRAY_NONE_BOUND)
840 + kind = (range_type) SUBARRAY_HIGH_BOUND;
841 + if (!operation->inclusive)
842 + kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE);
846 - gdb_assert (kind == HIGH_BOUND_DEFAULT);
847 - kind = (operation->inclusive
848 - ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE);
849 + gdb_assert (kind == SUBARRAY_LOW_BOUND);
850 + kind = (range_type) (kind | SUBARRAY_HIGH_BOUND);
851 + if (!operation->inclusive)
852 + kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE);
856 diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
857 --- a/gdb/rust-lang.c
858 +++ b/gdb/rust-lang.c
859 @@ -1224,13 +1224,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
860 kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
863 - if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT
864 - || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
865 + if ((kind & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
866 low = evaluate_subexp (NULL_TYPE, exp, pos, noside);
867 - if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE
868 - || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
869 + if ((kind & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
870 high = evaluate_subexp (NULL_TYPE, exp, pos, noside);
871 - bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT);
872 + bool inclusive = (!((kind & SUBARRAY_HIGH_BOUND_EXCLUSIVE) == SUBARRAY_HIGH_BOUND_EXCLUSIVE));
874 if (noside == EVAL_SKIP)
875 return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
876 @@ -1319,7 +1317,7 @@ rust_compute_range (struct type *type, struct value *range,
880 - *kind = BOTH_BOUND_DEFAULT;
881 + *kind = SUBARRAY_NONE_BOUND;
883 if (TYPE_NFIELDS (type) == 0)
885 @@ -1327,15 +1325,14 @@ rust_compute_range (struct type *type, struct value *range,
887 if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0)
889 - *kind = HIGH_BOUND_DEFAULT;
890 + *kind = SUBARRAY_LOW_BOUND;
891 *low = value_as_long (value_field (range, 0));
894 if (TYPE_NFIELDS (type) > i
895 && strcmp (TYPE_FIELD_NAME (type, i), "end") == 0)
897 - *kind = (*kind == BOTH_BOUND_DEFAULT
898 - ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
899 + *kind = (range_type) (*kind | SUBARRAY_HIGH_BOUND);
900 *high = value_as_long (value_field (range, i));
902 if (rust_inclusive_range_type_p (type))
903 @@ -1353,7 +1350,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
904 struct type *rhstype;
905 LONGEST low, high_bound;
906 /* Initialized to appease the compiler. */
907 - enum range_type kind = BOTH_BOUND_DEFAULT;
908 + enum range_type kind = SUBARRAY_NONE_BOUND;
912 @@ -1451,7 +1448,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
913 error (_("Cannot subscript non-array type"));
916 - && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT))
917 + && ((kind & SUBARRAY_LOW_BOUND) != SUBARRAY_LOW_BOUND))
920 error (_("Index less than zero"));
921 @@ -1469,7 +1466,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
923 struct value *addrval, *tem;
925 - if (kind == BOTH_BOUND_DEFAULT || kind == HIGH_BOUND_DEFAULT)
926 + if ((kind & SUBARRAY_HIGH_BOUND) != SUBARRAY_HIGH_BOUND)
929 error (_("High index less than zero"));
930 diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp
933 +++ b/gdb/testsuite/gdb.fortran/static-arrays.exp
935 +# Copyright 2015 Free Software Foundation, Inc.
937 +# Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
939 +# This program is free software; you can redistribute it and/or modify
940 +# it under the terms of the GNU General Public License as published by
941 +# the Free Software Foundation; either version 3 of the License, or
942 +# (at your option) any later version.
944 +# This program is distributed in the hope that it will be useful,
945 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
946 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
947 +# GNU General Public License for more details.
949 +# You should have received a copy of the GNU General Public License
950 +# along with this program. If not, see <http://www.gnu.org/licenses/>.
952 +standard_testfile static-arrays.f90
954 +if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } {
958 +if ![runto MAIN__] then {
959 + perror "couldn't run to breakpoint MAIN__"
963 +gdb_breakpoint [gdb_get_line_number "BP1"]
964 +gdb_continue_to_breakpoint "BP1" ".*BP1.*"
966 +# Tests subarrays of one dimensional arrays with subrange variations
967 +gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \
969 +gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \
971 +gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \
973 +gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \
975 +gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \
979 +gdb_test_no_output "set \$my_ary = ar1\(3:8\)"
980 +gdb_test "print \$my_ary" \
981 + "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \
982 + "Assignment of subarray to variable"
983 +gdb_test_no_output "set ar1\(5\) = 42"
984 + gdb_test "print ar1\(3:8\)" \
985 + "\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \
986 + "print ar1\(3:8\) after assignment"
987 +gdb_test "print \$my_ary" \
988 + "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \
989 + "Assignment of subarray to variable after original array changed"
991 +# Test for subarrays of one dimensional arrays with literals
992 + gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \
995 +# Tests for subranges of 2 dimensional arrays with subrange variations
996 +gdb_test "print ar2\(2:3, 3:4\)" \
997 + "\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \
998 + "print ar2\(2:3, 3:4\)."
999 +gdb_test "print ar2\(8:9,8:\)" \
1000 + "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
1001 + "print ar2\(8:9,8:\)"
1002 +gdb_test "print ar2\(8:9,:2\)" \
1003 + "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \
1004 + "print ar2\(8:9,:2\)"
1006 +gdb_test "print ar2\(8:,8:9\)" \
1007 + "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
1008 + "print ar2\(8:,8:9\)"
1009 +gdb_test "print ar2\(8:,8:\)" \
1010 + "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
1011 + "print ar2\(8:,8:\)"
1012 +gdb_test "print ar2\(8:,:2\)" \
1013 + "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \
1014 + "print ar2\(8:,:2\)"
1016 +gdb_test "print ar2\(:2,2:3\)" \
1017 + "\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \
1018 + "print ar2\(:2,2:3\)"
1019 +gdb_test "print ar2\(:2,8:\)" \
1020 + "\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \
1021 + "print ar2\(:2,8:\)"
1022 +gdb_test "print ar2\(:2,:2\)" \
1023 + "\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \
1024 + "print ar2\(:2,:2\)"
1026 +# Test subranges of 2 dimensional arrays with literals and subrange variations
1027 +gdb_test "print ar2\(7, 3:6\)" \
1028 + "\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \
1029 + "print ar2\(7, 3:6\)"
1030 +gdb_test "print ar2\(7,8:\)" \
1031 + "\\$\[0-9\]+ = \\(78, 79\\)" \
1032 + "print ar2\(7,8:\)"
1033 +gdb_test "print ar2\(7,:2\)" \
1034 + "\\$\[0-9\]+ = \\(71, 72\\)" \
1035 + "print ar2\(7,:2\)"
1037 +gdb_test "print ar2\(7:8,4\)" \
1038 + "\\$\[0-9\]+ = \\(74, 84\\)" \
1039 + "print ar2(7:8,4\)"
1040 +gdb_test "print ar2\(8:,4\)" \
1041 + "\\$\[0-9\]+ = \\(84, 94\\)" \
1042 + "print ar2\(8:,4\)"
1043 +gdb_test "print ar2\(:2,4\)" \
1044 + "\\$\[0-9\]+ = \\(14, 24\\)" \
1045 + "print ar2\(:2,4\)"
1046 +gdb_test "print ar2\(3,4\)" \
1047 + "\\$\[0-9\]+ = 34" \
1048 + "print ar2\(3,4\)"
1050 +# Test subarrays of 3 dimensional arrays with literals and subrange variations
1051 +gdb_test "print ar3\(2:4,3:4,7:8\)" \
1052 + "\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\)\
1053 + \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \
1054 + "print ar3\(2:4,3:4,7:8\)"
1055 +gdb_test "print ar3\(2:3,4:5,8:\)" \
1056 + "\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\(\
1057 + \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \
1058 + "print ar3\(2:3,4:5,8:\)"
1059 +gdb_test "print ar3\(2:3,4:5,:2\)" \
1060 + "\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\(\
1061 + \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \
1062 + "print ar3\(2:3,4:5,:2\)"
1064 +gdb_test "print ar3\(2:3,8:,7:8\)" \
1065 + "\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\(\
1066 + \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \
1067 + "print ar3\(2:3,8:,7:8\)"
1068 +gdb_test "print ar3\(2:3,8:,8:\)" \
1069 + "\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\(\
1070 + \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \
1071 + "print ar3\(2:3,8:,8:\)"
1072 +gdb_test "print ar3\(2:3,8:,:2\)" \
1073 + "\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\(\
1074 + \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \
1075 + "print ar3\(2:3,8:,:2\)"
1077 +gdb_test "print ar3\(2:3,:2,7:8\)" \
1078 + "\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\(\
1079 + \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \
1080 + "print ar3\(2:3,:2,7:8\)"
1081 +gdb_test "print ar3\(2:3,:2,8:\)" \
1082 + "\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\(\
1083 + \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \
1084 + "print ar3\(2:3,:2,8:\)"
1085 +gdb_test "print ar3\(2:3,:2,:2\)" \
1086 + "\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\(\
1087 + \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \
1088 + "print ar3\(2:3,:2,:2\)"
1090 +gdb_test "print ar3\(8:,3:4,7:8\)" \
1091 + "\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\(\
1092 + \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \
1093 + "print ar3\(8:,3:4,7:8\)"
1094 +gdb_test "print ar3\(8:,4:5,8:\)" \
1095 + "\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\(\
1096 + \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \
1097 + "print ar3\(8:,4:5,8:\)"
1098 +gdb_test "print ar3\(8:,4:5,:2\)" \
1099 + "\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\(\
1100 + \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \
1101 + "print ar3\(8:,4:5,:2\)"
1103 +gdb_test "print ar3\(8:,8:,7:8\)" \
1104 + "\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\(\
1105 + \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \
1106 + "print ar3\(8:,8:,7:8\)"
1107 +gdb_test "print ar3\(8:,8:,8:\)" \
1108 + "\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\(\
1109 + \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \
1110 + "print ar3\(8:,8:,8:\)"
1111 +gdb_test "print ar3\(8:,8:,:2\)" \
1112 + "\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\(\
1113 + \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \
1114 + "print ar3\(8:,8:,:2\)"
1116 +gdb_test "print ar3\(8:,:2,7:8\)" \
1117 + "\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\(\
1118 + \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \
1119 + "print ar3\(8:,:2,7:8\)"
1120 +gdb_test "print ar3\(8:,:2,8:\)" \
1121 + "\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\(\
1122 + \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \
1123 + "print ar3\(8:,:2,8:\)"
1124 +gdb_test "print ar3\(8:,:2,:2\)" \
1125 + "\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\(\
1126 + \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \
1127 + "print ar3\(8:,:2,:2\)"
1130 +gdb_test "print ar3\(:2,3:4,7:8\)" \
1131 + "\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\(\
1132 + \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \
1133 + "print ar3 \(:2,3:4,7:8\)."
1134 +gdb_test "print ar3\(:2,3:4,8:\)" \
1135 + "\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\(\
1136 + \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \
1137 + "print ar3\(:2,3:4,8:\)"
1138 +gdb_test "print ar3\(:2,3:4,:2\)" \
1139 + "\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\(\
1140 + \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \
1141 + "print ar3\(:2,3:4,:2\)"
1143 +gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\(\
1144 + 197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \
1145 + "print ar3\(:2,8:,7:8\)"
1146 +gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198,\
1147 + 298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \
1148 + "print ar3\(:2,8:,8:\)"
1149 +gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191,\
1150 + 291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \
1151 + "print ar3\(:2,8:,:2\)"
1153 +gdb_test "print ar3\(:2,:2,7:8\)" \
1154 + "\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\(\
1155 + \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \
1156 + "print ar3\(:2,:2,7:8\)"
1157 +gdb_test "print ar3\(:2,:2,8:\)" \
1158 + "\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\(\
1159 + \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \
1160 + "print ar3\(:2,:2,8:\)"
1161 +gdb_test "print ar3\(:2,:2,:2\)" \
1162 + "\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\(\
1163 + \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \
1164 + "print ar3\(:2,:2,:2\)"
1166 +#Tests for subarrays of 3 dimensional arrays with literals and subranges
1167 +gdb_test "print ar3\(3,3:4,7:8\)" \
1168 + "\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \
1169 + "print ar3\(3,3:4,7:8\)"
1170 +gdb_test "print ar3\(3,4:5,8:\)" \
1171 + "\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \
1172 + "print ar3\(3,4:5,8:\)"
1173 +gdb_test "print ar3\(3,4:5,:2\)" \
1174 + "\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \
1175 + "print ar3\(3,4:5,:2\)"
1176 +gdb_test "print ar3\(3,4:5,3\)" \
1177 + "\\$\[0-9\]+ = \\(343, 353\\)" \
1178 + "print ar3\(3,4:5,3\)"
1180 +gdb_test "print ar3\(2,8:,7:8\)" \
1181 + "\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \
1182 + "print ar3\(2,8:,7:8\)"
1183 +gdb_test "print ar3\(2,8:,8:\)" \
1184 + "\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \
1185 + "print ar3\(2,8:,8:\)"
1186 +gdb_test "print ar3\(2,8:,:2\)"\
1187 + "\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \
1188 + "print ar3\(2,8:,:2\)"
1189 +gdb_test "print ar3\(2,8:,3\)" \
1190 + "\\$\[0-9\]+ = \\(283, 293\\)" \
1191 + "print ar3\(2,8:,3\)"
1193 +gdb_test "print ar3\(2,:2,7:8\)" \
1194 + "\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \
1195 + "print ar3\(2,:2,7:8\)"
1196 +gdb_test "print ar3\(2,:2,8:\)" \
1197 + "\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \
1198 + "print ar3\(2,:2,8:\)"
1199 +gdb_test "print ar3\(2,:2,:2\)" \
1200 + "\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \
1201 + "print ar3\(2,:2,:2\)"
1202 +gdb_test "print ar3\(2,:2,3\)" \
1203 + "\\$\[0-9\]+ = \\(213, 223\\)" \
1204 + "print ar3\(2,:2,3\)"
1206 +gdb_test "print ar3\(3,4,7:8\)" \
1207 + "\\$\[0-9\]+ = \\(347, 348\\)" \
1208 + "print ar3\(3,4,7:8\)"
1209 +gdb_test "print ar3\(3,4,8:\)" \
1210 + "\\$\[0-9\]+ = \\(348, 349\\)" \
1211 +i "print ar3\(3,4,8:\)"
1212 +gdb_test "print ar3\(3,4,:2\)" \
1213 + "\\$\[0-9\]+ = \\(341, 342\\)" \
1214 + "print ar3\(3,4,:2\)"
1215 +gdb_test "print ar3\(5,6,7\)" \
1216 + "\\$\[0-9\]+ = 567" \
1217 + "print ar3\(5,6,7\)"
1219 +gdb_test "print ar3\(3:4,6,7:8\)" \
1220 + "\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \
1221 + "print ar3\(3:4,6,7:8\)"
1222 +gdb_test "print ar3\(3:4,6,8:\)" \
1223 + "\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \
1224 + "print ar3\(3:4,6,8:\)"
1225 +gdb_test "print ar3\(3:4,6,:2\)" \
1226 + "\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \
1227 + "print ar3\(3:4,6,:2\)"
1228 +gdb_test "print ar3\(3:4,6,5\)" \
1229 + "\\$\[0-9\]+ = \\(365, 465\\)" \
1230 + "print ar3\(3:4,6,5\)"
1232 +gdb_test "print ar3\(8:,6,7:8\)" \
1233 + "\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \
1234 + "print ar3\(8:,6,7:8\)"
1235 +gdb_test "print ar3\(8:,6,8:\)" \
1236 + "\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \
1237 + "print ar3\(8:,6,8:\)"
1238 +gdb_test "print ar3\(8:,6,:2\)" \
1239 + "\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \
1240 + "print ar3\(8:,6,:2\)"
1241 +gdb_test "print ar3\(8:,6,5\)" \
1242 + "\\$\[0-9\]+ = \\(865, 965\\)" \
1243 + "print ar3\(8:,6,5\)"
1245 +gdb_test "print ar3\(:2,6,7:8\)" \
1246 + "\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \
1247 + "print ar3\(:2,6,7:8\)"
1248 +gdb_test "print ar3\(:2,6,8:\)" \
1249 + "\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \
1250 + "print ar3\(:2,6,8:\)"
1251 +gdb_test "print ar3\(:2,6,:2\)" \
1252 + "\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \
1253 + "print ar3\(:2,6,:2\)"
1254 +gdb_test "print ar3\(:2,6,5\)" \
1255 + "\\$\[0-9\]+ = \\(165, 265\\)" \
1256 + "print ar3\(:2,6,5\)"
1258 +gdb_test "print ar3\(3:4,5:6,4\)" \
1259 + "\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \
1260 + "print ar2\(3:4,5:6,4\)"
1261 +gdb_test "print ar3\(8:,5:6,4\)" \
1262 + "\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \
1263 + "print ar2\(8:,5:6,4\)"
1264 +gdb_test "print ar3\(:2,5:6,4\)" \
1265 + "\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \
1266 + "print ar2\(:2,5:6,4\)"
1269 +gdb_test "print ar1\(2:6:2\)" \
1270 + "\\$\[0-9\]+ = \\(2, 4, 6\\)" \
1271 + "print ar1\(2:6:2\)"
1272 +gdb_test "print ar2\(2:6:2,3:4\)" \
1273 + "\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \
1274 + "print ar2\(2:6:2,3:4\)"
1275 +gdb_test "print ar2\(2:6:2,3\)" \
1276 + "\\$\[0-9\]+ = \\(23, 43, 63\\)" \
1277 + "print ar2\(2:6:2,3\)"
1278 +gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \
1279 + "\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\)\
1280 + \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \
1281 + "print ar3\(2:6:2,3:5:2,4:7:3\)"
1282 +gdb_test "print ar3\(2:6:2,5,4:7:3\)" \
1283 + "\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\)\
1285 + "print ar3\(2:6:2,5,4:7:3\)"
1288 +gdb_test "print ar1\(8:2:-2\)" \
1289 + "\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \
1290 + "print ar1\(8:2:-2\)"
1291 +gdb_test "print ar2\(8:2:-2,3:4\)" \
1292 + "\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\)\
1294 + "print ar2\(8:2:-2,3:4\)"
1295 +gdb_test "print ar2\(2:6:2,3\)" \
1296 + "\\$\[0-9\]+ = \\(23, 43, 63\\)" \
1297 + "print ar2\(2:6:2,3\)"
1298 +gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \
1299 + "\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\(\
1300 + \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \
1301 + "print ar3\(2:3,7:3:-4,4:7:3\)"
1302 +gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \
1303 + "\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\)\
1305 + "print ar3\(2:6:2,5,7:4:-3\)"
1307 +# Tests with negative and mixed indices
1308 +gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \
1309 + "\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\)\
1310 + \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262,\
1311 + 362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292,\
1312 + 392, 492\\) \\) \\)" \
1313 + "print ar4(2:4, -2:1, -15:-14)"
1315 +gdb_test "p ar4\(7,-6:2:3,-7\)" \
1316 + "\\$\[0-9\]+ = \\(729, 759, 789\\)" \
1317 + "print ar4(7,-6:2:3,-7)"
1319 +gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \
1320 + "\\$\[0-9\]+ = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760,\
1321 + 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727,\
1322 + 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587,\
1323 + 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554,\
1324 + 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521,\
1325 + 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\)\
1327 + "print ar4(9:2:-2, -6:2:3, -6:-15:-3)"
1329 +gdb_test "p ar4\(:,:,:\)" \
1330 + "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711,\
1332 + "print ar4(:,:,:)"
1334 +# Provoke error messages for bad user input
1335 +gdb_test "print ar1\(0:4\)" \
1336 + "provided bound\\(s\\) outside array bound\\(s\\)" \
1337 + "print ar1\(0:4\)"
1338 +gdb_test "print ar1\(8:12\)" \
1339 + "provided bound\\(s\\) outside array bound\\(s\\)" \
1340 + "print ar1\(8:12\)"
1341 +gdb_test "print ar1\(8:2:\)" \
1342 + "A syntax error in expression, near `\\)'." \
1343 + "print ar1\(8:2:\)"
1344 +gdb_test "print ar1\(8:2:2\)" \
1345 + "Wrong value provided for stride and boundaries" \
1346 + "print ar1\(8:2:2\)"
1347 +gdb_test "print ar1\(2:8:-2\)" \
1348 + "Wrong value provided for stride and boundaries" \
1349 + "print ar1\(2:8:-2\)"
1350 +gdb_test "print ar1\(2:7:0\)" \
1351 + "Stride must not be 0" \
1352 + "print ar1\(2:7:0\)"
1353 +gdb_test "print ar1\(3:7\) = 42" \
1355 + "Assignment of value to subarray"
1356 diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90
1357 new file mode 100644
1359 +++ b/gdb/testsuite/gdb.fortran/static-arrays.f90
1361 +! Copyright 2015 Free Software Foundation, Inc.
1363 +! Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
1365 +! This program is free software; you can redistribute it and/or modify
1366 +! it under the terms of the GNU General Public License as published by
1367 +! the Free Software Foundation; either version 3 of the License, or
1368 +! (at your option) any later version.
1370 +! This program is distributed in the hope that it will be useful,
1371 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
1372 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1373 +! GNU General Public License for more details.
1375 +! You should have received a copy of the GNU General Public License
1376 +! along with this program. If not, see <http://www.gnu.org/licenses/>.
1379 + integer, dimension(9) :: ar1
1380 + integer, dimension(9,9) :: ar2
1381 + integer, dimension(9,9,9) :: ar3
1382 + integer, dimension(10,-7:3, -15:-5) :: ar4
1390 + ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...)))
1394 + ar2(i,j) = i*10 + j
1396 + ar3(i,j,k) = i*100 + j*10 + k
1404 + ar4(i,j,k) = i*100 + (j+8)*10 + (k+16)
1416 diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
1417 --- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
1418 +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
1419 @@ -32,7 +32,8 @@ gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1"
1420 gdb_test "print sizeof(vla1(3,2,1))" \
1421 "no such vector element \\(vector not allocated\\)" \
1422 "print sizeof non-allocated indexed vla1"
1423 -gdb_test "print sizeof(vla1(3:4,2,1))" "array not allocated" \
1424 +gdb_test "print sizeof(vla1(3:4,2,1))" \
1425 + "provided bound\\(s\\) outside array bound\\(s\\)" \
1426 "print sizeof non-allocated sliced vla1"
1428 # Try to access value in allocated VLA
1429 @@ -41,7 +42,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
1430 gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
1431 gdb_test "print sizeof(vla1(3,2,1))" "4" \
1432 "print sizeof element from allocated vla1"
1433 -gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
1434 +gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
1435 "print sizeof sliced vla1"
1437 # Try to access values in undefined pointer to VLA (dangling)
1438 @@ -49,7 +50,8 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
1439 gdb_test "print sizeof(pvla(3,2,1))" \
1440 "no such vector element \\(vector not associated\\)" \
1441 "print sizeof non-associated indexed pvla"
1442 -gdb_test "print sizeof(pvla(3:4,2,1))" "array not associated" \
1443 +gdb_test "print sizeof(pvla(3:4,2,1))" \
1444 + "provided bound\\(s\\) outside array bound\\(s\\)" \
1445 "print sizeof non-associated sliced pvla"
1447 # Try to access values in pointer to VLA and compare them
1448 @@ -58,7 +60,8 @@ gdb_continue_to_breakpoint "pvla-associated"
1449 gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
1450 gdb_test "print sizeof(pvla(3,2,1))" "4" \
1451 "print sizeof element from associated pvla"
1452 -gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
1454 +gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
1456 gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
1457 gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
1458 diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
1459 new file mode 100644
1461 +++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
1463 +# Copyright 2016 Free Software Foundation, Inc.
1465 +# This program is free software; you can redistribute it and/or modify
1466 +# it under the terms of the GNU General Public License as published by
1467 +# the Free Software Foundation; either version 3 of the License, or
1468 +# (at your option) any later version.
1470 +# This program is distributed in the hope that it will be useful,
1471 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1472 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1473 +# GNU General Public License for more details.
1475 +# You should have received a copy of the GNU General Public License
1476 +# along with this program. If not, see <http://www.gnu.org/licenses/>.
1478 +standard_testfile ".f90"
1480 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1481 + {debug f90 quiet}] } {
1485 +if ![runto MAIN__] then {
1486 + perror "couldn't run to breakpoint MAIN__"
1490 +gdb_test_no_output "set max-value-size unlimited" \
1491 + "set max-value-size to unlimited"
1493 +gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
1494 +gdb_continue_to_breakpoint "re-reverse-elements"
1495 +gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
1496 + "print re-reverse-elements"
1497 +gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
1498 +gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
1500 +gdb_breakpoint [gdb_get_line_number "odd-elements"]
1501 +gdb_continue_to_breakpoint "odd-elements"
1502 +gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
1503 +gdb_test "print pvla(1)" " = 1" "print first odd-element"
1504 +gdb_test "print pvla(5)" " = 9" "print last odd-element"
1506 +gdb_breakpoint [gdb_get_line_number "single-element"]
1507 +gdb_continue_to_breakpoint "single-element"
1508 +gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
1509 +gdb_test "print pvla(1)" " = 5" "print one single-element"
1510 diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
1511 new file mode 100644
1513 +++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
1515 +! Copyright 2016 Free Software Foundation, Inc.
1517 +! This program is free software; you can redistribute it and/or modify
1518 +! it under the terms of the GNU General Public License as published by
1519 +! the Free Software Foundation; either version 3 of the License, or
1520 +! (at your option) any later version.
1522 +! This program is distributed in the hope that it will be useful,
1523 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
1524 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1525 +! GNU General Public License for more details.
1527 +! You should have received a copy of the GNU General Public License
1528 +! along with this program. If not, see <http://www.gnu.org/licenses/>.
1531 + integer, target, allocatable :: vla (:)
1532 + integer, pointer :: pvla (:)
1535 + vla = (/ (I, I = 1,10) /)
1537 + pvla => vla(10:1:-1)
1538 + pvla => pvla(10:1:-1)
1539 + pvla => vla(1:10:2) ! re-reverse-elements
1540 + pvla => vla(5:4:-2) ! odd-elements
1542 + pvla => null() ! single-element
1543 +end program vla_stride
1544 diff --git a/gdb/valops.c b/gdb/valops.c
1547 @@ -3797,13 +3797,42 @@ value_of_this_silent (const struct language_defn *lang)
1550 value_slice (struct value *array, int lowbound, int length)
1552 + /* Pass unaltered arguments to VALUE_SLICE_1, plus a default stride
1553 + value of '1', which returns every element between LOWBOUND and
1554 + (LOWBOUND + LENGTH). We also provide a default CALL_COUNT of '1'
1555 + as we are only considering the highest dimension, or we are
1556 + working on a one dimensional array. So we call VALUE_SLICE_1
1558 + return value_slice_1 (array, lowbound, length, 1, 1);
1561 +/* VALUE_SLICE_1 is called for each array dimension to calculate the number
1562 + of elements as defined by the subscript expression.
1563 + CALL_COUNT is used to determine if we are calling the function once, e.g.
1564 + we are working on the current dimension of ARRAY, or if we are calling
1565 + the function repeatedly. In the later case we need to take elements
1566 + from the TARGET_TYPE of ARRAY.
1567 + With a CALL_COUNT greater than 1 we calculate the offsets for every element
1568 + that should be in the result array. Then we fetch the contents and then
1569 + copy them into the result array. The result array will have one dimension
1570 + less than the input array, so later on we need to recreate the indices and
1571 + ranges in the calling function. */
1574 +value_slice_1 (struct value *array, int lowbound, int length,
1575 + int stride_length, int call_count)
1577 struct type *slice_range_type, *slice_type, *range_type;
1578 - LONGEST lowerbound, upperbound;
1579 - struct value *slice;
1580 - struct type *array_type;
1581 + struct type *array_type = check_typedef (value_type (array));
1582 + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
1583 + unsigned int elt_size, elt_offs;
1584 + LONGEST ary_high_bound, ary_low_bound;
1586 + int slice_range_size, i = 0, row_count = 1, elem_count = 1;
1588 - array_type = check_typedef (value_type (array));
1589 + /* Check for legacy code if we are actually dealing with an array or
1591 if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
1592 && TYPE_CODE (array_type) != TYPE_CODE_STRING)
1593 error (_("cannot take slice of non-array"));
1594 @@ -3813,45 +3842,155 @@ value_slice (struct value *array, int lowbound, int length)
1595 if (type_not_associated (array_type))
1596 error (_("array not associated"));
1598 - range_type = TYPE_INDEX_TYPE (array_type);
1599 - if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
1600 - error (_("slice from bad array or bitstring"));
1601 + ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (array_type));
1602 + ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (array_type));
1604 + /* When we are working on a multi-dimensional array, we need to get the
1605 + attributes of the underlying type. */
1606 + if (call_count > 1)
1608 + ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (elt_type));
1609 + ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (elt_type));
1610 + elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
1611 + row_count = TYPE_LENGTH (array_type)
1612 + / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
1615 + /* With a stride of '1', the number of elements per result row is equal to
1616 + the LENGTH of the subarray. With non-default stride values, we skip
1617 + elements, but have to add the start element to the total number of
1618 + elements per row. */
1619 + if (stride_length == 1)
1620 + elem_count = length;
1622 + elem_count = ((length - 1) / stride_length) + 1;
1624 + elt_size = TYPE_LENGTH (elt_type);
1625 + elt_offs = lowbound - ary_low_bound;
1627 - if (lowbound < lowerbound || length < 0
1628 - || lowbound + length - 1 > upperbound)
1629 - error (_("slice out of range"));
1630 + elt_offs *= elt_size;
1632 + /* Check for valid user input. In case of Fortran this was already done
1633 + in the calling function. */
1634 + if (call_count == 1
1635 + && (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
1636 + && elt_offs >= TYPE_LENGTH (array_type)))
1637 + error (_("no such vector element"));
1639 + /* CALL_COUNT is 1 when we are dealing either with the highest dimension
1640 + of the array, or a one dimensional array. Set RANGE_TYPE accordingly.
1641 + In both cases we calculate how many rows/elements will be in the output
1642 + array by setting slice_range_size. */
1643 + if (call_count == 1)
1645 + range_type = TYPE_INDEX_TYPE (array_type);
1646 + slice_range_size = ary_low_bound + elem_count - 1;
1648 + /* Check if the array bounds are valid. */
1649 + if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0)
1650 + error (_("slice from bad array or bitstring"));
1652 + /* When CALL_COUNT is greater than 1, we are dealing with an array of arrays.
1653 + So we need to get the type below the current one and set the RANGE_TYPE
1657 + range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type));
1658 + slice_range_size = ary_low_bound + (row_count * elem_count) - 1;
1659 + ary_low_bound = TYPE_LOW_BOUND (range_type);
1662 /* FIXME-type-allocation: need a way to free this type when we are
1664 - slice_range_type = create_static_range_type (NULL,
1665 - TYPE_TARGET_TYPE (range_type),
1667 - lowbound + length - 1);
1670 + slice_range_type = create_static_range_type (NULL, TYPE_TARGET_TYPE (range_type),
1671 + ary_low_bound, slice_range_size);
1673 - struct type *element_type = TYPE_TARGET_TYPE (array_type);
1675 - = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type));
1676 + struct type *element_type;
1678 + /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy
1679 + code for subarrays. */
1680 + if (call_count == 1 && stride_length == 1)
1682 + element_type = TYPE_TARGET_TYPE (array_type);
1684 + slice_type = create_array_type (NULL, element_type, slice_range_type);
1686 - slice_type = create_array_type (NULL,
1688 - slice_range_type);
1689 - TYPE_CODE (slice_type) = TYPE_CODE (array_type);
1690 + TYPE_CODE (slice_type) = TYPE_CODE (array_type);
1692 - if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
1693 - slice = allocate_value_lazy (slice_type);
1694 + if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
1695 + v = allocate_value_lazy (slice_type);
1698 + v = allocate_value (slice_type);
1699 + value_contents_copy (v,
1700 + value_embedded_offset (v),
1702 + value_embedded_offset (array) + elt_offs,
1703 + elt_size * longest_to_int (length));
1707 + /* With a CALL_COUNT or STRIDE_LENGTH are greater than 1 we are working
1708 + on a range of ranges. So we copy the relevant elements into the
1709 + new array we return. */
1712 - slice = allocate_value (slice_type);
1713 - value_contents_copy (slice, 0, array, offset,
1714 - type_length_units (slice_type));
1715 + int j, offs_store = elt_offs;
1716 + LONGEST dst_offset = 0;
1717 + LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
1719 + if (call_count == 1)
1721 + /* When CALL_COUNT is equal to 1 we are working on the current range
1722 + and use these elements directly. */
1723 + element_type = TYPE_TARGET_TYPE (array_type);
1727 + /* Working on an array of arrays, the type of the elements is the type
1728 + of the subarrays' type. */
1729 + element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type));
1732 + slice_type = create_array_type (NULL, element_type, slice_range_type);
1734 + /* If we have a one dimensional array, we copy its TYPE_CODE. For a
1735 + multi dimensional array we copy the embedded type's TYPE_CODE. */
1736 + if (call_count == 1)
1737 + TYPE_CODE (slice_type) = TYPE_CODE (array_type);
1739 + TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type));
1741 + v = allocate_value (slice_type);
1743 + /* Iterate through the rows of the outer array and set the new offset
1745 + for (i = 0; i < row_count; i++)
1747 + elt_offs = offs_store + i * src_row_length;
1749 + /* Iterate through the elements in each row to copy only those. */
1750 + for (j = 1; j <= elem_count; j++)
1752 + /* Fetches the contents of ARRAY and copies them into V. */
1753 + value_contents_copy (v, dst_offset, array, elt_offs, elt_size);
1754 + elt_offs += elt_size * stride_length;
1755 + dst_offset += elt_size;
1760 - set_value_component_location (slice, array);
1761 - set_value_offset (slice, value_offset (array) + offset);
1762 + set_value_component_location (v, array);
1763 + if (VALUE_LVAL (v) == lval_register)
1765 + VALUE_REGNUM (v) = VALUE_REGNUM (array);
1766 + VALUE_NEXT_FRAME_ID (v) = VALUE_NEXT_FRAME_ID (array);
1768 + set_value_offset (v, value_offset (array) + elt_offs);
1775 /* Create a value for a FORTRAN complex number. Currently most of the
1776 diff --git a/gdb/value.h b/gdb/value.h
1779 @@ -1145,6 +1145,8 @@ extern struct value *varying_to_slice (struct value *);
1781 extern struct value *value_slice (struct value *, int, int);
1783 +extern struct value *value_slice_1 (struct value *, int, int, int, int);
1785 extern struct value *value_literal_complex (struct value *, struct value *,