]> git.pld-linux.org Git - packages/gdb.git/blame - gdb-vla-intel-fortran-strides.patch
up to 10.2
[packages/gdb.git] / gdb-vla-intel-fortran-strides.patch
CommitLineData
4b0e5c1b
AM
1From FEDORA_PATCHES Mon Sep 17 00:00:00 2001
2From: Fedora GDB patches <invalid@email.com>
3Date: Fri, 27 Oct 2017 21:07:50 +0200
4Subject: gdb-vla-intel-fortran-strides.patch
5
4b0e5c1b
AM
6;; VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests.
7;;=push
8
140f8057
JR
9git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides
10dbfd7140bf4c0500d1f5d192be781f83f78f7922
11
12 gdb/dwarf2loc.c | 46 ++-
13 gdb/dwarf2loc.h | 6 +
14 gdb/dwarf2read.c | 13 +-
15 gdb/eval.c | 391 +++++++++++++++++++++-----
16 gdb/expprint.c | 20 +-
17 gdb/expression.h | 18 +-
18 gdb/f-exp.y | 42 ++-
19 gdb/f-valprint.c | 8 +-
20 gdb/gdbtypes.c | 34 ++-
21 gdb/gdbtypes.h | 18 +-
22 gdb/parse.c | 24 +-
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 +++++++++++--
34 gdb/value.h | 2 +
35 23 files changed, 1242 insertions(+), 183 deletions(-)
36
4b0e5c1b 37diff --git a/gdb/eval.c b/gdb/eval.c
4b0e5c1b
AM
38--- a/gdb/eval.c
39+++ b/gdb/eval.c
174fe25c 40@@ -371,29 +371,323 @@ init_array_element (struct value *array, struct value *element,
140f8057
JR
41 return index;
42 }
43
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. */
50+
51 static struct value *
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)
56 {
57- int pc = (*pos) + 1;
77d10998 58- LONGEST low_bound, high_bound;
174fe25c 59- struct type *range = check_typedef (value_type (array)->index_type ());
140f8057
JR
60- enum range_type range_type
61- = (enum range_type) longest_to_int (exp->elts[pc].longconst);
62-
63- *pos += 3;
4b0e5c1b
AM
64-
65- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
174fe25c 66- low_bound = range->bounds ()->low.const_val ();
4b0e5c1b 67- else
174fe25c 68- low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
77d10998 69+ int i, dim_count = 0;
140f8057
JR
70+ struct value *new_array = array;
71+ struct type *array_type = check_typedef (value_type (new_array));
72+ struct type *elt_type;
73+
77d10998 74+ typedef struct
140f8057
JR
75+ {
76+ enum range_type f90_range_type;
77+ LONGEST low, high, stride;
78+ } subscript_range;
79+
80+ typedef enum subscript_kind
81+ {
82+ SUBSCRIPT_RANGE, /* e.g. "(lowbound:highbound)" */
83+ SUBSCRIPT_INDEX /* e.g. "(literal)" */
84+ } kind;
85+
86+ /* Local struct to hold user data for Fortran subarray dimensions. */
87+ struct subscript_store
88+ {
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;
92+
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. */
98+ union element_range
99+ {
100+ subscript_range range;
101+ LONGEST number;
102+ } U;
103+ } *subscript_array;
104+
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
107+ dimension. */
108+ if (nargs != calc_f77_array_dims (value_type (new_array)))
109+ error (_("Wrong number of subscripts"));
110+
111+ subscript_array = (struct subscript_store*) alloca (sizeof (*subscript_array) * nargs);
112+
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++)
121+ {
122+ struct subscript_store *index = &subscript_array[i];
77d10998 123+
140f8057
JR
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)
127+ {
128+ int pc = (*pos) + 1;
129+ subscript_range *range;
4b0e5c1b 130+
140f8057
JR
131+ index->kind = SUBSCRIPT_RANGE;
132+ range = &index->U.range;
133+
134+ *pos += 3;
135+ range->f90_range_type = (enum range_type) exp->elts[pc].longconst;
136+
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
139+ upper bound. */
140+ if ((range->f90_range_type & SUBARRAY_LOW_BOUND)
141+ == SUBARRAY_LOW_BOUND)
174fe25c 142+ range->low = value_as_long (evaluate_subexp (nullptr, exp,
140f8057
JR
143+ pos, noside));
144+ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND)
145+ == SUBARRAY_HIGH_BOUND)
174fe25c 146+ range->high = value_as_long (evaluate_subexp (nullptr, exp,
140f8057
JR
147+ pos, noside));
148+
149+ /* Assign the user's stride value if provided. */
150+ if ((range->f90_range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
174fe25c 151+ range->stride = value_as_long (evaluate_subexp (nullptr, exp,
140f8057
JR
152+ pos, noside));
153+
154+ /* Assign the default stride value '1'. */
155+ else
156+ range->stride = 1;
77d10998
AM
157
158- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
174fe25c 159- high_bound = range->bounds ()->high.const_val ();
77d10998 160- else
174fe25c 161- high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
140f8057
JR
162+ /* Check the provided stride value is illegal, aka '0'. */
163+ if (range->stride == 0)
164+ error (_("Stride must not be 0"));
165+ }
166+ /* User input is an index. E.g.: "p arry(5)". */
167+ else
168+ {
169+ struct value *val;
170+
171+ index->kind = SUBSCRIPT_INDEX;
172+
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);
177+ }
178+
179+ }
180+
181+ /* Traverse the array from right to left and set the high and low bounds
182+ for later use. */
183+ for (i = nargs - 1; i >= 0; i--)
184+ {
185+ struct subscript_store *index = &subscript_array[i];
174fe25c 186+ struct type *index_type = array_type->index_type ();
140f8057
JR
187+
188+ switch (index->kind)
189+ {
190+ case SUBSCRIPT_RANGE:
191+ {
192+
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;
198+
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)
174fe25c 202+ range->low = index_type->bounds ()->low.const_val ();
140f8057
JR
203+
204+ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0)
174fe25c 205+ range->high = index_type->bounds ()->high.const_val ();
140f8057
JR
206+
207+ /* Both user provided low and high bound have to be inside the
208+ array bounds. Throw an error if not. */
174fe25c
JP
209+ if (range->low < index_type->bounds ()->low.const_val ()
210+ || range->low > index_type->bounds ()->high.const_val ()
211+ || range->high < index_type->bounds ()->low.const_val ()
212+ || range->high > index_type->bounds ()->high.const_val ())
140f8057
JR
213+ error (_("provided bound(s) outside array bound(s)"));
214+
215+ /* For a negative stride the lower boundary must be larger than the
216+ upper boundary.
217+ For a positive stride the lower boundary must be smaller than the
218+ upper boundary. */
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"));
222+
223+ }
224+ break;
225+
226+ case SUBSCRIPT_INDEX:
227+ break;
4b0e5c1b 228+
140f8057
JR
229+ }
230+
231+ array_type = TYPE_TARGET_TYPE (array_type);
232+ }
233+
234+ /* Reset ARRAY_TYPE before slicing.*/
235+ array_type = check_typedef (value_type (new_array));
236+
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--)
242+ {
243+ struct subscript_store *index = &subscript_array[i];
174fe25c 244+ struct type *index_type = array_type->index_type ();
140f8057
JR
245+
246+ switch (index->kind)
247+ {
248+ case SUBSCRIPT_RANGE:
249+ {
250+
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;
256+
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. */
261+ dim_count++;
262+
263+ new_array
264+ = value_slice_1 (new_array, range->low,
265+ range->high - range->low + 1,
266+ range->stride, dim_count);
267+ }
268+ break;
269+
270+ case SUBSCRIPT_INDEX:
271+ {
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)
279+ new_array
280+ = value_subscripted_rvalue (new_array, index->U.number,
281+ f77_get_lowerbound (value_type
282+ (new_array)));
283+ else
284+ {
285+ dim_count++;
286+
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. */
174fe25c
JP
292+ if (index->U.number < index_type->bounds ()->low.const_val ()
293+ && index->U.number > index_type->bounds ()->high.const_val ())
140f8057
JR
294+ error (_("provided bound(s) outside array bound(s)"));
295+
174fe25c
JP
296+ if (index->U.number > index_type->bounds ()->low.const_val ()
297+ && index->U.number > index_type->bounds ()->high.const_val ())
140f8057
JR
298+ error (_("provided bound(s) outside array bound(s)"));
299+
300+ new_array = value_slice_1 (new_array,
301+ index->U.number,
302+ 1, /* COUNT is '1' element */
303+ 1, /* STRIDE set to '1' */
304+ dim_count);
305+ }
306+
307+ }
308+ break;
309+ }
310+ array_type = TYPE_TARGET_TYPE (array_type);
311+ }
312+
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
316+ correctly.
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.
319+ E.g.:
320+ "p ary(3, 7, 2:15)" in Fortran has only 1 dimension, but we calculated 3
321+ ranges.
322+ "p ary(3, 7:12, 4)" in Fortran has only 1 dimension, but we calculated 2
323+ ranges.
324+ "p ary(2:4, 5, 7)" in Fortran has only 1 dimension, and we calculated 1
325+ range. */
326+ if (dim_count > 1)
327+ {
328+ struct value *v = NULL;
329+
330+ elt_type = TYPE_TARGET_TYPE (value_type (new_array));
77d10998
AM
331
332- return value_slice (array, low_bound, high_bound - low_bound + 1);
140f8057
JR
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++)
341+ {
342+ struct subscript_store *index = &subscript_array[i];
343+
344+ if (index->kind == SUBSCRIPT_RANGE)
345+ {
346+ struct type *range_type, *interim_array_type;
347+
348+ int new_length;
77d10998 349+
140f8057
JR
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;
354+
355+ new_length /= index->U.range.stride;
356+
357+ range_type
358+ = create_static_range_type (NULL,
359+ elt_type,
360+ index->U.range.low,
361+ index->U.range.low + new_length);
362+
363+ interim_array_type = create_array_type (NULL,
364+ elt_type,
365+ range_type);
366+
174fe25c 367+ interim_array_type->set_code ( value_type (new_array)->code ());
140f8057
JR
368+
369+ v = allocate_value (interim_array_type);
370+
371+ elt_type = value_type (v);
372+ }
373+
374+ }
375+ value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (elt_type));
376+ return v;
377+ }
378+
379+ return new_array;
380 }
381
382
174fe25c 383@@ -1233,19 +1527,6 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
77d10998
AM
384 return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
385 }
386
387-/* Helper for skipping all the arguments in an undetermined argument list.
388- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
389- case of evaluate_subexp_standard as multiple, but not all, code paths
390- require a generic skip. */
391-
392-static void
393-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
394- enum noside noside)
395-{
396- for (int i = 0; i < nargs; ++i)
174fe25c 397- evaluate_subexp (nullptr, exp, pos, noside);
77d10998
AM
398-}
399-
174fe25c
JP
400 /* Return true if type is integral or reference to integral */
401
402 static bool
403@@ -1953,33 +2234,8 @@ evaluate_subexp_standard (struct type *expect_type,
140f8057
JR
404 switch (code)
405 {
406 case TYPE_CODE_ARRAY:
407- if (exp->elts[*pos].opcode == OP_RANGE)
408- return value_f90_subarray (arg1, exp, pos, noside);
409- else
77d10998
AM
410- {
411- if (noside == EVAL_SKIP)
412- {
413- skip_undetermined_arglist (nargs, exp, pos, noside);
414- /* Return the dummy value with the correct type. */
415- return arg1;
416- }
417- goto multi_f77_subscript;
418- }
140f8057
JR
419-
420 case TYPE_CODE_STRING:
421- if (exp->elts[*pos].opcode == OP_RANGE)
422- return value_f90_subarray (arg1, exp, pos, noside);
423- else
424- {
77d10998
AM
425- if (noside == EVAL_SKIP)
426- {
427- skip_undetermined_arglist (nargs, exp, pos, noside);
428- /* Return the dummy value with the correct type. */
429- return arg1;
430- }
140f8057
JR
431- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
432- return value_subscript (arg1, value_as_long (arg2));
433- }
434+ return value_f90_subarray (arg1, exp, pos, nargs, noside);
435
436 case TYPE_CODE_PTR:
437 case TYPE_CODE_FUNC:
174fe25c 438@@ -2400,49 +2656,6 @@ evaluate_subexp_standard (struct type *expect_type,
140f8057
JR
439 }
440 return (arg1);
441
442- multi_f77_subscript:
443- {
444- LONGEST subscript_array[MAX_FORTRAN_DIMS];
445- int ndimensions = 1, i;
446- struct value *array = arg1;
447-
448- if (nargs > MAX_FORTRAN_DIMS)
449- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
450-
451- ndimensions = calc_f77_array_dims (type);
452-
453- if (nargs != ndimensions)
454- error (_("Wrong number of subscripts"));
455-
456- gdb_assert (nargs > 0);
457-
458- /* Now that we know we have a legal array subscript expression
459- let us actually find out where this element exists in the array. */
460-
461- /* Take array indices left to right. */
462- for (i = 0; i < nargs; i++)
463- {
464- /* Evaluate each subscript; it must be a legal integer in F77. */
465- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
466-
467- /* Fill in the subscript array. */
468-
469- subscript_array[i] = value_as_long (arg2);
470- }
471-
472- /* Internal type of array is arranged right to left. */
473- for (i = nargs; i > 0; i--)
474- {
475- struct type *array_type = check_typedef (value_type (array));
476- LONGEST index = subscript_array[i - 1];
477-
478- array = value_subscripted_rvalue (array, index,
479- f77_get_lowerbound (array_type));
480- }
481-
482- return array;
483- }
484-
485 case BINOP_LOGICAL_AND:
174fe25c 486 arg1 = evaluate_subexp (nullptr, exp, pos, noside);
140f8057 487 if (noside == EVAL_SKIP)
174fe25c 488@@ -3360,6 +3573,9 @@ calc_f77_array_dims (struct type *array_type)
140f8057
JR
489 int ndimen = 1;
490 struct type *tmp_type;
491
174fe25c 492+ if (array_type->code () == TYPE_CODE_STRING)
140f8057
JR
493+ return 1;
494+
174fe25c 495 if ((array_type->code () != TYPE_CODE_ARRAY))
140f8057
JR
496 error (_("Can't get dimensions for a non-array type"));
497
4b0e5c1b 498diff --git a/gdb/expprint.c b/gdb/expprint.c
4b0e5c1b
AM
499--- a/gdb/expprint.c
500+++ b/gdb/expprint.c
174fe25c 501@@ -576,17 +576,14 @@ print_subexp_standard (struct expression *exp, int *pos,
ed003b1c 502 longest_to_int (exp->elts[pc + 1].longconst);
140f8057
JR
503 *pos += 2;
504
ed003b1c
AM
505- if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE
506- || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)
507+ if ((range_type & SUBARRAY_HIGH_BOUND_EXCLUSIVE)
508+ == SUBARRAY_HIGH_BOUND_EXCLUSIVE)
509 fputs_filtered ("EXCLUSIVE_", stream);
140f8057
JR
510 fputs_filtered ("RANGE(", stream);
511- if (range_type == HIGH_BOUND_DEFAULT
ed003b1c
AM
512- || range_type == NONE_BOUND_DEFAULT
513- || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)
140f8057
JR
514+ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
515 print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
516 fputs_filtered ("..", stream);
517- if (range_type == LOW_BOUND_DEFAULT
518- || range_type == NONE_BOUND_DEFAULT)
519+ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
520 print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
521 fputs_filtered (")", stream);
522 return;
174fe25c 523@@ -1103,22 +1100,24 @@ dump_subexp_body_standard (struct expression *exp,
140f8057
JR
524
525 switch (range_type)
526 {
527- case BOTH_BOUND_DEFAULT:
528+ case SUBARRAY_NONE_BOUND:
529 fputs_filtered ("Range '..'", stream);
530 break;
531- case LOW_BOUND_DEFAULT:
532+ case SUBARRAY_HIGH_BOUND:
533 fputs_filtered ("Range '..EXP'", stream);
534 break;
ed003b1c
AM
535- case LOW_BOUND_DEFAULT_EXCLUSIVE:
536- fputs_filtered ("ExclusiveRange '..EXP'", stream);
537- break;
140f8057
JR
538- case HIGH_BOUND_DEFAULT:
539+ case SUBARRAY_LOW_BOUND:
540 fputs_filtered ("Range 'EXP..'", stream);
541 break;
542- case NONE_BOUND_DEFAULT:
ed003b1c
AM
543+ case (SUBARRAY_LOW_BOUND
544+ | SUBARRAY_HIGH_BOUND
545+ | SUBARRAY_HIGH_BOUND_EXCLUSIVE):
546+ fputs_filtered ("ExclusiveRange '..EXP'", stream);
547+ break;
140f8057
JR
548+ case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND):
549 fputs_filtered ("Range 'EXP..EXP'", stream);
550 break;
ed003b1c
AM
551- case NONE_BOUND_DEFAULT_EXCLUSIVE:
552+ case (SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE):
553 fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
554 break;
140f8057 555 default:
174fe25c 556@@ -1126,11 +1125,9 @@ dump_subexp_body_standard (struct expression *exp,
140f8057
JR
557 break;
558 }
559
560- if (range_type == HIGH_BOUND_DEFAULT
561- || range_type == NONE_BOUND_DEFAULT)
562+ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
563 elt = dump_subexp (exp, stream, elt);
564- if (range_type == LOW_BOUND_DEFAULT
565- || range_type == NONE_BOUND_DEFAULT)
566+ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
567 elt = dump_subexp (exp, stream, elt);
568 }
569 break;
4b0e5c1b 570diff --git a/gdb/expression.h b/gdb/expression.h
4b0e5c1b
AM
571--- a/gdb/expression.h
572+++ b/gdb/expression.h
e28f2cc1 573@@ -167,28 +167,27 @@ extern void dump_raw_expression (struct expression *,
140f8057
JR
574 struct ui_file *, const char *);
575 extern void dump_prefix_expression (struct expression *, struct ui_file *);
576
577-/* In an OP_RANGE expression, either bound could be empty, indicating
578- that its value is by default that of the corresponding bound of the
ed003b1c
AM
579- array or string. Also, the upper end of the range can be exclusive
580- or inclusive. So we have six sorts of subrange. This enumeration
581- type is to identify this. */
582+/* In an OP_RANGE expression, either bound can be provided by the
583+ user, or not. In addition to this, the user can also specify a
584+ stride value to indicated only certain elements of the array.
585+ Also, the upper end of the range can be exclusive or inclusive.
586+ This enumeration type is to identify this. */
587
140f8057 588 enum range_type
ed003b1c
AM
589-{
590- /* Neither the low nor the high bound was given -- so this refers to
591- the entire available range. */
592- BOTH_BOUND_DEFAULT,
593- /* The low bound was not given and the high bound is inclusive. */
594- LOW_BOUND_DEFAULT,
595- /* The high bound was not given and the low bound in inclusive. */
596- HIGH_BOUND_DEFAULT,
597- /* Both bounds were given and both are inclusive. */
598- NONE_BOUND_DEFAULT,
599- /* The low bound was not given and the high bound is exclusive. */
600- NONE_BOUND_DEFAULT_EXCLUSIVE,
601- /* Both bounds were given. The low bound is inclusive and the high
602- bound is exclusive. */
603- LOW_BOUND_DEFAULT_EXCLUSIVE,
604-};
605+ {
140f8057
JR
606+ SUBARRAY_NONE_BOUND = 0x0, /* "( : )" */
607+ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */
608+ SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */
ed003b1c
AM
609+ SUBARRAY_STRIDE = 0x4, /* "(::stride)" */
610+ /* The low bound was not given and the high bound is exclusive.
611+ In this case we always use (SUBARRAY_HIGH_BOUND |
612+ SUBARRAY_HIGH_BOUND_EXCLUSIVE). */
613+ SUBARRAY_HIGH_BOUND_EXCLUSIVE = 0x8,
614+ /* Both bounds were given. The low bound is inclusive and the high
615+ bound is exclusive. In this case, we use (SUBARRAY_LOW_BOUND |
616+ SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE). */
617+ // SUBARRAY_LOW_BOUND_EXCLUSIVE = (SUBARRAY_LOW_BOUND
618+ // | SUBARRAY_HIGH_BOUND_EXCLUSIVE),
619+ };
140f8057
JR
620
621 #endif /* !defined (EXPRESSION_H) */
4b0e5c1b 622diff --git a/gdb/f-exp.y b/gdb/f-exp.y
4b0e5c1b
AM
623--- a/gdb/f-exp.y
624+++ b/gdb/f-exp.y
e28f2cc1 625@@ -282,31 +282,63 @@ arglist : subrange
140f8057
JR
626
627 arglist : arglist ',' exp %prec ABOVE_COMMA
e28f2cc1 628 { pstate->arglist_len++; }
140f8057 629+ | arglist ',' subrange %prec ABOVE_COMMA
e28f2cc1 630+ { pstate->arglist_len++; }
140f8057
JR
631 ;
632
633 /* There are four sorts of subrange types in F90. */
634
635 subrange: exp ':' exp %prec ABOVE_COMMA
636- { write_exp_elt_opcode (pstate, OP_RANGE);
637- write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
638+ { write_exp_elt_opcode (pstate, OP_RANGE);
639+ write_exp_elt_longcst (pstate,
640+ SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND);
641 write_exp_elt_opcode (pstate, OP_RANGE); }
642 ;
643
644 subrange: exp ':' %prec ABOVE_COMMA
645 { write_exp_elt_opcode (pstate, OP_RANGE);
646- write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
647+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND);
648 write_exp_elt_opcode (pstate, OP_RANGE); }
649 ;
650
651 subrange: ':' exp %prec ABOVE_COMMA
652 { write_exp_elt_opcode (pstate, OP_RANGE);
653- write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
654+ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND);
655 write_exp_elt_opcode (pstate, OP_RANGE); }
656 ;
657
658 subrange: ':' %prec ABOVE_COMMA
659 { write_exp_elt_opcode (pstate, OP_RANGE);
660- write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
661+ write_exp_elt_longcst (pstate, SUBARRAY_NONE_BOUND);
662+ write_exp_elt_opcode (pstate, OP_RANGE); }
663+ ;
664+
665+/* Each subrange type can have a stride argument. */
666+subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
667+ { write_exp_elt_opcode (pstate, OP_RANGE);
668+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
669+ | SUBARRAY_HIGH_BOUND
670+ | SUBARRAY_STRIDE);
671+ write_exp_elt_opcode (pstate, OP_RANGE); }
672+ ;
673+
674+subrange: exp ':' ':' exp %prec ABOVE_COMMA
675+ { write_exp_elt_opcode (pstate, OP_RANGE);
676+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
677+ | SUBARRAY_STRIDE);
678+ write_exp_elt_opcode (pstate, OP_RANGE); }
679+ ;
680+
681+subrange: ':' exp ':' exp %prec ABOVE_COMMA
682+ { write_exp_elt_opcode (pstate, OP_RANGE);
683+ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND
684+ | SUBARRAY_STRIDE);
685+ write_exp_elt_opcode (pstate, OP_RANGE); }
686+ ;
687+
688+subrange: ':' ':' exp %prec ABOVE_COMMA
689+ { write_exp_elt_opcode (pstate, OP_RANGE);
690+ write_exp_elt_longcst (pstate, SUBARRAY_STRIDE);
691 write_exp_elt_opcode (pstate, OP_RANGE); }
692 ;
693
4b0e5c1b 694diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
4b0e5c1b
AM
695--- a/gdb/f-valprint.c
696+++ b/gdb/f-valprint.c
e28f2cc1
AM
697@@ -129,6 +129,11 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
698 byte_stride = dim_size;
140f8057 699 size_t offs = 0;
e28f2cc1 700
140f8057
JR
701+ if (byte_stride)
702+ dim_size = byte_stride;
703+ else
704+ dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
e28f2cc1 705+
140f8057
JR
706 for (i = lowerbound;
707 (i < upperbound + 1 && (*elts) < options->print_max);
e28f2cc1 708 i++)
4b0e5c1b 709diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
4b0e5c1b
AM
710--- a/gdb/gdbtypes.c
711+++ b/gdb/gdbtypes.c
174fe25c
JP
712@@ -1006,7 +1006,8 @@ create_static_range_type (struct type *result_type, struct type *index_type,
713 low.set_const_val (low_bound);
714 high.set_const_val (high_bound);
140f8057 715
e28f2cc1 716- result_type = create_range_type (result_type, index_type, &low, &high, 0);
140f8057 717+ result_type = create_range_type (result_type, index_type,
e28f2cc1 718+ &low, &high, 0);
140f8057
JR
719
720 return result_type;
721 }
4b0e5c1b 722diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
4b0e5c1b
AM
723--- a/gdb/gdbtypes.h
724+++ b/gdb/gdbtypes.h
174fe25c
JP
725@@ -1615,6 +1615,15 @@ extern unsigned type_align (struct type *);
726 space in struct type. */
727 extern bool set_type_align (struct type *, ULONGEST);
140f8057 728
140f8057
JR
729+#define TYPE_BYTE_STRIDE(range_type) \
730+ TYPE_RANGE_DATA(range_type)->stride.data.const_val
731+#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
732+ TYPE_RANGE_DATA(range_type)->stride.data.locexpr
733+#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
734+ TYPE_RANGE_DATA(range_type)->stride.data.loclist
735+#define TYPE_BYTE_STRIDE_KIND(range_type) \
736+ TYPE_RANGE_DATA(range_type)->stride.kind
737+
140f8057
JR
738 /* Property accessors for the type data location. */
739 #define TYPE_DATA_LOCATION(thistype) \
174fe25c
JP
740 ((thistype)->dyn_prop (DYN_PROP_DATA_LOCATION))
741@@ -1633,6 +1642,26 @@ extern bool set_type_align (struct type *, ULONGEST);
742 #define TYPE_ASSOCIATED_PROP(thistype) \
743 ((thistype)->dyn_prop (DYN_PROP_ASSOCIATED))
744
745+/* Accessors for struct range_bounds data attached to an array type's
746+ index type. */
747+
748+#define TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED(arraytype) \
749+ ((arraytype)->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED)
750+#define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
751+ (arraytype->index_type ()->bounds ().low.kind () == PROP_UNDEFINED)
140f8057 752+#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
174fe25c
JP
753+ (TYPE_BYTE_STRIDE(arraytype->index_type ()) == 0)
754+
755+
756+#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
757+ (TYPE_HIGH_BOUND((arraytype)->index_type ()))
140f8057 758+
174fe25c
JP
759+#define TYPE_ARRAY_LOWER_BOUND_VALUE(arraytype) \
760+ (TYPE_LOW_BOUND((arraytype)->index_type ()))
761+
762+#define TYPE_ARRAY_BIT_STRIDE(arraytype) \
763+ (TYPE_BIT_STRIDE((arraytype)->index_type ()))
764+
765 /* C++ */
140f8057 766
174fe25c 767 #define TYPE_SELF_TYPE(thistype) internal_type_self_type (thistype)
4b0e5c1b 768diff --git a/gdb/parse.c b/gdb/parse.c
4b0e5c1b
AM
769--- a/gdb/parse.c
770+++ b/gdb/parse.c
e28f2cc1 771@@ -919,24 +919,20 @@ operator_length_standard (const struct expression *expr, int endpos,
140f8057
JR
772
773 case OP_RANGE:
774 oplen = 3;
775+ args = 0;
776 range_type = (enum range_type)
777 longest_to_int (expr->elts[endpos - 2].longconst);
778
779- switch (range_type)
780- {
781- case LOW_BOUND_DEFAULT:
ed003b1c 782- case LOW_BOUND_DEFAULT_EXCLUSIVE:
140f8057
JR
783- case HIGH_BOUND_DEFAULT:
784- args = 1;
785- break;
786- case BOTH_BOUND_DEFAULT:
787- args = 0;
788- break;
789- case NONE_BOUND_DEFAULT:
ed003b1c 790- case NONE_BOUND_DEFAULT_EXCLUSIVE:
140f8057
JR
791- args = 2;
792- break;
793- }
794+ /* Increment the argument counter for each argument
795+ provided by the user. */
796+ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
797+ args++;
798+
799+ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
800+ args++;
801+
802+ if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
803+ args++;
804
805 break;
806
4b0e5c1b 807diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
4b0e5c1b
AM
808--- a/gdb/rust-exp.y
809+++ b/gdb/rust-exp.y
e28f2cc1 810@@ -2492,24 +2492,28 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
140f8057
JR
811
812 case OP_RANGE:
813 {
814- enum range_type kind = BOTH_BOUND_DEFAULT;
815+ enum range_type kind = SUBARRAY_NONE_BOUND;
816
817 if (operation->left.op != NULL)
818 {
77d10998 819 convert_ast_to_expression (operation->left.op, top);
140f8057
JR
820- kind = HIGH_BOUND_DEFAULT;
821+ kind = SUBARRAY_LOW_BOUND;
822 }
823 if (operation->right.op != NULL)
824 {
77d10998 825 convert_ast_to_expression (operation->right.op, top);
140f8057 826- if (kind == BOTH_BOUND_DEFAULT)
ed003b1c
AM
827- kind = (operation->inclusive
828- ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE);
829+ if (kind == SUBARRAY_NONE_BOUND)
830+ {
831+ kind = (range_type) SUBARRAY_HIGH_BOUND;
832+ if (!operation->inclusive)
833+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE);
834+ }
835 else
836 {
140f8057 837- gdb_assert (kind == HIGH_BOUND_DEFAULT);
ed003b1c
AM
838- kind = (operation->inclusive
839- ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE);
840+ gdb_assert (kind == SUBARRAY_LOW_BOUND);
841+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND);
842+ if (!operation->inclusive)
843+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE);
844 }
140f8057 845 }
ed003b1c 846 else
4b0e5c1b 847diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
4b0e5c1b
AM
848--- a/gdb/rust-lang.c
849+++ b/gdb/rust-lang.c
174fe25c 850@@ -1082,13 +1082,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
140f8057
JR
851 kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
852 *pos += 3;
853
ed003b1c
AM
854- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT
855- || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
140f8057 856+ if ((kind & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
174fe25c 857 low = evaluate_subexp (nullptr, exp, pos, noside);
ed003b1c
AM
858- if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE
859- || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
140f8057 860+ if ((kind & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
174fe25c 861 high = evaluate_subexp (nullptr, exp, pos, noside);
ed003b1c
AM
862- bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT);
863+ bool inclusive = (!((kind & SUBARRAY_HIGH_BOUND_EXCLUSIVE) == SUBARRAY_HIGH_BOUND_EXCLUSIVE));
140f8057
JR
864
865 if (noside == EVAL_SKIP)
ed003b1c 866 return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
174fe25c 867@@ -1177,7 +1175,7 @@ rust_compute_range (struct type *type, struct value *range,
140f8057
JR
868
869 *low = 0;
870 *high = 0;
871- *kind = BOTH_BOUND_DEFAULT;
872+ *kind = SUBARRAY_NONE_BOUND;
873
174fe25c 874 if (type->num_fields () == 0)
140f8057 875 return;
174fe25c 876@@ -1185,15 +1183,14 @@ rust_compute_range (struct type *type, struct value *range,
140f8057
JR
877 i = 0;
878 if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0)
879 {
880- *kind = HIGH_BOUND_DEFAULT;
881+ *kind = SUBARRAY_LOW_BOUND;
882 *low = value_as_long (value_field (range, 0));
883 ++i;
884 }
174fe25c 885 if (type->num_fields () > i
140f8057
JR
886 && strcmp (TYPE_FIELD_NAME (type, i), "end") == 0)
887 {
888- *kind = (*kind == BOTH_BOUND_DEFAULT
889- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
890+ *kind = (range_type) (*kind | SUBARRAY_HIGH_BOUND);
891 *high = value_as_long (value_field (range, i));
ed003b1c
AM
892
893 if (rust_inclusive_range_type_p (type))
174fe25c 894@@ -1211,7 +1208,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
140f8057
JR
895 struct type *rhstype;
896 LONGEST low, high_bound;
897 /* Initialized to appease the compiler. */
898- enum range_type kind = BOTH_BOUND_DEFAULT;
899+ enum range_type kind = SUBARRAY_NONE_BOUND;
900 LONGEST high = 0;
901 int want_slice = 0;
902
174fe25c 903@@ -1309,7 +1306,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
140f8057
JR
904 error (_("Cannot subscript non-array type"));
905
906 if (want_slice
907- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT))
908+ && ((kind & SUBARRAY_LOW_BOUND) != SUBARRAY_LOW_BOUND))
909 low = low_bound;
910 if (low < 0)
911 error (_("Index less than zero"));
174fe25c 912@@ -1327,7 +1324,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
140f8057
JR
913 CORE_ADDR addr;
914 struct value *addrval, *tem;
915
916- if (kind == BOTH_BOUND_DEFAULT || kind == HIGH_BOUND_DEFAULT)
917+ if ((kind & SUBARRAY_HIGH_BOUND) != SUBARRAY_HIGH_BOUND)
918 high = high_bound;
919 if (high < 0)
920 error (_("High index less than zero"));
4b0e5c1b
AM
921diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp
922new file mode 100644
4b0e5c1b
AM
923--- /dev/null
924+++ b/gdb/testsuite/gdb.fortran/static-arrays.exp
140f8057
JR
925@@ -0,0 +1,421 @@
926+# Copyright 2015 Free Software Foundation, Inc.
927+#
928+# Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
929+#
930+# This program is free software; you can redistribute it and/or modify
931+# it under the terms of the GNU General Public License as published by
932+# the Free Software Foundation; either version 3 of the License, or
933+# (at your option) any later version.
934+#
935+# This program is distributed in the hope that it will be useful,
936+# but WITHOUT ANY WARRANTY; without even the implied warranty of
937+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
938+# GNU General Public License for more details.
939+#
940+# You should have received a copy of the GNU General Public License
941+# along with this program. If not, see <http://www.gnu.org/licenses/>.
942+
943+standard_testfile static-arrays.f90
944+
945+if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } {
946+ return -1
947+}
948+
949+if ![runto MAIN__] then {
950+ perror "couldn't run to breakpoint MAIN__"
951+ continue
952+}
953+
954+gdb_breakpoint [gdb_get_line_number "BP1"]
955+gdb_continue_to_breakpoint "BP1" ".*BP1.*"
956+
957+# Tests subarrays of one dimensional arrays with subrange variations
958+gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \
959+ "print ar1."
960+gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \
961+ "print ar1\(4:7\)"
962+gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \
963+ "print ar1\(8:\)"
964+gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \
965+ "print ar1\(:3\)"
966+gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \
967+ "print ar1\(:\)"
968+
969+# Check assignment
970+gdb_test_no_output "set \$my_ary = ar1\(3:8\)"
971+gdb_test "print \$my_ary" \
972+ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \
973+ "Assignment of subarray to variable"
974+gdb_test_no_output "set ar1\(5\) = 42"
975+ gdb_test "print ar1\(3:8\)" \
976+ "\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \
977+ "print ar1\(3:8\) after assignment"
978+gdb_test "print \$my_ary" \
979+ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \
980+ "Assignment of subarray to variable after original array changed"
981+
982+# Test for subarrays of one dimensional arrays with literals
983+ gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \
984+ "print ar1\(3\)"
985+
986+# Tests for subranges of 2 dimensional arrays with subrange variations
987+gdb_test "print ar2\(2:3, 3:4\)" \
988+ "\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \
989+ "print ar2\(2:3, 3:4\)."
990+gdb_test "print ar2\(8:9,8:\)" \
991+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
992+ "print ar2\(8:9,8:\)"
993+gdb_test "print ar2\(8:9,:2\)" \
994+ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \
995+ "print ar2\(8:9,:2\)"
996+
997+gdb_test "print ar2\(8:,8:9\)" \
998+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
999+ "print ar2\(8:,8:9\)"
1000+gdb_test "print ar2\(8:,8:\)" \
1001+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
1002+ "print ar2\(8:,8:\)"
1003+gdb_test "print ar2\(8:,:2\)" \
1004+ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \
1005+ "print ar2\(8:,:2\)"
1006+
1007+gdb_test "print ar2\(:2,2:3\)" \
1008+ "\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \
1009+ "print ar2\(:2,2:3\)"
1010+gdb_test "print ar2\(:2,8:\)" \
1011+ "\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \
1012+ "print ar2\(:2,8:\)"
1013+gdb_test "print ar2\(:2,:2\)" \
1014+ "\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \
1015+ "print ar2\(:2,:2\)"
1016+
1017+# Test subranges of 2 dimensional arrays with literals and subrange variations
1018+gdb_test "print ar2\(7, 3:6\)" \
1019+ "\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \
1020+ "print ar2\(7, 3:6\)"
1021+gdb_test "print ar2\(7,8:\)" \
1022+ "\\$\[0-9\]+ = \\(78, 79\\)" \
1023+ "print ar2\(7,8:\)"
1024+gdb_test "print ar2\(7,:2\)" \
1025+ "\\$\[0-9\]+ = \\(71, 72\\)" \
1026+ "print ar2\(7,:2\)"
1027+
1028+gdb_test "print ar2\(7:8,4\)" \
1029+ "\\$\[0-9\]+ = \\(74, 84\\)" \
1030+ "print ar2(7:8,4\)"
1031+gdb_test "print ar2\(8:,4\)" \
1032+ "\\$\[0-9\]+ = \\(84, 94\\)" \
1033+ "print ar2\(8:,4\)"
1034+gdb_test "print ar2\(:2,4\)" \
1035+ "\\$\[0-9\]+ = \\(14, 24\\)" \
1036+ "print ar2\(:2,4\)"
1037+gdb_test "print ar2\(3,4\)" \
1038+ "\\$\[0-9\]+ = 34" \
1039+ "print ar2\(3,4\)"
1040+
1041+# Test subarrays of 3 dimensional arrays with literals and subrange variations
1042+gdb_test "print ar3\(2:4,3:4,7:8\)" \
1043+ "\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\)\
1044+ \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \
1045+ "print ar3\(2:4,3:4,7:8\)"
1046+gdb_test "print ar3\(2:3,4:5,8:\)" \
1047+ "\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\(\
1048+ \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \
1049+ "print ar3\(2:3,4:5,8:\)"
1050+gdb_test "print ar3\(2:3,4:5,:2\)" \
1051+ "\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\(\
1052+ \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \
1053+ "print ar3\(2:3,4:5,:2\)"
1054+
1055+gdb_test "print ar3\(2:3,8:,7:8\)" \
1056+ "\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\(\
1057+ \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \
1058+ "print ar3\(2:3,8:,7:8\)"
1059+gdb_test "print ar3\(2:3,8:,8:\)" \
1060+ "\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\(\
1061+ \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \
1062+ "print ar3\(2:3,8:,8:\)"
1063+gdb_test "print ar3\(2:3,8:,:2\)" \
1064+ "\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\(\
1065+ \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \
1066+ "print ar3\(2:3,8:,:2\)"
1067+
1068+gdb_test "print ar3\(2:3,:2,7:8\)" \
1069+ "\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\(\
1070+ \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \
1071+ "print ar3\(2:3,:2,7:8\)"
1072+gdb_test "print ar3\(2:3,:2,8:\)" \
1073+ "\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\(\
1074+ \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \
1075+ "print ar3\(2:3,:2,8:\)"
1076+gdb_test "print ar3\(2:3,:2,:2\)" \
1077+ "\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\(\
1078+ \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \
1079+ "print ar3\(2:3,:2,:2\)"
1080+
1081+gdb_test "print ar3\(8:,3:4,7:8\)" \
1082+ "\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\(\
1083+ \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \
1084+ "print ar3\(8:,3:4,7:8\)"
1085+gdb_test "print ar3\(8:,4:5,8:\)" \
1086+ "\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\(\
1087+ \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \
1088+ "print ar3\(8:,4:5,8:\)"
1089+gdb_test "print ar3\(8:,4:5,:2\)" \
1090+ "\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\(\
1091+ \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \
1092+ "print ar3\(8:,4:5,:2\)"
1093+
1094+gdb_test "print ar3\(8:,8:,7:8\)" \
1095+ "\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\(\
1096+ \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \
1097+ "print ar3\(8:,8:,7:8\)"
1098+gdb_test "print ar3\(8:,8:,8:\)" \
1099+ "\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\(\
1100+ \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \
1101+ "print ar3\(8:,8:,8:\)"
1102+gdb_test "print ar3\(8:,8:,:2\)" \
1103+ "\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\(\
1104+ \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \
1105+ "print ar3\(8:,8:,:2\)"
1106+
1107+gdb_test "print ar3\(8:,:2,7:8\)" \
1108+ "\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\(\
1109+ \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \
1110+ "print ar3\(8:,:2,7:8\)"
1111+gdb_test "print ar3\(8:,:2,8:\)" \
1112+ "\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\(\
1113+ \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \
1114+ "print ar3\(8:,:2,8:\)"
1115+gdb_test "print ar3\(8:,:2,:2\)" \
1116+ "\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\(\
1117+ \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \
1118+ "print ar3\(8:,:2,:2\)"
1119+
1120+
1121+gdb_test "print ar3\(:2,3:4,7:8\)" \
1122+ "\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\(\
1123+ \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \
1124+ "print ar3 \(:2,3:4,7:8\)."
1125+gdb_test "print ar3\(:2,3:4,8:\)" \
1126+ "\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\(\
1127+ \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \
1128+ "print ar3\(:2,3:4,8:\)"
1129+gdb_test "print ar3\(:2,3:4,:2\)" \
1130+ "\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\(\
1131+ \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \
1132+ "print ar3\(:2,3:4,:2\)"
1133+
1134+gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\(\
1135+ 197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \
1136+ "print ar3\(:2,8:,7:8\)"
1137+gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198,\
1138+ 298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \
1139+ "print ar3\(:2,8:,8:\)"
1140+gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191,\
1141+ 291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \
1142+ "print ar3\(:2,8:,:2\)"
1143+
1144+gdb_test "print ar3\(:2,:2,7:8\)" \
1145+ "\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\(\
1146+ \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \
1147+ "print ar3\(:2,:2,7:8\)"
1148+gdb_test "print ar3\(:2,:2,8:\)" \
1149+ "\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\(\
1150+ \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \
1151+ "print ar3\(:2,:2,8:\)"
1152+gdb_test "print ar3\(:2,:2,:2\)" \
1153+ "\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\(\
1154+ \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \
1155+ "print ar3\(:2,:2,:2\)"
1156+
1157+#Tests for subarrays of 3 dimensional arrays with literals and subranges
1158+gdb_test "print ar3\(3,3:4,7:8\)" \
1159+ "\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \
1160+ "print ar3\(3,3:4,7:8\)"
1161+gdb_test "print ar3\(3,4:5,8:\)" \
1162+ "\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \
1163+ "print ar3\(3,4:5,8:\)"
1164+gdb_test "print ar3\(3,4:5,:2\)" \
1165+ "\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \
1166+ "print ar3\(3,4:5,:2\)"
1167+gdb_test "print ar3\(3,4:5,3\)" \
1168+ "\\$\[0-9\]+ = \\(343, 353\\)" \
1169+ "print ar3\(3,4:5,3\)"
1170+
1171+gdb_test "print ar3\(2,8:,7:8\)" \
1172+ "\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \
1173+ "print ar3\(2,8:,7:8\)"
1174+gdb_test "print ar3\(2,8:,8:\)" \
1175+ "\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \
1176+ "print ar3\(2,8:,8:\)"
1177+gdb_test "print ar3\(2,8:,:2\)"\
1178+ "\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \
1179+ "print ar3\(2,8:,:2\)"
1180+gdb_test "print ar3\(2,8:,3\)" \
1181+ "\\$\[0-9\]+ = \\(283, 293\\)" \
1182+ "print ar3\(2,8:,3\)"
1183+
1184+gdb_test "print ar3\(2,:2,7:8\)" \
1185+ "\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \
1186+ "print ar3\(2,:2,7:8\)"
1187+gdb_test "print ar3\(2,:2,8:\)" \
1188+ "\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \
1189+ "print ar3\(2,:2,8:\)"
1190+gdb_test "print ar3\(2,:2,:2\)" \
1191+ "\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \
1192+ "print ar3\(2,:2,:2\)"
1193+gdb_test "print ar3\(2,:2,3\)" \
1194+ "\\$\[0-9\]+ = \\(213, 223\\)" \
1195+ "print ar3\(2,:2,3\)"
1196+
1197+gdb_test "print ar3\(3,4,7:8\)" \
1198+ "\\$\[0-9\]+ = \\(347, 348\\)" \
1199+ "print ar3\(3,4,7:8\)"
1200+gdb_test "print ar3\(3,4,8:\)" \
1201+ "\\$\[0-9\]+ = \\(348, 349\\)" \
1202+i "print ar3\(3,4,8:\)"
1203+gdb_test "print ar3\(3,4,:2\)" \
1204+ "\\$\[0-9\]+ = \\(341, 342\\)" \
1205+ "print ar3\(3,4,:2\)"
1206+gdb_test "print ar3\(5,6,7\)" \
1207+ "\\$\[0-9\]+ = 567" \
1208+ "print ar3\(5,6,7\)"
1209+
1210+gdb_test "print ar3\(3:4,6,7:8\)" \
1211+ "\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \
1212+ "print ar3\(3:4,6,7:8\)"
1213+gdb_test "print ar3\(3:4,6,8:\)" \
1214+ "\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \
1215+ "print ar3\(3:4,6,8:\)"
1216+gdb_test "print ar3\(3:4,6,:2\)" \
1217+ "\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \
1218+ "print ar3\(3:4,6,:2\)"
1219+gdb_test "print ar3\(3:4,6,5\)" \
1220+ "\\$\[0-9\]+ = \\(365, 465\\)" \
1221+ "print ar3\(3:4,6,5\)"
1222+
1223+gdb_test "print ar3\(8:,6,7:8\)" \
1224+ "\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \
1225+ "print ar3\(8:,6,7:8\)"
1226+gdb_test "print ar3\(8:,6,8:\)" \
1227+ "\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \
1228+ "print ar3\(8:,6,8:\)"
1229+gdb_test "print ar3\(8:,6,:2\)" \
1230+ "\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \
1231+ "print ar3\(8:,6,:2\)"
1232+gdb_test "print ar3\(8:,6,5\)" \
1233+ "\\$\[0-9\]+ = \\(865, 965\\)" \
1234+ "print ar3\(8:,6,5\)"
1235+
1236+gdb_test "print ar3\(:2,6,7:8\)" \
1237+ "\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \
1238+ "print ar3\(:2,6,7:8\)"
1239+gdb_test "print ar3\(:2,6,8:\)" \
1240+ "\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \
1241+ "print ar3\(:2,6,8:\)"
1242+gdb_test "print ar3\(:2,6,:2\)" \
1243+ "\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \
1244+ "print ar3\(:2,6,:2\)"
1245+gdb_test "print ar3\(:2,6,5\)" \
1246+ "\\$\[0-9\]+ = \\(165, 265\\)" \
1247+ "print ar3\(:2,6,5\)"
1248+
1249+gdb_test "print ar3\(3:4,5:6,4\)" \
1250+ "\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \
1251+ "print ar2\(3:4,5:6,4\)"
1252+gdb_test "print ar3\(8:,5:6,4\)" \
1253+ "\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \
1254+ "print ar2\(8:,5:6,4\)"
1255+gdb_test "print ar3\(:2,5:6,4\)" \
1256+ "\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \
1257+ "print ar2\(:2,5:6,4\)"
1258+
1259+# Stride > 1
1260+gdb_test "print ar1\(2:6:2\)" \
1261+ "\\$\[0-9\]+ = \\(2, 4, 6\\)" \
1262+ "print ar1\(2:6:2\)"
1263+gdb_test "print ar2\(2:6:2,3:4\)" \
1264+ "\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \
1265+ "print ar2\(2:6:2,3:4\)"
1266+gdb_test "print ar2\(2:6:2,3\)" \
1267+ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \
1268+ "print ar2\(2:6:2,3\)"
1269+gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \
1270+ "\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\)\
1271+ \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \
1272+ "print ar3\(2:6:2,3:5:2,4:7:3\)"
1273+gdb_test "print ar3\(2:6:2,5,4:7:3\)" \
1274+ "\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\)\
1275+ \\)" \
1276+ "print ar3\(2:6:2,5,4:7:3\)"
1277+
1278+# Stride < 0
1279+gdb_test "print ar1\(8:2:-2\)" \
1280+ "\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \
1281+ "print ar1\(8:2:-2\)"
1282+gdb_test "print ar2\(8:2:-2,3:4\)" \
1283+ "\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\)\
1284+ \\)" \
1285+ "print ar2\(8:2:-2,3:4\)"
1286+gdb_test "print ar2\(2:6:2,3\)" \
1287+ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \
1288+ "print ar2\(2:6:2,3\)"
1289+gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \
1290+ "\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\(\
1291+ \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \
1292+ "print ar3\(2:3,7:3:-4,4:7:3\)"
1293+gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \
1294+ "\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\)\
1295+ \\)" \
1296+ "print ar3\(2:6:2,5,7:4:-3\)"
1297+
1298+# Tests with negative and mixed indices
1299+gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \
1300+ "\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\)\
1301+ \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262,\
1302+ 362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292,\
1303+ 392, 492\\) \\) \\)" \
1304+ "print ar4(2:4, -2:1, -15:-14)"
1305+
1306+gdb_test "p ar4\(7,-6:2:3,-7\)" \
1307+ "\\$\[0-9\]+ = \\(729, 759, 789\\)" \
1308+ "print ar4(7,-6:2:3,-7)"
1309+
1310+gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \
1311+ "\\$\[0-9\]+ = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760,\
1312+ 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727,\
1313+ 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587,\
1314+ 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554,\
1315+ 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521,\
1316+ 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\)\
1317+ \\)" \
1318+ "print ar4(9:2:-2, -6:2:3, -6:-15:-3)"
1319+
1320+gdb_test "p ar4\(:,:,:\)" \
1321+ "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711,\
1322+ 811, .*" \
1323+ "print ar4(:,:,:)"
1324+
1325+# Provoke error messages for bad user input
1326+gdb_test "print ar1\(0:4\)" \
1327+ "provided bound\\(s\\) outside array bound\\(s\\)" \
1328+ "print ar1\(0:4\)"
1329+gdb_test "print ar1\(8:12\)" \
1330+ "provided bound\\(s\\) outside array bound\\(s\\)" \
1331+ "print ar1\(8:12\)"
1332+gdb_test "print ar1\(8:2:\)" \
1333+ "A syntax error in expression, near `\\)'." \
1334+ "print ar1\(8:2:\)"
1335+gdb_test "print ar1\(8:2:2\)" \
1336+ "Wrong value provided for stride and boundaries" \
1337+ "print ar1\(8:2:2\)"
1338+gdb_test "print ar1\(2:8:-2\)" \
1339+ "Wrong value provided for stride and boundaries" \
1340+ "print ar1\(2:8:-2\)"
1341+gdb_test "print ar1\(2:7:0\)" \
1342+ "Stride must not be 0" \
1343+ "print ar1\(2:7:0\)"
1344+gdb_test "print ar1\(3:7\) = 42" \
1345+ "Invalid cast." \
1346+ "Assignment of value to subarray"
4b0e5c1b
AM
1347diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90
1348new file mode 100644
4b0e5c1b
AM
1349--- /dev/null
1350+++ b/gdb/testsuite/gdb.fortran/static-arrays.f90
140f8057
JR
1351@@ -0,0 +1,55 @@
1352+! Copyright 2015 Free Software Foundation, Inc.
1353+!
1354+! Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
1355+!
1356+! This program is free software; you can redistribute it and/or modify
1357+! it under the terms of the GNU General Public License as published by
1358+! the Free Software Foundation; either version 3 of the License, or
1359+! (at your option) any later version.
1360+!
1361+! This program is distributed in the hope that it will be useful,
1362+! but WITHOUT ANY WARRANTY; without even the implied warranty of
1363+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1364+! GNU General Public License for more details.
1365+!
1366+! You should have received a copy of the GNU General Public License
1367+! along with this program. If not, see <http://www.gnu.org/licenses/>.
1368+
1369+subroutine sub
1370+ integer, dimension(9) :: ar1
1371+ integer, dimension(9,9) :: ar2
1372+ integer, dimension(9,9,9) :: ar3
1373+ integer, dimension(10,-7:3, -15:-5) :: ar4
1374+ integer :: i,j,k
1375+
1376+ ar1 = 1
1377+ ar2 = 1
1378+ ar3 = 1
1379+ ar4 = 4
1380+
1381+ ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...)))
1382+ do i = 1, 9, 1
1383+ ar1(i) = i
1384+ do j = 1, 9, 1
1385+ ar2(i,j) = i*10 + j
1386+ do k = 1, 9, 1
1387+ ar3(i,j,k) = i*100 + j*10 + k
1388+ end do
1389+ end do
1390+ end do
1391+
1392+ do i = 1, 10, 1
1393+ do j = -7, 3, 1
1394+ do k = -15, -5, 1
1395+ ar4(i,j,k) = i*100 + (j+8)*10 + (k+16)
1396+ end do
1397+ end do
1398+ end do
1399+
1400+ ar1(1) = 11 !BP1
1401+ return
1402+end
1403+
1404+program testprog
1405+ call sub
1406+end
4b0e5c1b 1407diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
4b0e5c1b
AM
1408--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
1409+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
174fe25c 1410@@ -35,7 +35,8 @@ gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1"
e28f2cc1
AM
1411 gdb_test "print sizeof(vla1(3,2,1))" \
1412 "no such vector element \\(vector not allocated\\)" \
1413 "print sizeof non-allocated indexed vla1"
1414-gdb_test "print sizeof(vla1(3:4,2,1))" "array not allocated" \
1415+gdb_test "print sizeof(vla1(3:4,2,1))" \
1416+ "provided bound\\(s\\) outside array bound\\(s\\)" \
1417 "print sizeof non-allocated sliced vla1"
1418
1419 # Try to access value in allocated VLA
174fe25c 1420@@ -44,7 +45,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
e28f2cc1
AM
1421 gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
1422 gdb_test "print sizeof(vla1(3,2,1))" "4" \
1423 "print sizeof element from allocated vla1"
1424-gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
1425+gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
1426 "print sizeof sliced vla1"
1427
1428 # Try to access values in undefined pointer to VLA (dangling)
174fe25c 1429@@ -52,7 +53,8 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
e28f2cc1
AM
1430 gdb_test "print sizeof(pvla(3,2,1))" \
1431 "no such vector element \\(vector not associated\\)" \
1432 "print sizeof non-associated indexed pvla"
1433-gdb_test "print sizeof(pvla(3:4,2,1))" "array not associated" \
1434+gdb_test "print sizeof(pvla(3:4,2,1))" \
1435+ "provided bound\\(s\\) outside array bound\\(s\\)" \
1436 "print sizeof non-associated sliced pvla"
1437
1438 # Try to access values in pointer to VLA and compare them
174fe25c 1439@@ -61,7 +63,8 @@ gdb_continue_to_breakpoint "pvla-associated"
140f8057 1440 gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
e28f2cc1
AM
1441 gdb_test "print sizeof(pvla(3,2,1))" "4" \
1442 "print sizeof element from associated pvla"
1443-gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
140f8057 1444+
e28f2cc1
AM
1445+gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
1446
1447 gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
1448 gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
4b0e5c1b
AM
1449diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
1450new file mode 100644
4b0e5c1b
AM
1451--- /dev/null
1452+++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
e28f2cc1 1453@@ -0,0 +1,47 @@
140f8057
JR
1454+# Copyright 2016 Free Software Foundation, Inc.
1455+
1456+# This program is free software; you can redistribute it and/or modify
1457+# it under the terms of the GNU General Public License as published by
1458+# the Free Software Foundation; either version 3 of the License, or
1459+# (at your option) any later version.
1460+#
1461+# This program is distributed in the hope that it will be useful,
1462+# but WITHOUT ANY WARRANTY; without even the implied warranty of
1463+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1464+# GNU General Public License for more details.
1465+#
1466+# You should have received a copy of the GNU General Public License
1467+# along with this program. If not, see <http://www.gnu.org/licenses/>.
1468+
1469+standard_testfile ".f90"
1470+
1471+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1472+ {debug f90 quiet}] } {
1473+ return -1
1474+}
1475+
1476+if ![runto MAIN__] then {
1477+ perror "couldn't run to breakpoint MAIN__"
1478+ continue
1479+}
1480+
e28f2cc1
AM
1481+gdb_test_no_output "set max-value-size unlimited" \
1482+ "set max-value-size to unlimited"
1483+
140f8057
JR
1484+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
1485+gdb_continue_to_breakpoint "re-reverse-elements"
1486+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
1487+ "print re-reverse-elements"
1488+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
1489+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
1490+
1491+gdb_breakpoint [gdb_get_line_number "odd-elements"]
1492+gdb_continue_to_breakpoint "odd-elements"
1493+gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
1494+gdb_test "print pvla(1)" " = 1" "print first odd-element"
1495+gdb_test "print pvla(5)" " = 9" "print last odd-element"
1496+
1497+gdb_breakpoint [gdb_get_line_number "single-element"]
1498+gdb_continue_to_breakpoint "single-element"
1499+gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
1500+gdb_test "print pvla(1)" " = 5" "print one single-element"
4b0e5c1b
AM
1501diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
1502new file mode 100644
4b0e5c1b
AM
1503--- /dev/null
1504+++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
140f8057
JR
1505@@ -0,0 +1,29 @@
1506+! Copyright 2016 Free Software Foundation, Inc.
1507+!
1508+! This program is free software; you can redistribute it and/or modify
1509+! it under the terms of the GNU General Public License as published by
1510+! the Free Software Foundation; either version 3 of the License, or
1511+! (at your option) any later version.
1512+!
1513+! This program is distributed in the hope that it will be useful,
1514+! but WITHOUT ANY WARRANTY; without even the implied warranty of
1515+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1516+! GNU General Public License for more details.
1517+!
1518+! You should have received a copy of the GNU General Public License
1519+! along with this program. If not, see <http://www.gnu.org/licenses/>.
1520+
1521+program vla_stride
1522+ integer, target, allocatable :: vla (:)
1523+ integer, pointer :: pvla (:)
1524+
1525+ allocate(vla(10))
1526+ vla = (/ (I, I = 1,10) /)
1527+
1528+ pvla => vla(10:1:-1)
1529+ pvla => pvla(10:1:-1)
1530+ pvla => vla(1:10:2) ! re-reverse-elements
1531+ pvla => vla(5:4:-2) ! odd-elements
1532+
1533+ pvla => null() ! single-element
1534+end program vla_stride
4b0e5c1b 1535diff --git a/gdb/valops.c b/gdb/valops.c
4b0e5c1b
AM
1536--- a/gdb/valops.c
1537+++ b/gdb/valops.c
174fe25c 1538@@ -3756,13 +3756,42 @@ value_of_this_silent (const struct language_defn *lang)
4b0e5c1b 1539
140f8057
JR
1540 struct value *
1541 value_slice (struct value *array, int lowbound, int length)
4b0e5c1b 1542+{
140f8057
JR
1543+ /* Pass unaltered arguments to VALUE_SLICE_1, plus a default stride
1544+ value of '1', which returns every element between LOWBOUND and
1545+ (LOWBOUND + LENGTH). We also provide a default CALL_COUNT of '1'
1546+ as we are only considering the highest dimension, or we are
1547+ working on a one dimensional array. So we call VALUE_SLICE_1
1548+ exactly once. */
1549+ return value_slice_1 (array, lowbound, length, 1, 1);
1550+}
1551+
1552+/* VALUE_SLICE_1 is called for each array dimension to calculate the number
1553+ of elements as defined by the subscript expression.
1554+ CALL_COUNT is used to determine if we are calling the function once, e.g.
1555+ we are working on the current dimension of ARRAY, or if we are calling
1556+ the function repeatedly. In the later case we need to take elements
1557+ from the TARGET_TYPE of ARRAY.
1558+ With a CALL_COUNT greater than 1 we calculate the offsets for every element
1559+ that should be in the result array. Then we fetch the contents and then
1560+ copy them into the result array. The result array will have one dimension
1561+ less than the input array, so later on we need to recreate the indices and
1562+ ranges in the calling function. */
1563+
1564+struct value *
1565+value_slice_1 (struct value *array, int lowbound, int length,
1566+ int stride_length, int call_count)
4b0e5c1b 1567 {
140f8057
JR
1568 struct type *slice_range_type, *slice_type, *range_type;
1569- LONGEST lowerbound, upperbound;
1570- struct value *slice;
1571- struct type *array_type;
1572+ struct type *array_type = check_typedef (value_type (array));
1573+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
1574+ unsigned int elt_size, elt_offs;
1575+ LONGEST ary_high_bound, ary_low_bound;
1576+ struct value *v;
1577+ int slice_range_size, i = 0, row_count = 1, elem_count = 1;
1578
1579- array_type = check_typedef (value_type (array));
1580+ /* Check for legacy code if we are actually dealing with an array or
1581+ string. */
174fe25c
JP
1582 if (array_type->code () != TYPE_CODE_ARRAY
1583 && array_type->code () != TYPE_CODE_STRING)
140f8057 1584 error (_("cannot take slice of non-array"));
174fe25c 1585@@ -3772,45 +3801,155 @@ value_slice (struct value *array, int lowbound, int length)
e28f2cc1
AM
1586 if (type_not_associated (array_type))
1587 error (_("array not associated"));
140f8057 1588
174fe25c
JP
1589- range_type = array_type->index_type ();
1590- if (!get_discrete_bounds (range_type, &lowerbound, &upperbound))
140f8057 1591- error (_("slice from bad array or bitstring"));
174fe25c
JP
1592+ ary_low_bound = array_type->index_type ()->bounds ()->low.const_val ();
1593+ ary_high_bound = array_type->index_type ()->bounds ()->high.const_val ();
140f8057
JR
1594+
1595+ /* When we are working on a multi-dimensional array, we need to get the
1596+ attributes of the underlying type. */
1597+ if (call_count > 1)
1598+ {
174fe25c
JP
1599+ ary_low_bound = elt_type->index_type ()->bounds ()->low.const_val ();
1600+ ary_high_bound = elt_type->index_type ()->bounds ()->high.const_val ();
140f8057
JR
1601+ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
1602+ row_count = TYPE_LENGTH (array_type)
1603+ / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
1604+ }
1605+
1606+ /* With a stride of '1', the number of elements per result row is equal to
1607+ the LENGTH of the subarray. With non-default stride values, we skip
1608+ elements, but have to add the start element to the total number of
1609+ elements per row. */
1610+ if (stride_length == 1)
1611+ elem_count = length;
1612+ else
1613+ elem_count = ((length - 1) / stride_length) + 1;
1614+
1615+ elt_size = TYPE_LENGTH (elt_type);
1616+ elt_offs = lowbound - ary_low_bound;
174fe25c
JP
1617+
1618+ elt_offs *= elt_size;
4b0e5c1b
AM
1619
1620- if (lowbound < lowerbound || length < 0
1621- || lowbound + length - 1 > upperbound)
1622- error (_("slice out of range"));
140f8057
JR
1623+ /* Check for valid user input. In case of Fortran this was already done
1624+ in the calling function. */
1625+ if (call_count == 1
1626+ && (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
1627+ && elt_offs >= TYPE_LENGTH (array_type)))
1628+ error (_("no such vector element"));
1629+
1630+ /* CALL_COUNT is 1 when we are dealing either with the highest dimension
1631+ of the array, or a one dimensional array. Set RANGE_TYPE accordingly.
1632+ In both cases we calculate how many rows/elements will be in the output
1633+ array by setting slice_range_size. */
1634+ if (call_count == 1)
1635+ {
174fe25c 1636+ range_type = array_type->index_type ();
140f8057
JR
1637+ slice_range_size = ary_low_bound + elem_count - 1;
1638+
1639+ /* Check if the array bounds are valid. */
1640+ if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0)
1641+ error (_("slice from bad array or bitstring"));
1642+ }
1643+ /* When CALL_COUNT is greater than 1, we are dealing with an array of arrays.
1644+ So we need to get the type below the current one and set the RANGE_TYPE
1645+ accordingly. */
1646+ else
1647+ {
174fe25c 1648+ range_type = TYPE_TARGET_TYPE (array_type)->index_type ();
140f8057 1649+ slice_range_size = ary_low_bound + (row_count * elem_count) - 1;
174fe25c 1650+ ary_low_bound = range_type->bounds ()->low.const_val ();
140f8057
JR
1651+ }
1652
1653 /* FIXME-type-allocation: need a way to free this type when we are
1654- done with it. */
e28f2cc1 1655- slice_range_type = create_static_range_type (NULL,
140f8057
JR
1656- TYPE_TARGET_TYPE (range_type),
1657- lowbound,
1658- lowbound + length - 1);
1659+ done with it. */
1660
1661+ slice_range_type = create_static_range_type (NULL, TYPE_TARGET_TYPE (range_type),
1662+ ary_low_bound, slice_range_size);
1663 {
1664- struct type *element_type = TYPE_TARGET_TYPE (array_type);
1665- LONGEST offset
1666- = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type));
140f8057 1667+ struct type *element_type;
174fe25c
JP
1668
1669- slice_type = create_array_type (NULL,
1670- element_type,
1671- slice_range_type);
1672- slice_type->set_code (array_type->code ());
140f8057
JR
1673+ /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy
1674+ code for subarrays. */
1675+ if (call_count == 1 && stride_length == 1)
1676+ {
1677+ element_type = TYPE_TARGET_TYPE (array_type);
1678+
1679+ slice_type = create_array_type (NULL, element_type, slice_range_type);
174fe25c
JP
1680+
1681+ slice_type->set_code (array_type->code ());
4b0e5c1b
AM
1682
1683- if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
1684- slice = allocate_value_lazy (slice_type);
140f8057
JR
1685+ if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
1686+ v = allocate_value_lazy (slice_type);
1687+ else
1688+ {
1689+ v = allocate_value (slice_type);
1690+ value_contents_copy (v,
1691+ value_embedded_offset (v),
1692+ array,
1693+ value_embedded_offset (array) + elt_offs,
1694+ elt_size * longest_to_int (length));
1695+ }
4b0e5c1b 1696+
140f8057
JR
1697+ }
1698+ /* With a CALL_COUNT or STRIDE_LENGTH are greater than 1 we are working
1699+ on a range of ranges. So we copy the relevant elements into the
1700+ new array we return. */
1701 else
1702 {
1703- slice = allocate_value (slice_type);
1704- value_contents_copy (slice, 0, array, offset,
1705- type_length_units (slice_type));
1706+ int j, offs_store = elt_offs;
1707+ LONGEST dst_offset = 0;
1708+ LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
1709+
1710+ if (call_count == 1)
1711+ {
1712+ /* When CALL_COUNT is equal to 1 we are working on the current range
1713+ and use these elements directly. */
1714+ element_type = TYPE_TARGET_TYPE (array_type);
1715+ }
1716+ else
1717+ {
1718+ /* Working on an array of arrays, the type of the elements is the type
1719+ of the subarrays' type. */
1720+ element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type));
1721+ }
1722+
1723+ slice_type = create_array_type (NULL, element_type, slice_range_type);
1724+
174fe25c
JP
1725+ /* If we have a one dimensional array, we copy its type code. For a
1726+ multi dimensional array we copy the embedded type's type code. */
140f8057 1727+ if (call_count == 1)
174fe25c 1728+ slice_type->set_code (array_type->code ());
140f8057 1729+ else
174fe25c 1730+ slice_type->set_code ((TYPE_TARGET_TYPE (array_type)->code ()));
140f8057
JR
1731+
1732+ v = allocate_value (slice_type);
1733+
1734+ /* Iterate through the rows of the outer array and set the new offset
1735+ for each row. */
1736+ for (i = 0; i < row_count; i++)
1737+ {
1738+ elt_offs = offs_store + i * src_row_length;
1739+
1740+ /* Iterate through the elements in each row to copy only those. */
1741+ for (j = 1; j <= elem_count; j++)
1742+ {
1743+ /* Fetches the contents of ARRAY and copies them into V. */
1744+ value_contents_copy (v, dst_offset, array, elt_offs, elt_size);
1745+ elt_offs += elt_size * stride_length;
1746+ dst_offset += elt_size;
1747+ }
1748+ }
1749 }
1750
1751- set_value_component_location (slice, array);
1752- set_value_offset (slice, value_offset (array) + offset);
1753+ set_value_component_location (v, array);
1754+ if (VALUE_LVAL (v) == lval_register)
1755+ {
1756+ VALUE_REGNUM (v) = VALUE_REGNUM (array);
1757+ VALUE_NEXT_FRAME_ID (v) = VALUE_NEXT_FRAME_ID (array);
1758+ }
1759+ set_value_offset (v, value_offset (array) + elt_offs);
1760 }
1761
1762- return slice;
1763+ return v;
1764 }
1765
174fe25c 1766 /* See value.h. */
4b0e5c1b 1767diff --git a/gdb/value.h b/gdb/value.h
4b0e5c1b
AM
1768--- a/gdb/value.h
1769+++ b/gdb/value.h
174fe25c 1770@@ -1144,6 +1144,8 @@ extern struct value *varying_to_slice (struct value *);
140f8057
JR
1771
1772 extern struct value *value_slice (struct value *, int, int);
1773
1774+extern struct value *value_slice_1 (struct value *, int, int, int, int);
1775+
174fe25c
JP
1776 /* Create a complex number. The type is the complex type; the values
1777 are cast to the underlying scalar type before the complex number is
1778 created. */
This page took 0.277851 seconds and 4 git commands to generate.