* [PATCH 0/5] Fortran: Array strides
@ 2017-09-11 12:58 Tim Wiederhake
2017-09-11 12:58 ` [PATCH 1/5] Fortran: Move calc_f77_array_dims Tim Wiederhake
` (4 more replies)
0 siblings, 5 replies; 11+ messages in thread
From: Tim Wiederhake @ 2017-09-11 12:58 UTC (permalink / raw)
To: gdb-patches
Hi all,
this series adds support for multi-dimensional strides in Fortran.
A previous version of this series can be found here:
https://sourceware.org/ml/gdb-patches/2015-12/msg00008.html
1| program prog
2| integer :: ary(10,5) = (/ (i,i=1,10) (j, j=1,5) /)
3| end program prog
Before:
(gdb) print ary(2:4,1:3)
A syntax error in expression near ':3'.
(gdb) print ary(::2,1)
A syntax error in expression, near `:2,1)'.
After:
(gdb) print ary(2:4,1:3)
$1 = ( ( 21, 31, 41) ( 22, 32, 42) ( 23, 33, 43) )
(gdb) print ary(::2,1)
$2 = (11, 31, 51, 71, 91)
Regards,
Tim
*** BLURB HERE ***
Christoph Weinmann (3):
Fortran: Allow multi-dimensional subarrays.
Fortran: Change subrange enum to bit field.
Fortran: Enable parsing of stride parameter for subranges.
Tim Wiederhake (2):
Fortran: Move calc_f77_array_dims.
Fortran: Move value_f90_subarray.
gdb/eval.c | 101 +---------
gdb/expprint.c | 20 +-
gdb/expression.h | 17 +-
gdb/f-exp.y | 42 +++-
gdb/f-lang.c | 250 +++++++++++++++++++++++
gdb/f-lang.h | 15 +-
gdb/f-valprint.c | 2 +-
gdb/parse.c | 24 ++-
gdb/rust-exp.y | 12 +-
gdb/rust-lang.c | 17 +-
gdb/testsuite/gdb.fortran/static-arrays.exp | 297 ++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/static-arrays.f90 | 53 +++++
12 files changed, 690 insertions(+), 160 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.exp
create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.f90
--
2.7.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCH 4/5] Fortran: Change subrange enum to bit field.
2017-09-11 12:58 [PATCH 0/5] Fortran: Array strides Tim Wiederhake
2017-09-11 12:58 ` [PATCH 1/5] Fortran: Move calc_f77_array_dims Tim Wiederhake
2017-09-11 12:58 ` [PATCH 5/5] Fortran: Enable parsing of stride parameter for subranges Tim Wiederhake
@ 2017-09-11 12:58 ` Tim Wiederhake
2017-09-15 22:29 ` Simon Marchi
2017-09-11 12:58 ` [PATCH 2/5] Fortran: Move value_f90_subarray Tim Wiederhake
2017-09-11 12:58 ` [PATCH 3/5] Fortran: Allow multi-dimensional subarrays Tim Wiederhake
4 siblings, 1 reply; 11+ messages in thread
From: Tim Wiederhake @ 2017-09-11 12:58 UTC (permalink / raw)
To: gdb-patches; +Cc: Christoph Weinmann
From: Christoph Weinmann <christoph.t.weinmann@intel.com>
Change Fortran subrange enum for subrange expressions to represent a bitfield
for easier manipulation. Consequently also change occurences and evaluation
of said enum. The behaviour of GDB is unchanged.
xxxx-yy-zz Christoph Weinmann <christoph.t.weinmann@intel.com>
Tim Wiederhake <tim.wiederhake@intel.com>
* expprint.c (print_subexp_standard): Use bitfield instead of enum.
(dump_subexp_body_standard): Same.
* f-exp.y (subrange): Same.
* f-lang.c (f90_value_subarray): Same.
* parse.c (operator_length_standard): Same.
* rust-exp.y: Same.
* rust-lang.c (rust_range, rust_compute_range, rust_subscript): Same.
* expression.h (enum range_type): Turn into a bitfield.
---
gdb/expprint.c | 20 ++++++++------------
gdb/expression.h | 15 ++++++---------
gdb/f-exp.y | 11 ++++++-----
gdb/f-lang.c | 8 ++++----
gdb/parse.c | 21 ++++++++-------------
gdb/rust-exp.y | 12 +++---------
gdb/rust-lang.c | 17 ++++++++---------
7 files changed, 43 insertions(+), 61 deletions(-)
diff --git a/gdb/expprint.c b/gdb/expprint.c
index 9e04f24..19d1c88 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -581,12 +581,10 @@ print_subexp_standard (struct expression *exp, int *pos,
*pos += 2;
fputs_filtered ("RANGE(", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if ((range_type & SUBARRAY_LOW_BOUND) != 0)
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered ("..", stream);
- if (range_type == LOW_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if ((range_type & SUBARRAY_HIGH_BOUND) != 0)
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
@@ -1093,16 +1091,16 @@ dump_subexp_body_standard (struct expression *exp,
switch (range_type)
{
- case BOTH_BOUND_DEFAULT:
+ case SUBARRAY_NO_BOUND:
fputs_filtered ("Range '..'", stream);
break;
- case LOW_BOUND_DEFAULT:
+ case SUBARRAY_HIGH_BOUND:
fputs_filtered ("Range '..EXP'", stream);
break;
- case HIGH_BOUND_DEFAULT:
+ case SUBARRAY_LOW_BOUND:
fputs_filtered ("Range 'EXP..'", stream);
break;
- case NONE_BOUND_DEFAULT:
+ case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND):
fputs_filtered ("Range 'EXP..EXP'", stream);
break;
default:
@@ -1110,11 +1108,9 @@ dump_subexp_body_standard (struct expression *exp,
break;
}
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if ((range_type & SUBARRAY_LOW_BOUND) != 0)
elt = dump_subexp (exp, stream, elt);
- if (range_type == LOW_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if ((range_type & SUBARRAY_HIGH_BOUND) != 0)
elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 9e4ddf5..c794198 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -155,17 +155,14 @@ extern void dump_raw_expression (struct expression *,
struct ui_file *, const char *);
extern void dump_prefix_expression (struct expression *, struct ui_file *);
-/* In an OP_RANGE expression, either bound could be empty, indicating
- that its value is by default that of the corresponding bound of the
- array or string. So we have four sorts of subrange. This
- enumeration type is to identify this. */
-
+/* Flags to indicate which boundarys are set in an OP_RANGE expression. Values
+ can be or'ed together. */
+
enum range_type
{
- BOTH_BOUND_DEFAULT, /* "(:)" */
- LOW_BOUND_DEFAULT, /* "(:high)" */
- HIGH_BOUND_DEFAULT, /* "(low:)" */
- NONE_BOUND_DEFAULT /* "(low:high)" */
+ SUBARRAY_NO_BOUND = 0x0, /* "( : )" */
+ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */
+ SUBARRAY_HIGH_BOUND = 0x2 /* "(:high)" */
};
#endif /* !defined (EXPRESSION_H) */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index bfa9d09..96b9b05 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -261,26 +261,27 @@ arglist : arglist ',' exp %prec ABOVE_COMMA
/* There are four sorts of subrange types in F90. */
subrange: exp ':' exp %prec ABOVE_COMMA
- { write_exp_elt_opcode (pstate, OP_RANGE);
- write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
+ { write_exp_elt_opcode (pstate, OP_RANGE);
+ write_exp_elt_longcst (pstate,
+ SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND);
write_exp_elt_opcode (pstate, OP_RANGE); }
;
subrange: exp ':' %prec ABOVE_COMMA
{ write_exp_elt_opcode (pstate, OP_RANGE);
- write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND);
write_exp_elt_opcode (pstate, OP_RANGE); }
;
subrange: ':' exp %prec ABOVE_COMMA
{ write_exp_elt_opcode (pstate, OP_RANGE);
- write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
+ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND);
write_exp_elt_opcode (pstate, OP_RANGE); }
;
subrange: ':' %prec ABOVE_COMMA
{ write_exp_elt_opcode (pstate, OP_RANGE);
- write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
+ write_exp_elt_longcst (pstate, SUBARRAY_NO_BOUND);
write_exp_elt_opcode (pstate, OP_RANGE); }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 25bb758..832a3e7 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -503,9 +503,9 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos,
*pos += 3;
- if (type == HIGH_BOUND_DEFAULT || type == NONE_BOUND_DEFAULT)
+ if ((type & SUBARRAY_LOW_BOUND) != 0)
lo = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
- if (type == LOW_BOUND_DEFAULT || type == NONE_BOUND_DEFAULT)
+ if ((type & SUBARRAY_HIGH_BOUND) != 0)
hi = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
subscript_array.emplace_back (type, lo, hi);
@@ -533,9 +533,9 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos,
if (it->kind == subscript::SUBSCRIPT_RANGE)
{
- if (it->type == LOW_BOUND_DEFAULT || it->type == BOTH_BOUND_DEFAULT)
+ if ((it->type & SUBARRAY_LOW_BOUND) == 0)
it->low = lo;
- if (it->type == HIGH_BOUND_DEFAULT || it->type == BOTH_BOUND_DEFAULT)
+ if ((it->type & SUBARRAY_HIGH_BOUND) == 0)
it->high = hi;
if (it->low < lo || it->low > hi || it->high < lo || it->high > hi)
diff --git a/gdb/parse.c b/gdb/parse.c
index fb0dff2..dcf1b31 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -1001,22 +1001,17 @@ operator_length_standard (const struct expression *expr, int endpos,
case OP_RANGE:
oplen = 3;
+ args = 0;
range_type = (enum range_type)
longest_to_int (expr->elts[endpos - 2].longconst);
- switch (range_type)
- {
- case LOW_BOUND_DEFAULT:
- case HIGH_BOUND_DEFAULT:
- args = 1;
- break;
- case BOTH_BOUND_DEFAULT:
- args = 0;
- break;
- case NONE_BOUND_DEFAULT:
- args = 2;
- break;
- }
+ /* Increment the argument counter for each argument
+ provided by the user. */
+ if ((range_type & SUBARRAY_LOW_BOUND) != 0)
+ args++;
+
+ if ((range_type & SUBARRAY_HIGH_BOUND) != 0)
+ args++;
break;
diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
index 4cb3aa2..9adcae5 100644
--- a/gdb/rust-exp.y
+++ b/gdb/rust-exp.y
@@ -2460,23 +2460,17 @@ convert_ast_to_expression (struct parser_state *state,
case OP_RANGE:
{
- enum range_type kind = BOTH_BOUND_DEFAULT;
+ enum range_type kind = SUBARRAY_NO_BOUND;
if (operation->left.op != NULL)
{
convert_ast_to_expression (state, operation->left.op, top);
- kind = HIGH_BOUND_DEFAULT;
+ kind = (range_type) (kind | SUBARRAY_LOW_BOUND);
}
if (operation->right.op != NULL)
{
convert_ast_to_expression (state, operation->right.op, top);
- if (kind == BOTH_BOUND_DEFAULT)
- kind = LOW_BOUND_DEFAULT;
- else
- {
- gdb_assert (kind == HIGH_BOUND_DEFAULT);
- kind = NONE_BOUND_DEFAULT;
- }
+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND);
}
write_exp_elt_opcode (state, OP_RANGE);
write_exp_elt_longcst (state, kind);
diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
index c5764bf..45005fd5 100644
--- a/gdb/rust-lang.c
+++ b/gdb/rust-lang.c
@@ -1311,9 +1311,9 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
*pos += 3;
- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT)
+ if ((kind & SUBARRAY_LOW_BOUND) != 0)
low = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- if (kind == LOW_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT)
+ if ((kind & SUBARRAY_HIGH_BOUND) != 0)
high = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
@@ -1402,7 +1402,7 @@ rust_compute_range (struct type *type, struct value *range,
*low = 0;
*high = 0;
- *kind = BOTH_BOUND_DEFAULT;
+ *kind = SUBARRAY_NO_BOUND;
if (TYPE_NFIELDS (type) == 0)
return;
@@ -1410,15 +1410,14 @@ rust_compute_range (struct type *type, struct value *range,
i = 0;
if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0)
{
- *kind = HIGH_BOUND_DEFAULT;
+ *kind = SUBARRAY_LOW_BOUND;
*low = value_as_long (value_field (range, 0));
++i;
}
if (TYPE_NFIELDS (type) > i
&& strcmp (TYPE_FIELD_NAME (type, i), "end") == 0)
{
- *kind = (*kind == BOTH_BOUND_DEFAULT
- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
+ *kind = (range_type) (*kind | SUBARRAY_HIGH_BOUND);
*high = value_as_long (value_field (range, i));
}
}
@@ -1433,7 +1432,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
struct type *rhstype;
LONGEST low, high_bound;
/* Initialized to appease the compiler. */
- enum range_type kind = BOTH_BOUND_DEFAULT;
+ enum range_type kind = SUBARRAY_NO_BOUND;
LONGEST high = 0;
int want_slice = 0;
@@ -1495,7 +1494,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
error (_("Cannot subscript non-array type"));
if (want_slice
- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT))
+ && ((kind & SUBARRAY_LOW_BOUND) == 0))
low = low_bound;
if (low < 0)
error (_("Index less than zero"));
@@ -1513,7 +1512,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
CORE_ADDR addr;
struct value *addrval, *tem;
- if (kind == BOTH_BOUND_DEFAULT || kind == HIGH_BOUND_DEFAULT)
+ if ((kind & SUBARRAY_HIGH_BOUND) == 0)
high = high_bound;
if (high < 0)
error (_("High index less than zero"));
--
2.7.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCH 1/5] Fortran: Move calc_f77_array_dims.
2017-09-11 12:58 [PATCH 0/5] Fortran: Array strides Tim Wiederhake
@ 2017-09-11 12:58 ` Tim Wiederhake
2017-09-15 20:22 ` Simon Marchi
2017-09-11 12:58 ` [PATCH 5/5] Fortran: Enable parsing of stride parameter for subranges Tim Wiederhake
` (3 subsequent siblings)
4 siblings, 1 reply; 11+ messages in thread
From: Tim Wiederhake @ 2017-09-11 12:58 UTC (permalink / raw)
To: gdb-patches
2017-09-11 Tim Wiederhake <tim.wiederhake@intel.com>
gdb/ChangeLog:
* eval.c (evaluate_subexp_standard): Use new function name.
(calc_f77_array_dims): Move ...
* f-lang.c (f77_get_array_dims): ... here. Constify argument. Make
NULL check explicit.
* f-lang.h (calc_f77_arra_dims): Rename to...
(f77_get_array_dims): ... this. Add comment.
* f-valprint.c (f77_print_array): Use new function name.
---
gdb/eval.c | 21 +--------------------
gdb/f-lang.c | 16 ++++++++++++++++
gdb/f-lang.h | 4 +++-
gdb/f-valprint.c | 2 +-
4 files changed, 21 insertions(+), 22 deletions(-)
diff --git a/gdb/eval.c b/gdb/eval.c
index 24f32f8..7a808a0 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -2336,7 +2336,7 @@ evaluate_subexp_standard (struct type *expect_type,
if (nargs > MAX_FORTRAN_DIMS)
error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
- ndimensions = calc_f77_array_dims (type);
+ ndimensions = f77_get_array_dims (type);
if (nargs != ndimensions)
error (_("Wrong number of subscripts"));
@@ -3266,22 +3266,3 @@ parse_and_eval_type (char *p, int length)
error (_("Internal error in eval_type."));
return expr->elts[1].type;
}
-
-int
-calc_f77_array_dims (struct type *array_type)
-{
- int ndimen = 1;
- struct type *tmp_type;
-
- if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
- error (_("Can't get dimensions for a non-array type"));
-
- tmp_type = array_type;
-
- while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
- {
- if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
- ++ndimen;
- }
- return ndimen;
-}
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 903cfd1..77b759b 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -370,3 +370,19 @@ _initialize_f_language (void)
{
f_type_data = gdbarch_data_register_post_init (build_fortran_types);
}
+
+/* See f-lang.h. */
+
+int
+f77_get_array_dims (const struct type *array_type)
+{
+ if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
+ error (_("Can't get dimensions for a non-array type"));
+
+ int ndimen = 0;
+ for (; array_type != NULL; array_type = TYPE_TARGET_TYPE (array_type))
+ if (TYPE_CODE (array_type) == TYPE_CODE_ARRAY)
+ ndimen += 1;
+
+ return ndimen;
+}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 5633b41..cfe667b 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -55,7 +55,9 @@ extern int f77_get_lowerbound (struct type *);
extern void f77_get_dynamic_array_length (struct type *);
-extern int calc_f77_array_dims (struct type *);
+/* Calculate the number of dimensions of an array. Expects ARRAY_TYPE to be
+ * the type of an array. */
+extern int f77_get_array_dims (const struct type *array_type);
/* Fortran (F77) types */
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 8fc894a..59d1a2f 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -180,7 +180,7 @@ f77_print_array (struct type *type, const gdb_byte *valaddr,
int ndimensions;
int elts = 0;
- ndimensions = calc_f77_array_dims (type);
+ ndimensions = f77_get_array_dims (type);
if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
error (_("\
--
2.7.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCH 3/5] Fortran: Allow multi-dimensional subarrays.
2017-09-11 12:58 [PATCH 0/5] Fortran: Array strides Tim Wiederhake
` (3 preceding siblings ...)
2017-09-11 12:58 ` [PATCH 2/5] Fortran: Move value_f90_subarray Tim Wiederhake
@ 2017-09-11 12:58 ` Tim Wiederhake
2017-09-15 22:08 ` Simon Marchi
4 siblings, 1 reply; 11+ messages in thread
From: Tim Wiederhake @ 2017-09-11 12:58 UTC (permalink / raw)
To: gdb-patches; +Cc: Christoph Weinmann
From: Christoph Weinmann <christoph.t.weinmann@intel.com>
1| program prog
2| integer :: ary(10,5) = (/ (i,i=1,10) (j, j=1,5) /)
3| end program prog
Before:
(gdb) print ary(2:4,1:3)
Syntax error in expression near ':3'
After:
(gdb) print ary(2:4,1:3)
$1 = ( ( 21, 31, 41) ( 22, 32, 42) ( 23, 33, 43) )
xxxx-yy-zz Christoph Weinmann <christoph.t.weinmann@intel.com>
Tim Wiederhake <tim.wiederhake@intel.com>
gdb/ChangeLog:
* eval.c (evaluate_subexp_standard): Treat strings and arrays the same.
* f-exp.y (arglist): Add subrange expression.
* f-lang.c (f77_get_array_dims): Strings have one dimension.
(f90_value_slice): New function.
(f90_value_subarray): New parameter. Allow multi-dimensional subarrays.
* f-lang.h (f90_value_subarray): New parameter.
gdb/testsuite/ChangeLog:
* gdb.fortran/static-arrays.exp: New file.
* gdb.fortran/static-arrays.f90: New file.
---
gdb/eval.c | 56 +-----
gdb/f-exp.y | 2 +
gdb/f-lang.c | 215 ++++++++++++++++++++--
gdb/f-lang.h | 10 +-
gdb/testsuite/gdb.fortran/static-arrays.exp | 275 ++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/static-arrays.f90 | 44 +++++
6 files changed, 528 insertions(+), 74 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.exp
create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.f90
diff --git a/gdb/eval.c b/gdb/eval.c
index 557ac02..8a4687a 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -1889,19 +1889,8 @@ evaluate_subexp_standard (struct type *expect_type,
switch (code)
{
case TYPE_CODE_ARRAY:
- if (exp->elts[*pos].opcode == OP_RANGE)
- return f90_value_subarray (arg1, exp, pos, noside);
- else
- goto multi_f77_subscript;
-
case TYPE_CODE_STRING:
- if (exp->elts[*pos].opcode == OP_RANGE)
- return f90_value_subarray (arg1, exp, pos, noside);
- else
- {
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- return value_subscript (arg1, value_as_long (arg2));
- }
+ return f90_value_subarray (arg1, exp, pos, nargs, noside);
case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
@@ -2301,49 +2290,6 @@ evaluate_subexp_standard (struct type *expect_type,
}
return (arg1);
- multi_f77_subscript:
- {
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1, i;
- struct value *array = arg1;
-
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
-
- ndimensions = f77_get_array_dims (type);
-
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
-
- gdb_assert (nargs > 0);
-
- /* Now that we know we have a legal array subscript expression
- let us actually find out where this element exists in the array. */
-
- /* Take array indices left to right. */
- for (i = 0; i < nargs; i++)
- {
- /* Evaluate each subscript; it must be a legal integer in F77. */
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
-
- /* Fill in the subscript array. */
-
- subscript_array[i] = value_as_long (arg2);
- }
-
- /* Internal type of array is arranged right to left. */
- for (i = nargs; i > 0; i--)
- {
- struct type *array_type = check_typedef (value_type (array));
- LONGEST index = subscript_array[i - 1];
-
- array = value_subscripted_rvalue (array, index,
- f77_get_lowerbound (array_type));
- }
-
- return array;
- }
-
case BINOP_LOGICAL_AND:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 8dcc811..bfa9d09 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -254,6 +254,8 @@ arglist : subrange
arglist : arglist ',' exp %prec ABOVE_COMMA
{ arglist_len++; }
+ | arglist ',' subrange %prec ABOVE_COMMA
+ { arglist_len++; }
;
/* There are four sorts of subrange types in F90. */
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 63caf65..25bb758 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -376,6 +376,9 @@ _initialize_f_language (void)
int
f77_get_array_dims (const struct type *array_type)
{
+ if (TYPE_CODE (array_type) == TYPE_CODE_STRING)
+ return 1;
+
if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
error (_("Can't get dimensions for a non-array type"));
@@ -387,29 +390,209 @@ f77_get_array_dims (const struct type *array_type)
return ndimen;
}
+/* F90_VALUE_SLICE is called for each array dimension to calculate the number
+ of elements as defined by the subscript expression
+ array(SLICE_LOW : SLICE_LOW + SLICE_LEN).
+ MULTI_DIM is used to determine if we are working on a one-dimensional or
+ multi-dimensional array. The latter case happens in all slicing operations
+ following the first subscript that is a range, as a range subscript does not
+ decrease the number of dimensions of an array. */
+
+static struct value *
+f90_value_slice (struct value *src_array, LONGEST slice_low, LONGEST slice_len,
+ bool multi_dim)
+{
+ /* If the array is not multidimensional, we use the generic code path to
+ generate the slice. */
+ if (!multi_dim)
+ return value_slice (src_array, slice_low, slice_len);
+
+ type *const src_ary_type = check_typedef (value_type (src_array));
+ type *const src_row_type = check_typedef (TYPE_TARGET_TYPE (src_ary_type));
+ type *const src_elm_type = check_typedef (TYPE_TARGET_TYPE (src_row_type));
+ type *const src_idx_type = check_typedef (TYPE_INDEX_TYPE (src_row_type));
+ const LONGEST slice_offset = slice_low - TYPE_LOW_BOUND (src_idx_type);
+ const LONGEST row_count
+ = TYPE_LENGTH (src_ary_type) / TYPE_LENGTH (src_row_type);
+
+ /* FIXME-type-allocation: need a way to free this type when we are
+ done with it. */
+ type *const dst_rng_type
+ = create_static_range_type (NULL, TYPE_TARGET_TYPE (src_idx_type),
+ TYPE_LOW_BOUND (src_idx_type),
+ TYPE_LOW_BOUND (src_idx_type)
+ + slice_len * row_count - 1);
+
+ type *const dst_ary_type
+ = create_array_type (NULL, TYPE_TARGET_TYPE (src_row_type), dst_rng_type);
+
+ TYPE_CODE (dst_ary_type) = TYPE_CODE (src_row_type);
+ value *const dst_array = allocate_value (dst_ary_type);
+
+ for (LONGEST i = 0; i < row_count; ++i)
+ {
+ const LONGEST dst_offset = TYPE_LENGTH (src_elm_type) * i * slice_len;
+
+ const LONGEST src_offset
+ = TYPE_LENGTH (src_row_type) * i
+ + TYPE_LENGTH (src_elm_type) * slice_offset;
+
+ value_contents_copy (dst_array, dst_offset, src_array, src_offset,
+ TYPE_LENGTH (src_elm_type) * slice_len);
+ }
+
+ const LONGEST offset
+ = TYPE_LENGTH (src_row_type) * row_count
+ + TYPE_LENGTH (src_elm_type) * slice_offset;
+
+ set_value_component_location (dst_array, src_array);
+ set_value_offset (dst_array, value_offset (src_array) + offset);
+
+ return dst_array;
+}
+
/* See f-lang.h. */
struct value *
f90_value_subarray (struct value *array, struct expression *exp, int *pos,
- enum noside noside)
+ int nargs, enum noside noside)
{
- int pc = (*pos) + 1;
- LONGEST low_bound, high_bound;
- struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
- enum range_type range_type
- = (enum range_type) longest_to_int (exp->elts[pc].longconst);
+ /* Local struct to hold user data for Fortran subarray dimensions. */
+ struct subscript
+ {
+ enum
+ {
+ SUBSCRIPT_INDEX, /* e.g. "(literal)" */
+ SUBSCRIPT_RANGE /* e.g. "(lowbound:highbound)" */
+ } kind;
+
+ union
+ {
+ /* If KIND == SUBSCRIPT_INDEX. */
+ LONGEST index;
+
+ /* If KIND == SUBSCRIPT_RANGE. */
+ struct {
+ int type;
+ LONGEST low;
+ LONGEST high;
+ };
+ };
+
+ subscript (LONGEST index_) : kind (SUBSCRIPT_INDEX), index (index_) {}
+
+ subscript (int type_, LONGEST low_, LONGEST high_) :
+ kind (SUBSCRIPT_RANGE), type (type_), low (low_), high (high_) {}
+ };
+
+ if (nargs != f77_get_array_dims (value_type (array)))
+ error (_("Wrong number of subscripts"));
+
+ /* Parse the user input into SUBSCRIPT_ARRAY for later use. We need to parse
+ it fully first, as evaluation is performed right-to-left. */
+ std::vector<subscript> subscript_array;
+ for (int i = 0; i < nargs; i++)
+ {
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ {
+ /* User input is a range, with or without lower and upper bound,
+ e.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc. */
+ const int type = longest_to_int (exp->elts[*pos + 1].longconst);
+ LONGEST lo = 0;
+ LONGEST hi = 0;
+
+ *pos += 3;
+
+ if (type == HIGH_BOUND_DEFAULT || type == NONE_BOUND_DEFAULT)
+ lo = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ if (type == LOW_BOUND_DEFAULT || type == NONE_BOUND_DEFAULT)
+ hi = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+
+ subscript_array.emplace_back (type, lo, hi);
+ }
+ else
+ {
+ /* User input is an index, e.g.: "p arry(5)". The subscript must be
+ a legal integer in F77. */
+ value *const val = evaluate_subexp_with_coercion (exp, pos, noside);
+ subscript_array.emplace_back (value_as_long (val));
+ }
+ }
- *pos += 3;
+ /* Traverse the array from right to left and evaluate each corresponding
+ user input. */
+ bool multi_dim = false;
+ const type *array_type = check_typedef (value_type (array));
+ value *new_array = array;
+ for (auto it = subscript_array.rbegin (); it != subscript_array.rend ();
+ array_type = TYPE_TARGET_TYPE (array_type), ++it)
+ {
+ const type *const index_type = TYPE_INDEX_TYPE (array_type);
+ const LONGEST lo = TYPE_LOW_BOUND (index_type);
+ const LONGEST hi = TYPE_HIGH_BOUND (index_type);
- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
- low_bound = TYPE_LOW_BOUND (range);
- else
- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ if (it->kind == subscript::SUBSCRIPT_RANGE)
+ {
+ if (it->type == LOW_BOUND_DEFAULT || it->type == BOTH_BOUND_DEFAULT)
+ it->low = lo;
+ if (it->type == HIGH_BOUND_DEFAULT || it->type == BOTH_BOUND_DEFAULT)
+ it->high = hi;
+
+ if (it->low < lo || it->low > hi || it->high < lo || it->high > hi)
+ error (_("slice out of range"));
+
+ if (it->high - it->low + 1 < 0)
+ error (_("slice out of range"));
+
+ new_array = f90_value_slice (new_array, it->low,
+ it->high - it->low + 1,
+ multi_dim);
+
+ /* A range subscript does not decrease the number of dimensions in
+ array. Therefore we cannot use VALUE_SUBSCRIPTED_RVALUE anymore
+ after we encountered the first range, as we now operate on an
+ array of arrays. */
+ multi_dim = true;
+ }
+ else
+ {
+ if (!multi_dim)
+ {
+ const int lo = f77_get_lowerbound (value_type (new_array));
+ new_array = value_subscripted_rvalue (new_array, it->index, lo);
+ continue;
+ }
- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
- high_bound = TYPE_HIGH_BOUND (range);
- else
- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ if (it->index < lo || it->index > hi)
+ error (_("no such vector element"));
+
+ new_array = f90_value_slice (new_array, it->index, 1, multi_dim);
+ }
+ }
+
+ /* If we did not encounter any range subscript, the result is ready to go. */
+ if (!multi_dim)
+ return new_array;
+
+ /* After slicing, NEW_ARRAY is a flat, one-dimensional array. If we had any
+ range subscripts, we have to rebuild the dimensions with respect to the
+ stride size. */
+ type *elt_type = TYPE_TARGET_TYPE (value_type (new_array));
+ for (const subscript& s : subscript_array)
+ {
+ if (s.kind == subscript::SUBSCRIPT_INDEX)
+ continue;
+
+ type *const range_type =
+ create_static_range_type (NULL, elt_type, s.low, s.high);
+ type *const interim_array_type =
+ create_array_type (NULL, elt_type, range_type);
+
+ TYPE_CODE (interim_array_type) = TYPE_CODE (value_type (new_array));
+ array = allocate_value (interim_array_type);
+ elt_type = value_type (array);
+ }
- return value_slice (array, low_bound, high_bound - low_bound + 1);
+ value_contents_copy (array, 0, new_array, 0, TYPE_LENGTH (elt_type));
+ return array;
}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 013ea5e..0b25db2 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -59,11 +59,15 @@ extern void f77_get_dynamic_array_length (struct type *);
* the type of an array. */
extern int f77_get_array_dims (const struct type *array_type);
-/* Evaluates any subarray operation on Fortran arrays with at least one user
- provided parameter. Expects the input ARRAY to be an array. */
+/* Evaluates any subarray operation on Fortran arrays or strings with at least
+ one user provided parameter. Expects the input ARRAY to be either an array
+ or a string. Evaluates EXP by incrementing *POS. NARGS specifies number of
+ arguments the user provided and must be the same number as ARRAY has
+ dimensions. */
extern struct value *f90_value_subarray (struct value *array,
struct expression *exp,
- int *pos, enum noside noside);
+ int *pos, int nargs,
+ enum noside noside);
/* Fortran (F77) types */
diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp
new file mode 100644
index 0000000..0a9f1ab
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/static-arrays.exp
@@ -0,0 +1,275 @@
+# Copyright 2017 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+if { [skip_fortran_tests] } {
+ return -1
+}
+
+standard_testfile static-arrays.f90
+
+if { [prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90}] } {
+ return -1
+}
+
+if ![runto MAIN__] then {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "BP1"]
+gdb_continue_to_breakpoint "BP1" ".*BP1.*"
+
+
+# Test subranges of one-dimensional arrays
+gdb_test "p ar1" " = \\(1, 2, 3, 4\\)"
+gdb_test "p ar1\(2:3\)" " = \\(2, 3\\)"
+gdb_test "p ar1\(2: \)" " = \\(2, 3, 4\\)"
+gdb_test "p ar1\( :3\)" " = \\(1, 2, 3\\)"
+gdb_test "p ar1\( : \)" " = \\(1, 2, 3, 4\\)"
+gdb_test "p ar1\( 3 \)" " = 3"
+
+
+# Test subranges of two-dimensional arrays
+gdb_test "p ar2\(2:3,3:4\)" " = \\(\\( 23, 33\\) \\( 24, 34\\) \\)"
+gdb_test "p ar2\(2:3,3: \)" " = \\(\\( 23, 33\\) \\( 24, 34\\) \\)"
+gdb_test "p ar2\(2:3, :2\)" " = \\(\\( 21, 31\\) \\( 22, 32\\) \\)"
+gdb_test "p ar2\(2:3, : \)" " = \\(\\( 21, 31\\) \\( 22, 32\\) \\( 23, 33\\) \\( 24, 34\\) \\)"
+gdb_test "p ar2\(2:3, 4 \)" " = \\(24, 34\\)"
+
+gdb_test "p ar2\(3: ,3:4\)" " = \\(\\( 33, 43\\) \\( 34, 44\\) \\)"
+gdb_test "p ar2\(3: ,3: \)" " = \\(\\( 33, 43\\) \\( 34, 44\\) \\)"
+gdb_test "p ar2\(3: , :2\)" " = \\(\\( 31, 41\\) \\( 32, 42\\) \\)"
+gdb_test "p ar2\(3: , : \)" " = \\(\\( 31, 41\\) \\( 32, 42\\) \\( 33, 43\\) \\( 34, 44\\) \\)"
+gdb_test "p ar2\(3: , 4 \)" " = \\(34, 44\\)"
+
+gdb_test "p ar2\( :2,2:3\)" " = \\(\\( 12, 22\\) \\( 13, 23\\) \\)"
+gdb_test "p ar2\( :2,3: \)" " = \\(\\( 13, 23\\) \\( 14, 24\\) \\)"
+gdb_test "p ar2\( :2, :2\)" " = \\(\\( 11, 21\\) \\( 12, 22\\) \\)"
+gdb_test "p ar2\( :2, : \)" " = \\(\\( 11, 21\\) \\( 12, 22\\) \\( 13, 23\\) \\( 14, 24\\) \\)"
+gdb_test "p ar2\( :2, 4 \)" " = \\(14, 24\\)"
+
+gdb_test "p ar2\( 1 ,1:2\)" " = \\(11, 12\\)"
+gdb_test "p ar2\( 1 ,2: \)" " = \\(12, 13, 14\\)"
+gdb_test "p ar2\( 1 , :2\)" " = \\(11, 12\\)"
+gdb_test "p ar2\( 1 , : \)" " = \\(11, 12, 13, 14\\)"
+gdb_test "p ar2\( 1 , 4 \)" " = 14"
+
+gdb_test "p ar2\( : ,3:4\)" " = \\(\\( 13, 23, 33, 43\\) \\( 14, 24, 34, 44\\) \\)"
+gdb_test "p ar2\( : ,3: \)" " = \\(\\( 13, 23, 33, 43\\) \\( 14, 24, 34, 44\\) \\)"
+gdb_test "p ar2\( : , :4\)" " = \\(\\( 11, 21, 31, 41\\) \\( 12, 22, 32, 42\\) \\( 13, 23, 33, 43\\) \\( 14, 24, 34, 44\\) \\)"
+gdb_test "p ar2\( : , : \)" " = \\(\\( 11, 21, 31, 41\\) \\( 12, 22, 32, 42\\) \\( 13, 23, 33, 43\\) \\( 14, 24, 34, 44\\) \\)"
+gdb_test "p ar2\( : , 2 \)" " = \\(12, 22, 32, 42\\)"
+
+
+# Test subarrays of 3 dimensional arrays
+gdb_test "p ar3\(1:2,2:3,3:4\)" " = \\(\\( \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\(1:2,2:3,3: \)" " = \\(\\( \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\(1:2,2:3, :4\)" " = \\(\\( \\( 121, 221\\) \\( 131, 231\\) \\) \\( \\( 122, 222\\) \\( 132, 232\\) \\) \\( \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\(1:2,2:3, : \)" " = \\(\\( \\( 121, 221\\) \\( 131, 231\\) \\) \\( \\( 122, 222\\) \\( 132, 232\\) \\) \\( \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\(1:2,2:3, 1 \)" " = \\(\\( 121, 221\\) \\( 131, 231\\) \\)"
+
+gdb_test "p ar3\(1:2,2: ,3:4\)" " = \\(\\( \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\(1:2,2: ,3: \)" " = \\(\\( \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\(1:2,2: , :4\)" " = \\(\\( \\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\) \\( \\( 122, 222\\) \\( 132, 232\\) \\( 142, 242\\) \\) \\( \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\(1:2,2: , : \)" " = \\(\\( \\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\) \\( \\( 122, 222\\) \\( 132, 232\\) \\( 142, 242\\) \\) \\( \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\(1:2,2: , 1 \)" " = \\(\\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\)"
+
+gdb_test "p ar3\(1:2, :3,3:4\)" " = \\(\\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\(1:2, :3,3: \)" " = \\(\\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\(1:2, :3, :4\)" " = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\) \\( \\( 112, 212\\) \\( 122, 222\\) \\( 132, 232\\) \\) \\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\(1:2, :3, : \)" " = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\) \\( \\( 112, 212\\) \\( 122, 222\\) \\( 132, 232\\) \\) \\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\(1:2, :3, 1 \)" " = \\(\\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\)"
+
+gdb_test "p ar3\(1:2, : ,3:4\)" " = \\(\\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\(1:2, : ,3: \)" " = \\(\\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\(1:2, : , :4\)" " = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\) \\( \\( 112, 212\\) \\( 122, 222\\) \\( 132, 232\\) \\( 142, 242\\) \\) \\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\(1:2, : , : \)" " = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\) \\( \\( 112, 212\\) \\( 122, 222\\) \\( 132, 232\\) \\( 142, 242\\) \\) \\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\(1:2, : , 1 \)" " = \\(\\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\)"
+
+gdb_test "p ar3\(1:2, 2 ,3:4\)" " = \\(\\( 123, 223\\) \\( 124, 224\\) \\)"
+gdb_test "p ar3\(1:2, 2 ,3: \)" " = \\(\\( 123, 223\\) \\( 124, 224\\) \\)"
+gdb_test "p ar3\(1:2, 2 , :4\)" " = \\(\\( 121, 221\\) \\( 122, 222\\) \\( 123, 223\\) \\( 124, 224\\) \\)"
+gdb_test "p ar3\(1:2, 2 , : \)" " = \\(\\( 121, 221\\) \\( 122, 222\\) \\( 123, 223\\) \\( 124, 224\\) \\)"
+gdb_test "p ar3\(1:2, 2 , 1 \)" " = \\(121, 221\\)"
+
+
+gdb_test "p ar3\(1: ,2:3,3:4\)" " = \\(\\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\(1: ,2:3,3: \)" " = \\(\\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\(1: ,2:3, :4\)" " = \\(\\( \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\) \\( \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\) \\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\(1: ,2:3, : \)" " = \\(\\( \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\) \\( \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\) \\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\(1: ,2:3, 1 \)" " = \\(\\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\)"
+
+gdb_test "p ar3\(1: ,2: ,3:4\)" " = \\(\\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\(1: ,2: ,3: \)" " = \\(\\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\(1: ,2: , :4\)" " = \\(\\( \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\) \\( \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\( 142, 242, 342, 442\\) \\) \\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\(1: ,2: , : \)" " = \\(\\( \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\) \\( \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\( 142, 242, 342, 442\\) \\) \\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\(1: ,2: , 1 \)" " = \\(\\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\)"
+
+gdb_test "p ar3\(1: , :3,3:4\)" " = \\(\\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\(1: , :3,3: \)" " = \\(\\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\(1: , :3, :4\)" " = \\(\\( \\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\) \\( \\( 112, 212, 312, 412\\) \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\) \\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\(1: , :3, : \)" " = \\(\\( \\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\) \\( \\( 112, 212, 312, 412\\) \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\) \\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\(1: , :3, 1 \)" " = \\(\\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\)"
+
+gdb_test "p ar3\(1: , : ,3:4\)" " = \\(\\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\(1: , : ,3: \)" " = \\(\\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\(1: , : , :4\)" " = \\(\\( \\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\) \\( \\( 112, 212, 312, 412\\) \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\( 142, 242, 342, 442\\) \\) \\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\(1: , : , : \)" " = \\(\\( \\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\) \\( \\( 112, 212, 312, 412\\) \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\( 142, 242, 342, 442\\) \\) \\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\(1: , : , 1 \)" " = \\(\\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\)"
+
+gdb_test "p ar3\(1: , 2 ,3:4\)" " = \\(\\( 123, 223, 323, 423\\) \\( 124, 224, 324, 424\\) \\)"
+gdb_test "p ar3\(1: , 2 ,3: \)" " = \\(\\( 123, 223, 323, 423\\) \\( 124, 224, 324, 424\\) \\)"
+gdb_test "p ar3\(1: , 2 , :4\)" " = \\(\\( 121, 221, 321, 421\\) \\( 122, 222, 322, 422\\) \\( 123, 223, 323, 423\\) \\( 124, 224, 324, 424\\) \\)"
+gdb_test "p ar3\(1: , 2 , : \)" " = \\(\\( 121, 221, 321, 421\\) \\( 122, 222, 322, 422\\) \\( 123, 223, 323, 423\\) \\( 124, 224, 324, 424\\) \\)"
+gdb_test "p ar3\(1: , 2 , 1 \)" " = \\(121, 221, 321, 421\\)"
+
+
+gdb_test "p ar3\( :2,2:3,3:4\)" " = \\(\\( \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\( :2,2:3,3: \)" " = \\(\\( \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\( :2,2:3, :4\)" " = \\(\\( \\( 121, 221\\) \\( 131, 231\\) \\) \\( \\( 122, 222\\) \\( 132, 232\\) \\) \\( \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\( :2,2:3, : \)" " = \\(\\( \\( 121, 221\\) \\( 131, 231\\) \\) \\( \\( 122, 222\\) \\( 132, 232\\) \\) \\( \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\( :2,2:3, 1 \)" " = \\(\\( 121, 221\\) \\( 131, 231\\) \\)"
+
+gdb_test "p ar3\( :2,2: ,3:4\)" " = \\(\\( \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\( :2,2: ,3: \)" " = \\(\\( \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\( :2,2: , :4\)" " = \\(\\( \\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\) \\( \\( 122, 222\\) \\( 132, 232\\) \\( 142, 242\\) \\) \\( \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\( :2,2: , : \)" " = \\(\\( \\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\) \\( \\( 122, 222\\) \\( 132, 232\\) \\( 142, 242\\) \\) \\( \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\( :2,2: , 1 \)" " = \\(\\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\)"
+
+gdb_test "p ar3\( :2, :3,3:4\)" " = \\(\\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\( :2, :3,3: \)" " = \\(\\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\( :2, :3, :4\)" " = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\) \\( \\( 112, 212\\) \\( 122, 222\\) \\( 132, 232\\) \\) \\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\( :2, :3, : \)" " = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\) \\( \\( 112, 212\\) \\( 122, 222\\) \\( 132, 232\\) \\) \\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\) \\)"
+gdb_test "p ar3\( :2, :3, 1 \)" " = \\(\\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\)"
+
+gdb_test "p ar3\( :2, : ,3:4\)" " = \\(\\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\( :2, : ,3: \)" " = \\(\\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\( :2, : , :4\)" " = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\) \\( \\( 112, 212\\) \\( 122, 222\\) \\( 132, 232\\) \\( 142, 242\\) \\) \\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\( :2, : , : \)" " = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\) \\( \\( 112, 212\\) \\( 122, 222\\) \\( 132, 232\\) \\( 142, 242\\) \\) \\( \\( 113, 213\\) \\( 123, 223\\) \\( 133, 233\\) \\( 143, 243\\) \\) \\( \\( 114, 214\\) \\( 124, 224\\) \\( 134, 234\\) \\( 144, 244\\) \\) \\)"
+gdb_test "p ar3\( :2, : , 1 \)" " = \\(\\( 111, 211\\) \\( 121, 221\\) \\( 131, 231\\) \\( 141, 241\\) \\)"
+
+gdb_test "p ar3\( :2, 2 ,3:4\)" " = \\(\\( 123, 223\\) \\( 124, 224\\) \\)"
+gdb_test "p ar3\( :2, 2 ,3: \)" " = \\(\\( 123, 223\\) \\( 124, 224\\) \\)"
+gdb_test "p ar3\( :2, 2 , :4\)" " = \\(\\( 121, 221\\) \\( 122, 222\\) \\( 123, 223\\) \\( 124, 224\\) \\)"
+gdb_test "p ar3\( :2, 2 , : \)" " = \\(\\( 121, 221\\) \\( 122, 222\\) \\( 123, 223\\) \\( 124, 224\\) \\)"
+gdb_test "p ar3\( :2, 2 , 1 \)" " = \\(121, 221\\)"
+
+
+gdb_test "p ar3\( : ,2:3,3:4\)" " = \\(\\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\( : ,2:3,3: \)" " = \\(\\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\( : ,2:3, :4\)" " = \\(\\( \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\) \\( \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\) \\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\( : ,2:3, : \)" " = \\(\\( \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\) \\( \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\) \\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\( : ,2:3, 1 \)" " = \\(\\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\)"
+
+gdb_test "p ar3\( : ,2: ,3:4\)" " = \\(\\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\( : ,2: ,3: \)" " = \\(\\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\( : ,2: , :4\)" " = \\(\\( \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\) \\( \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\( 142, 242, 342, 442\\) \\) \\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\( : ,2: , : \)" " = \\(\\( \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\) \\( \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\( 142, 242, 342, 442\\) \\) \\( \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\( : ,2: , 1 \)" " = \\(\\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\)"
+
+gdb_test "p ar3\( : , :3,3:4\)" " = \\(\\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\( : , :3,3: \)" " = \\(\\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\( : , :3, :4\)" " = \\(\\( \\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\) \\( \\( 112, 212, 312, 412\\) \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\) \\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\( : , :3, : \)" " = \\(\\( \\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\) \\( \\( 112, 212, 312, 412\\) \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\) \\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\) \\)"
+gdb_test "p ar3\( : , :3, 1 \)" " = \\(\\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\)"
+
+gdb_test "p ar3\( : , : ,3:4\)" " = \\(\\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\( : , : ,3: \)" " = \\(\\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\( : , : , :4\)" " = \\(\\( \\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\) \\( \\( 112, 212, 312, 412\\) \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\( 142, 242, 342, 442\\) \\) \\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\( : , : , : \)" " = \\(\\( \\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\) \\( \\( 112, 212, 312, 412\\) \\( 122, 222, 322, 422\\) \\( 132, 232, 332, 432\\) \\( 142, 242, 342, 442\\) \\) \\( \\( 113, 213, 313, 413\\) \\( 123, 223, 323, 423\\) \\( 133, 233, 333, 433\\) \\( 143, 243, 343, 443\\) \\) \\( \\( 114, 214, 314, 414\\) \\( 124, 224, 324, 424\\) \\( 134, 234, 334, 434\\) \\( 144, 244, 344, 444\\) \\) \\)"
+gdb_test "p ar3\( : , : , 1 \)" " = \\(\\( 111, 211, 311, 411\\) \\( 121, 221, 321, 421\\) \\( 131, 231, 331, 431\\) \\( 141, 241, 341, 441\\) \\)"
+
+gdb_test "p ar3\( : , 2 ,3:4\)" " = \\(\\( 123, 223, 323, 423\\) \\( 124, 224, 324, 424\\) \\)"
+gdb_test "p ar3\( : , 2 ,3: \)" " = \\(\\( 123, 223, 323, 423\\) \\( 124, 224, 324, 424\\) \\)"
+gdb_test "p ar3\( : , 2 , :4\)" " = \\(\\( 121, 221, 321, 421\\) \\( 122, 222, 322, 422\\) \\( 123, 223, 323, 423\\) \\( 124, 224, 324, 424\\) \\)"
+gdb_test "p ar3\( : , 2 , : \)" " = \\(\\( 121, 221, 321, 421\\) \\( 122, 222, 322, 422\\) \\( 123, 223, 323, 423\\) \\( 124, 224, 324, 424\\) \\)"
+gdb_test "p ar3\( : , 2 , 1 \)" " = \\(121, 221, 321, 421\\)"
+
+
+gdb_test "p ar3\( 1 ,2:3,3:4\)" " = \\(\\( 123, 133\\) \\( 124, 134\\) \\)"
+gdb_test "p ar3\( 1 ,2:3,3: \)" " = \\(\\( 123, 133\\) \\( 124, 134\\) \\)"
+gdb_test "p ar3\( 1 ,2:3, :4\)" " = \\(\\( 121, 131\\) \\( 122, 132\\) \\( 123, 133\\) \\( 124, 134\\) \\)"
+gdb_test "p ar3\( 1 ,2:3, : \)" " = \\(\\( 121, 131\\) \\( 122, 132\\) \\( 123, 133\\) \\( 124, 134\\) \\)"
+gdb_test "p ar3\( 1 ,2:3, 1 \)" " = \\(121, 131\\)"
+
+gdb_test "p ar3\( 1 ,2: ,3:4\)" " = \\(\\( 123, 133, 143\\) \\( 124, 134, 144\\) \\)"
+gdb_test "p ar3\( 1 ,2: ,3: \)" " = \\(\\( 123, 133, 143\\) \\( 124, 134, 144\\) \\)"
+gdb_test "p ar3\( 1 ,2: , :4\)" " = \\(\\( 121, 131, 141\\) \\( 122, 132, 142\\) \\( 123, 133, 143\\) \\( 124, 134, 144\\) \\)"
+gdb_test "p ar3\( 1 ,2: , : \)" " = \\(\\( 121, 131, 141\\) \\( 122, 132, 142\\) \\( 123, 133, 143\\) \\( 124, 134, 144\\) \\)"
+gdb_test "p ar3\( 1 ,2: , 1 \)" " = \\(121, 131, 141\\)"
+
+gdb_test "p ar3\( 1 , :3,3:4\)" " = \\(\\( 113, 123, 133\\) \\( 114, 124, 134\\) \\)"
+gdb_test "p ar3\( 1 , :3,3: \)" " = \\(\\( 113, 123, 133\\) \\( 114, 124, 134\\) \\)"
+gdb_test "p ar3\( 1 , :3, :4\)" " = \\(\\( 111, 121, 131\\) \\( 112, 122, 132\\) \\( 113, 123, 133\\) \\( 114, 124, 134\\) \\)"
+gdb_test "p ar3\( 1 , :3, : \)" " = \\(\\( 111, 121, 131\\) \\( 112, 122, 132\\) \\( 113, 123, 133\\) \\( 114, 124, 134\\) \\)"
+gdb_test "p ar3\( 1 , :3, 1 \)" " = \\(111, 121, 131\\)"
+
+gdb_test "p ar3\( 1 , : ,3:4\)" " = \\(\\( 113, 123, 133, 143\\) \\( 114, 124, 134, 144\\) \\)"
+gdb_test "p ar3\( 1 , : ,3: \)" " = \\(\\( 113, 123, 133, 143\\) \\( 114, 124, 134, 144\\) \\)"
+gdb_test "p ar3\( 1 , : , :4\)" " = \\(\\( 111, 121, 131, 141\\) \\( 112, 122, 132, 142\\) \\( 113, 123, 133, 143\\) \\( 114, 124, 134, 144\\) \\)"
+gdb_test "p ar3\( 1 , : , : \)" " = \\(\\( 111, 121, 131, 141\\) \\( 112, 122, 132, 142\\) \\( 113, 123, 133, 143\\) \\( 114, 124, 134, 144\\) \\)"
+gdb_test "p ar3\( 1 , : , 1 \)" " = \\(111, 121, 131, 141\\)"
+
+gdb_test "p ar3\( 1 , 2 ,3:4\)" " = \\(123, 124\\)"
+gdb_test "p ar3\( 1 , 2 ,3: \)" " = \\(123, 124\\)"
+gdb_test "p ar3\( 1 , 2 , :4\)" " = \\(121, 122, 123, 124\\)"
+gdb_test "p ar3\( 1 , 2 , : \)" " = \\(121, 122, 123, 124\\)"
+gdb_test "p ar3\( 1 , 2 , 1 \)" " = 121"
+
+
+# Check negative indices and slices
+gdb_test "p ar4" " = \\(-4, -3, -2, -1, 0, 1, 2, 3, 4\\)"
+gdb_test "p ar4\(-3:-1\)" " = \\(-3, -2, -1\\)"
+gdb_test "p ar4\(-3: 1\)" " = \\(-3, -2, -1, 0, 1\\)"
+gdb_test "p ar4\(-1: 3\)" " = \\(-1, 0, 1, 2, 3\\)"
+gdb_test "p ar4\(-1: 4\)" " = \\(-1, 0, 1, 2, 3, 4\\)"
+gdb_test "p ar4\(-4: \)" " = \\(-4, -3, -2, -1, 0, 1, 2, 3, 4\\)"
+gdb_test "p ar4\(-3: \)" " = \\(-3, -2, -1, 0, 1, 2, 3, 4\\)"
+gdb_test "p ar4\( 1: \)" " = \\(1, 2, 3, 4\\)"
+gdb_test "p ar4\( 4: \)" " = \\(4\\)"
+gdb_test "p ar4\( :-4\)" " = \\(-4\\)"
+gdb_test "p ar4\( :-3\)" " = \\(-4, -3\\)"
+gdb_test "p ar4\( : 1\)" " = \\(-4, -3, -2, -1, 0, 1\\)"
+gdb_test "p ar4\( : 4\)" " = \\(-4, -3, -2, -1, 0, 1, 2, 3, 4\\)"
+gdb_test "p ar4\( : \)" " = \\(-4, -3, -2, -1, 0, 1, 2, 3, 4\\)"
+gdb_test "p ar4\( -4 \)" " = -4"
+gdb_test "p ar4\( -3 \)" " = -3"
+gdb_test "p ar4\( 1 \)" " = 1"
+gdb_test "p ar4\( 4 \)" " = 4"
+
+
+# Check assignment
+gdb_test_no_output "set \$my_ary = ar1\(2:4\)"
+gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary one"
+gdb_test_no_output "set ar1\(2\) = 1"
+gdb_test "p ar1\(2:4\)" " = \\(1, 3, 4\\)"
+gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary two"
+
+
+# Corner cases and error messages
+gdb_test "p ar1\(\)" "Wrong number of subscripts"
+gdb_test "p ar1\(9\)" "no such vector element"
+gdb_test "p ar1\(0:4\)" "slice out of range"
+gdb_test "p ar1\(2:7\)" "slice out of range"
+gdb_test "p ar1\(3:4\) = 42" "Invalid cast."
+gdb_test "p ar1\(3:3\)" " = \\(3\\)"
+gdb_test "p ar1\(3:2\)" " = \\(\\)"
+gdb_test "p ar1\(3:1\)" "slice out of range"
+gdb_test "p ar2\(3:3, :\)" "\\(\\( 31\\) \\( 32\\) \\( 33\\) \\( 34\\) \\)"
+gdb_test "p ar2\(3:2, :\)" "\\(\\( \\) \\( \\) \\( \\) \\( \\) \\)"
+gdb_test "p ar2\(3:1, :\)" "slice out of range"
+gdb_test "p ar4\(-3:-3\)" " = \\(-3\\)"
+gdb_test "p ar4\(-2:-3\)" " = \\(\\)"
+gdb_test "p ar4\( 1:-1\)" "slice out of range"
diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90
new file mode 100644
index 0000000..a4606b2
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/static-arrays.f90
@@ -0,0 +1,44 @@
+! Copyright 2017 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+subroutine sub
+ integer, dimension(4) :: ar1
+ integer, dimension(4,4) :: ar2
+ integer, dimension(4,4,4) :: ar3
+ integer, dimension(-4:4) :: ar4
+ integer :: i,j,k
+
+ ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...)))
+ do i = 1, 4, 1
+ ar1(i) = i
+ do j = 1, 4, 1
+ ar2(i,j) = i*10 + j
+ do k = 1, 4, 1
+ ar3(i,j,k) = i*100 + j*10 + k
+ end do
+ end do
+ end do
+
+ do i = -4, 4, 1
+ ar4(i) = i
+ end do
+
+ ar1(1) = 11 !BP1
+ return
+end
+
+program testprog
+ call sub
+end
--
2.7.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCH 5/5] Fortran: Enable parsing of stride parameter for subranges.
2017-09-11 12:58 [PATCH 0/5] Fortran: Array strides Tim Wiederhake
2017-09-11 12:58 ` [PATCH 1/5] Fortran: Move calc_f77_array_dims Tim Wiederhake
@ 2017-09-11 12:58 ` Tim Wiederhake
2017-09-11 12:58 ` [PATCH 4/5] Fortran: Change subrange enum to bit field Tim Wiederhake
` (2 subsequent siblings)
4 siblings, 0 replies; 11+ messages in thread
From: Tim Wiederhake @ 2017-09-11 12:58 UTC (permalink / raw)
To: gdb-patches; +Cc: Christoph Weinmann
From: Christoph Weinmann <christoph.t.weinmann@intel.com>
Allow the user to provide a stride parameter for Fortran subarrays.
The stride parameter can be any integer except '0'. The default stride value
is '1'.
xxxx-yy-zz Christoph Weinmann <christoph.t.weinmann@intel.com>
Tim Wiederhake <tim.wiederhake@intel.com>
gdb/ChangeLog:
* expression.h (enum range_type): Add stride flag.
* f-exp.y (subrange): Parse stride values.
* f-lang.c (f90_value_slice, f90_value_subarray): Allow strides != 1.
* parse.c (operator_length_standard): Parse stride values.
gdb/testsuite/ChangeLog:
* gdb.fortran/static-arrays.exp: Add tests for strides.
* gdb.fortran/static-arrays.f90: Same.
---
gdb/expression.h | 8 +--
gdb/f-exp.y | 29 +++++++++++
gdb/f-lang.c | 76 +++++++++++++++++++----------
gdb/parse.c | 3 ++
gdb/testsuite/gdb.fortran/static-arrays.exp | 34 ++++++++++---
gdb/testsuite/gdb.fortran/static-arrays.f90 | 9 ++++
6 files changed, 124 insertions(+), 35 deletions(-)
diff --git a/gdb/expression.h b/gdb/expression.h
index c794198..d1cfe70 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -155,14 +155,16 @@ extern void dump_raw_expression (struct expression *,
struct ui_file *, const char *);
extern void dump_prefix_expression (struct expression *, struct ui_file *);
-/* Flags to indicate which boundarys are set in an OP_RANGE expression. Values
- can be or'ed together. */
+/* Flags to indicate which boundaries are set in an OP_RANGE expression.
+ Additionally, the user can specify a stride. Values can be or'ed
+ together. */
enum range_type
{
SUBARRAY_NO_BOUND = 0x0, /* "( : )" */
SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */
- SUBARRAY_HIGH_BOUND = 0x2 /* "(:high)" */
+ SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */
+ SUBARRAY_STRIDE = 0x4 /* "(::stride)" */
};
#endif /* !defined (EXPRESSION_H) */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 96b9b05..2c0a3d0 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -285,6 +285,35 @@ subrange: ':' %prec ABOVE_COMMA
write_exp_elt_opcode (pstate, OP_RANGE); }
;
+/* Each subrange type can have a stride argument. */
+subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (pstate, OP_RANGE);
+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
+ | SUBARRAY_HIGH_BOUND
+ | SUBARRAY_STRIDE);
+ write_exp_elt_opcode (pstate, OP_RANGE); }
+ ;
+
+subrange: exp ':' ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (pstate, OP_RANGE);
+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
+ | SUBARRAY_STRIDE);
+ write_exp_elt_opcode (pstate, OP_RANGE); }
+ ;
+
+subrange: ':' exp ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (pstate, OP_RANGE);
+ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND
+ | SUBARRAY_STRIDE);
+ write_exp_elt_opcode (pstate, OP_RANGE); }
+ ;
+
+subrange: ':' ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (pstate, OP_RANGE);
+ write_exp_elt_longcst (pstate, SUBARRAY_STRIDE);
+ write_exp_elt_opcode (pstate, OP_RANGE); }
+ ;
+
complexnum: exp ',' exp
{ }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 832a3e7..8064adb 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -392,7 +392,7 @@ f77_get_array_dims (const struct type *array_type)
/* F90_VALUE_SLICE is called for each array dimension to calculate the number
of elements as defined by the subscript expression
- array(SLICE_LOW : SLICE_LOW + SLICE_LEN).
+ array(SLICE_LOW : SLICE_LOW + SLICE_LEN : SLICE_STRIDE).
MULTI_DIM is used to determine if we are working on a one-dimensional or
multi-dimensional array. The latter case happens in all slicing operations
following the first subscript that is a range, as a range subscript does not
@@ -400,20 +400,26 @@ f77_get_array_dims (const struct type *array_type)
static struct value *
f90_value_slice (struct value *src_array, LONGEST slice_low, LONGEST slice_len,
- bool multi_dim)
+ LONGEST slice_stride, bool multi_dim)
{
- /* If the array is not multidimensional, we use the generic code path to
- generate the slice. */
- if (!multi_dim)
+ /* If the array is not multidimensional and the stride is one, we can use
+ generic code to generate the slice. */
+ if (!multi_dim && slice_stride == 1)
return value_slice (src_array, slice_low, slice_len);
+ gdb_assert (slice_stride != 0);
+
type *const src_ary_type = check_typedef (value_type (src_array));
type *const src_row_type = check_typedef (TYPE_TARGET_TYPE (src_ary_type));
- type *const src_elm_type = check_typedef (TYPE_TARGET_TYPE (src_row_type));
- type *const src_idx_type = check_typedef (TYPE_INDEX_TYPE (src_row_type));
+ type *const src_tgt_type = multi_dim ? src_row_type : src_ary_type;
+ type *const src_elm_type = check_typedef (TYPE_TARGET_TYPE (src_tgt_type));
+ type *const src_idx_type = check_typedef (TYPE_INDEX_TYPE (src_tgt_type));
+ const LONGEST num_elements = ((slice_len - 1) / slice_stride) + 1;
const LONGEST slice_offset = slice_low - TYPE_LOW_BOUND (src_idx_type);
const LONGEST row_count
- = TYPE_LENGTH (src_ary_type) / TYPE_LENGTH (src_row_type);
+ = TYPE_LENGTH (src_ary_type) / TYPE_LENGTH (src_tgt_type);
+
+ gdb_assert (num_elements >= 0);
/* FIXME-type-allocation: need a way to free this type when we are
done with it. */
@@ -421,25 +427,28 @@ f90_value_slice (struct value *src_array, LONGEST slice_low, LONGEST slice_len,
= create_static_range_type (NULL, TYPE_TARGET_TYPE (src_idx_type),
TYPE_LOW_BOUND (src_idx_type),
TYPE_LOW_BOUND (src_idx_type)
- + slice_len * row_count - 1);
+ + num_elements * row_count - 1);
type *const dst_ary_type
- = create_array_type (NULL, TYPE_TARGET_TYPE (src_row_type), dst_rng_type);
+ = create_array_type (NULL, TYPE_TARGET_TYPE (src_tgt_type), dst_rng_type);
- TYPE_CODE (dst_ary_type) = TYPE_CODE (src_row_type);
+ TYPE_CODE (dst_ary_type) = TYPE_CODE (src_tgt_type);
value *const dst_array = allocate_value (dst_ary_type);
for (LONGEST i = 0; i < row_count; ++i)
- {
- const LONGEST dst_offset = TYPE_LENGTH (src_elm_type) * i * slice_len;
+ for (LONGEST j = 0; j < num_elements; ++j)
+ {
+ const LONGEST dst_offset
+ = TYPE_LENGTH (src_elm_type) * (j + i * num_elements);
- const LONGEST src_offset
- = TYPE_LENGTH (src_row_type) * i
- + TYPE_LENGTH (src_elm_type) * slice_offset;
+ const LONGEST src_offset
+ = TYPE_LENGTH (src_row_type) * i
+ + TYPE_LENGTH (src_elm_type) * j * slice_stride
+ + TYPE_LENGTH (src_elm_type) * slice_offset;
- value_contents_copy (dst_array, dst_offset, src_array, src_offset,
- TYPE_LENGTH (src_elm_type) * slice_len);
- }
+ value_contents_copy (dst_array, dst_offset, src_array, src_offset,
+ TYPE_LENGTH (src_elm_type));
+ }
const LONGEST offset
= TYPE_LENGTH (src_row_type) * row_count
@@ -476,13 +485,15 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos,
int type;
LONGEST low;
LONGEST high;
+ LONGEST stride;
};
};
subscript (LONGEST index_) : kind (SUBSCRIPT_INDEX), index (index_) {}
- subscript (int type_, LONGEST low_, LONGEST high_) :
- kind (SUBSCRIPT_RANGE), type (type_), low (low_), high (high_) {}
+ subscript (int type_, LONGEST low_, LONGEST high_, LONGEST stride_) :
+ kind (SUBSCRIPT_RANGE), type (type_), low (low_), high (high_),
+ stride (stride_) {}
};
if (nargs != f77_get_array_dims (value_type (array)))
@@ -500,6 +511,7 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos,
const int type = longest_to_int (exp->elts[*pos + 1].longconst);
LONGEST lo = 0;
LONGEST hi = 0;
+ LONGEST stride = 1;
*pos += 3;
@@ -507,8 +519,11 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos,
lo = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
if ((type & SUBARRAY_HIGH_BOUND) != 0)
hi = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ if ((type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
+ stride = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos,
+ noside));
- subscript_array.emplace_back (type, lo, hi);
+ subscript_array.emplace_back (type, lo, hi, stride);
}
else
{
@@ -538,15 +553,22 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos,
if ((it->type & SUBARRAY_HIGH_BOUND) == 0)
it->high = hi;
+ if (it->stride == 0)
+ error (_("Stride must not be 0."));
+
if (it->low < lo || it->low > hi || it->high < lo || it->high > hi)
error (_("slice out of range"));
- if (it->high - it->low + 1 < 0)
+ /* For a negative stride the lower boundary must be greater than the
+ upper boundary. For a positive stride the lower boundary must be
+ less than the upper boundary. */
+ if ((it->stride < 0 && (it->low - it->high - 1 < 0))
+ || (it->stride > 0 && (it->high - it->low + 1 < 0)))
error (_("slice out of range"));
new_array = f90_value_slice (new_array, it->low,
it->high - it->low + 1,
- multi_dim);
+ it->stride, multi_dim);
/* A range subscript does not decrease the number of dimensions in
array. Therefore we cannot use VALUE_SUBSCRIPTED_RVALUE anymore
@@ -566,7 +588,7 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos,
if (it->index < lo || it->index > hi)
error (_("no such vector element"));
- new_array = f90_value_slice (new_array, it->index, 1, multi_dim);
+ new_array = f90_value_slice (new_array, it->index, 1, 1, multi_dim);
}
}
@@ -584,7 +606,9 @@ f90_value_subarray (struct value *array, struct expression *exp, int *pos,
continue;
type *const range_type =
- create_static_range_type (NULL, elt_type, s.low, s.high);
+ create_static_range_type (NULL, elt_type, s.low,
+ s.low + ((s.high - s.low) / s.stride));
+
type *const interim_array_type =
create_array_type (NULL, elt_type, range_type);
diff --git a/gdb/parse.c b/gdb/parse.c
index dcf1b31..2a774ce 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -1013,6 +1013,9 @@ operator_length_standard (const struct expression *expr, int endpos,
if ((range_type & SUBARRAY_HIGH_BOUND) != 0)
args++;
+ if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
+ args++;
+
break;
default:
diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp
index 0a9f1ab..660173a 100644
--- a/gdb/testsuite/gdb.fortran/static-arrays.exp
+++ b/gdb/testsuite/gdb.fortran/static-arrays.exp
@@ -250,12 +250,17 @@ gdb_test "p ar4\( 1 \)" " = 1"
gdb_test "p ar4\( 4 \)" " = 4"
-# Check assignment
-gdb_test_no_output "set \$my_ary = ar1\(2:4\)"
-gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary one"
-gdb_test_no_output "set ar1\(2\) = 1"
-gdb_test "p ar1\(2:4\)" " = \\(1, 3, 4\\)"
-gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary two"
+# Check strides
+gdb_test "p ar5(1:6: 3, 1, -6)" " = \\(200, 500\\)"
+gdb_test "p ar5(1:7: 3, 1, -6)" " = \\(200, 500, 800\\)"
+gdb_test "p ar5(6:1:-3, 1, -6)" " = \\(700, 400\\)"
+gdb_test "p ar5(7:1:-3, 1, -6)" " = \\(800, 500, 200\\)"
+gdb_test "p ar5(1, 1, -6:-12:-3)" " = \\(200, 197, 194\\)"
+gdb_test "p ar5(1, 1, -6:-11:-3)" " = \\(200, 197\\)"
+gdb_test "p ar5(1, 1, -12: -6: 3)" " = \\(194, 197, 200\\)"
+gdb_test "p ar5(1, 1, -11: -6: 3)" " = \\(195, 198\\)"
+
+gdb_test "p ar5\(9:2:-2, -6:2:3, -6:-15:-3\)" " = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760, 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727, 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587, 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554, 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521, 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\) \\)"
# Corner cases and error messages
@@ -273,3 +278,20 @@ gdb_test "p ar2\(3:1, :\)" "slice out of range"
gdb_test "p ar4\(-3:-3\)" " = \\(-3\\)"
gdb_test "p ar4\(-2:-3\)" " = \\(\\)"
gdb_test "p ar4\( 1:-1\)" "slice out of range"
+
+gdb_test "p ar1\(1:3:\)" "A syntax error in expression, near `\\)'."
+gdb_test "p ar1\(1:3:0\)" "Stride must not be 0."
+gdb_test "p ar1\(3:1:2\)" "slice out of range"
+gdb_test "p ar1\(1:3:-2\)" "slice out of range"
+gdb_test "p ar5(1:7:-3, 1, -6)" "slice out of range"
+gdb_test "p ar5(7:1: 3, 1, -6)" "slice out of range"
+gdb_test "p ar5(1,1,-6:-14: 3)" "slice out of range"
+gdb_test "p ar5(1,1,-14:-6:-3)" "slice out of range"
+
+
+# Check assignment
+gdb_test_no_output "set \$my_ary = ar1\(2:4\)"
+gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary one"
+gdb_test_no_output "set ar1\(2\) = 1"
+gdb_test "p ar1\(2:4\)" " = \\(1, 3, 4\\)"
+gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary two"
diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90
index a4606b2..9186e23 100644
--- a/gdb/testsuite/gdb.fortran/static-arrays.f90
+++ b/gdb/testsuite/gdb.fortran/static-arrays.f90
@@ -18,6 +18,7 @@ subroutine sub
integer, dimension(4,4) :: ar2
integer, dimension(4,4,4) :: ar3
integer, dimension(-4:4) :: ar4
+ integer, dimension(10,-7:3, -15:-5) :: ar5
integer :: i,j,k
! Resulting array ar3 looks like ((( 111, 112, 113, 114,...)))
@@ -35,6 +36,14 @@ subroutine sub
ar4(i) = i
end do
+ do i = 1, 10, 1
+ do j = -7, 3, 1
+ do k = -15, -5, 1
+ ar5(i,j,k) = i*100 + (j+8)*10 + (k+16)
+ end do
+ end do
+ end do
+
ar1(1) = 11 !BP1
return
end
--
2.7.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCH 2/5] Fortran: Move value_f90_subarray.
2017-09-11 12:58 [PATCH 0/5] Fortran: Array strides Tim Wiederhake
` (2 preceding siblings ...)
2017-09-11 12:58 ` [PATCH 4/5] Fortran: Change subrange enum to bit field Tim Wiederhake
@ 2017-09-11 12:58 ` Tim Wiederhake
2017-09-15 20:27 ` Simon Marchi
2017-09-11 12:58 ` [PATCH 3/5] Fortran: Allow multi-dimensional subarrays Tim Wiederhake
4 siblings, 1 reply; 11+ messages in thread
From: Tim Wiederhake @ 2017-09-11 12:58 UTC (permalink / raw)
To: gdb-patches
2017-09-11 Tim Wiederhake <tim.wiederhake@intel.com>
gdb/ChangeLog:
* eval.c (Evaluate_subexp_standard): Use new function name.
(value_f90_subarray): Move ...
* f-lang.c (f90_value_subarray): ... here.
* f-lang.h (f90_value_subarray): New declaration.
---
gdb/eval.c | 30 ++----------------------------
gdb/f-lang.c | 27 +++++++++++++++++++++++++++
gdb/f-lang.h | 5 +++++
3 files changed, 34 insertions(+), 28 deletions(-)
diff --git a/gdb/eval.c b/gdb/eval.c
index 7a808a0..557ac02 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -384,32 +384,6 @@ init_array_element (struct value *array, struct value *element,
return index;
}
-static struct value *
-value_f90_subarray (struct value *array,
- struct expression *exp, int *pos, enum noside noside)
-{
- int pc = (*pos) + 1;
- LONGEST low_bound, high_bound;
- struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
- enum range_type range_type
- = (enum range_type) longest_to_int (exp->elts[pc].longconst);
-
- *pos += 3;
-
- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
- low_bound = TYPE_LOW_BOUND (range);
- else
- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
-
- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
- high_bound = TYPE_HIGH_BOUND (range);
- else
- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
-
- return value_slice (array, low_bound, high_bound - low_bound + 1);
-}
-
-
/* Promote value ARG1 as appropriate before performing a unary operation
on this argument.
If the result is not appropriate for any particular language then it
@@ -1916,13 +1890,13 @@ evaluate_subexp_standard (struct type *expect_type,
{
case TYPE_CODE_ARRAY:
if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (arg1, exp, pos, noside);
+ return f90_value_subarray (arg1, exp, pos, noside);
else
goto multi_f77_subscript;
case TYPE_CODE_STRING:
if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (arg1, exp, pos, noside);
+ return f90_value_subarray (arg1, exp, pos, noside);
else
{
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 77b759b..63caf65 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -386,3 +386,30 @@ f77_get_array_dims (const struct type *array_type)
return ndimen;
}
+
+/* See f-lang.h. */
+
+struct value *
+f90_value_subarray (struct value *array, struct expression *exp, int *pos,
+ enum noside noside)
+{
+ int pc = (*pos) + 1;
+ LONGEST low_bound, high_bound;
+ struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
+ enum range_type range_type
+ = (enum range_type) longest_to_int (exp->elts[pc].longconst);
+
+ *pos += 3;
+
+ if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ low_bound = TYPE_LOW_BOUND (range);
+ else
+ low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+
+ if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ high_bound = TYPE_HIGH_BOUND (range);
+ else
+ high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+
+ return value_slice (array, low_bound, high_bound - low_bound + 1);
+}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index cfe667b..013ea5e 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -59,6 +59,11 @@ extern void f77_get_dynamic_array_length (struct type *);
* the type of an array. */
extern int f77_get_array_dims (const struct type *array_type);
+/* Evaluates any subarray operation on Fortran arrays with at least one user
+ provided parameter. Expects the input ARRAY to be an array. */
+extern struct value *f90_value_subarray (struct value *array,
+ struct expression *exp,
+ int *pos, enum noside noside);
/* Fortran (F77) types */
--
2.7.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: [PATCH 1/5] Fortran: Move calc_f77_array_dims.
2017-09-11 12:58 ` [PATCH 1/5] Fortran: Move calc_f77_array_dims Tim Wiederhake
@ 2017-09-15 20:22 ` Simon Marchi
2017-09-15 20:28 ` Simon Marchi
0 siblings, 1 reply; 11+ messages in thread
From: Simon Marchi @ 2017-09-15 20:22 UTC (permalink / raw)
To: Tim Wiederhake; +Cc: gdb-patches
Hi Tim,
The patch is ok, with some nits I noted below.
On 2017-09-11 14:57, Tim Wiederhake wrote:
> 2017-09-11 Tim Wiederhake <tim.wiederhake@intel.com>
>
> gdb/ChangeLog:
> * eval.c (evaluate_subexp_standard): Use new function name.
> (calc_f77_array_dims): Move ...
> * f-lang.c (f77_get_array_dims): ... here. Constify argument. Make
> NULL check explicit.
> * f-lang.h (calc_f77_arra_dims): Rename to...
> (f77_get_array_dims): ... this. Add comment.
> * f-valprint.c (f77_print_array): Use new function name.
>
> ---
> gdb/eval.c | 21 +--------------------
> gdb/f-lang.c | 16 ++++++++++++++++
> gdb/f-lang.h | 4 +++-
> gdb/f-valprint.c | 2 +-
> 4 files changed, 21 insertions(+), 22 deletions(-)
>
> diff --git a/gdb/eval.c b/gdb/eval.c
> index 24f32f8..7a808a0 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -2336,7 +2336,7 @@ evaluate_subexp_standard (struct type
> *expect_type,
> if (nargs > MAX_FORTRAN_DIMS)
> error (_("Too many subscripts for F77 (%d Max)"),
> MAX_FORTRAN_DIMS);
>
> - ndimensions = calc_f77_array_dims (type);
> + ndimensions = f77_get_array_dims (type);
>
> if (nargs != ndimensions)
> error (_("Wrong number of subscripts"));
> @@ -3266,22 +3266,3 @@ parse_and_eval_type (char *p, int length)
> error (_("Internal error in eval_type."));
> return expr->elts[1].type;
> }
> -
> -int
> -calc_f77_array_dims (struct type *array_type)
> -{
> - int ndimen = 1;
> - struct type *tmp_type;
> -
> - if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
> - error (_("Can't get dimensions for a non-array type"));
> -
> - tmp_type = array_type;
> -
> - while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
> - {
> - if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
> - ++ndimen;
> - }
> - return ndimen;
> -}
> diff --git a/gdb/f-lang.c b/gdb/f-lang.c
> index 903cfd1..77b759b 100644
> --- a/gdb/f-lang.c
> +++ b/gdb/f-lang.c
> @@ -370,3 +370,19 @@ _initialize_f_language (void)
> {
> f_type_data = gdbarch_data_register_post_init (build_fortran_types);
> }
> +
> +/* See f-lang.h. */
> +
> +int
> +f77_get_array_dims (const struct type *array_type)
> +{
> + if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
> + error (_("Can't get dimensions for a non-array type"));
> +
> + int ndimen = 0;
> + for (; array_type != NULL; array_type = TYPE_TARGET_TYPE
> (array_type))
> + if (TYPE_CODE (array_type) == TYPE_CODE_ARRAY)
> + ndimen += 1;
ndimen++; ?
Just a question (just showing off my ignorance of fortran): don't you
want to stop looping when you reach a type that is a non-array? I don't
know which types in fortran can have a target, but is it possible to
have something like this?
array type -> array type -> other type -> array type
The code above would give a dimension of 3, is it what we want? I would
have thought that the "top-level" array has a dimension of 2, but its
elements is of type "other type".
> +
> + return ndimen;
> +}
> diff --git a/gdb/f-lang.h b/gdb/f-lang.h
> index 5633b41..cfe667b 100644
> --- a/gdb/f-lang.h
> +++ b/gdb/f-lang.h
> @@ -55,7 +55,9 @@ extern int f77_get_lowerbound (struct type *);
>
> extern void f77_get_dynamic_array_length (struct type *);
>
> -extern int calc_f77_array_dims (struct type *);
> +/* Calculate the number of dimensions of an array. Expects ARRAY_TYPE
> to be
> + * the type of an array. */
Nit: remove the star at the beginning of the second line.
I would suggest this wording: Calculate the number of dimensions of an
array of type ARRAY_TYPE.
> +extern int f77_get_array_dims (const struct type *array_type);
>
>
> /* Fortran (F77) types */
> diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
> index 8fc894a..59d1a2f 100644
> --- a/gdb/f-valprint.c
> +++ b/gdb/f-valprint.c
> @@ -180,7 +180,7 @@ f77_print_array (struct type *type, const gdb_byte
> *valaddr,
> int ndimensions;
> int elts = 0;
>
> - ndimensions = calc_f77_array_dims (type);
> + ndimensions = f77_get_array_dims (type);
>
> if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
> error (_("\
Thanks,
Simon
^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: [PATCH 2/5] Fortran: Move value_f90_subarray.
2017-09-11 12:58 ` [PATCH 2/5] Fortran: Move value_f90_subarray Tim Wiederhake
@ 2017-09-15 20:27 ` Simon Marchi
0 siblings, 0 replies; 11+ messages in thread
From: Simon Marchi @ 2017-09-15 20:27 UTC (permalink / raw)
To: Tim Wiederhake; +Cc: gdb-patches
On 2017-09-11 14:57, Tim Wiederhake wrote:
> 2017-09-11 Tim Wiederhake <tim.wiederhake@intel.com>
>
> gdb/ChangeLog:
> * eval.c (Evaluate_subexp_standard): Use new function name.
> (value_f90_subarray): Move ...
> * f-lang.c (f90_value_subarray): ... here.
> * f-lang.h (f90_value_subarray): New declaration.
>
> ---
> gdb/eval.c | 30 ++----------------------------
> gdb/f-lang.c | 27 +++++++++++++++++++++++++++
> gdb/f-lang.h | 5 +++++
> 3 files changed, 34 insertions(+), 28 deletions(-)
>
> diff --git a/gdb/eval.c b/gdb/eval.c
> index 7a808a0..557ac02 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -384,32 +384,6 @@ init_array_element (struct value *array, struct
> value *element,
> return index;
> }
>
> -static struct value *
> -value_f90_subarray (struct value *array,
> - struct expression *exp, int *pos, enum noside noside)
> -{
> - int pc = (*pos) + 1;
> - LONGEST low_bound, high_bound;
> - struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type
> (array)));
> - enum range_type range_type
> - = (enum range_type) longest_to_int (exp->elts[pc].longconst);
> -
> - *pos += 3;
> -
> - if (range_type == LOW_BOUND_DEFAULT || range_type ==
> BOTH_BOUND_DEFAULT)
> - low_bound = TYPE_LOW_BOUND (range);
> - else
> - low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos,
> noside));
> -
> - if (range_type == HIGH_BOUND_DEFAULT || range_type ==
> BOTH_BOUND_DEFAULT)
> - high_bound = TYPE_HIGH_BOUND (range);
> - else
> - high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos,
> noside));
> -
> - return value_slice (array, low_bound, high_bound - low_bound + 1);
> -}
> -
> -
> /* Promote value ARG1 as appropriate before performing a unary
> operation
> on this argument.
> If the result is not appropriate for any particular language then
> it
> @@ -1916,13 +1890,13 @@ evaluate_subexp_standard (struct type
> *expect_type,
> {
> case TYPE_CODE_ARRAY:
> if (exp->elts[*pos].opcode == OP_RANGE)
> - return value_f90_subarray (arg1, exp, pos, noside);
> + return f90_value_subarray (arg1, exp, pos, noside);
> else
> goto multi_f77_subscript;
>
> case TYPE_CODE_STRING:
> if (exp->elts[*pos].opcode == OP_RANGE)
> - return value_f90_subarray (arg1, exp, pos, noside);
> + return f90_value_subarray (arg1, exp, pos, noside);
> else
> {
> arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
> diff --git a/gdb/f-lang.c b/gdb/f-lang.c
> index 77b759b..63caf65 100644
> --- a/gdb/f-lang.c
> +++ b/gdb/f-lang.c
> @@ -386,3 +386,30 @@ f77_get_array_dims (const struct type *array_type)
>
> return ndimen;
> }
> +
> +/* See f-lang.h. */
> +
> +struct value *
> +f90_value_subarray (struct value *array, struct expression *exp, int
> *pos,
> + enum noside noside)
> +{
> + int pc = (*pos) + 1;
> + LONGEST low_bound, high_bound;
> + struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type
> (array)));
> + enum range_type range_type
> + = (enum range_type) longest_to_int (exp->elts[pc].longconst);
> +
> + *pos += 3;
> +
> + if (range_type == LOW_BOUND_DEFAULT || range_type ==
> BOTH_BOUND_DEFAULT)
> + low_bound = TYPE_LOW_BOUND (range);
> + else
> + low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos,
> noside));
> +
> + if (range_type == HIGH_BOUND_DEFAULT || range_type ==
> BOTH_BOUND_DEFAULT)
> + high_bound = TYPE_HIGH_BOUND (range);
> + else
> + high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos,
> noside));
> +
> + return value_slice (array, low_bound, high_bound - low_bound + 1);
> +}
> diff --git a/gdb/f-lang.h b/gdb/f-lang.h
> index cfe667b..013ea5e 100644
> --- a/gdb/f-lang.h
> +++ b/gdb/f-lang.h
> @@ -59,6 +59,11 @@ extern void f77_get_dynamic_array_length (struct
> type *);
> * the type of an array. */
> extern int f77_get_array_dims (const struct type *array_type);
>
> +/* Evaluates any subarray operation on Fortran arrays with at least
> one user
> + provided parameter. Expects the input ARRAY to be an array. */
> +extern struct value *f90_value_subarray (struct value *array,
> + struct expression *exp,
> + int *pos, enum noside noside);
>
> /* Fortran (F77) types */
LGTM.
^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: [PATCH 1/5] Fortran: Move calc_f77_array_dims.
2017-09-15 20:22 ` Simon Marchi
@ 2017-09-15 20:28 ` Simon Marchi
0 siblings, 0 replies; 11+ messages in thread
From: Simon Marchi @ 2017-09-15 20:28 UTC (permalink / raw)
To: Tim Wiederhake; +Cc: gdb-patches
On 2017-09-15 22:21, Simon Marchi wrote:
> Hi Tim,
>
> The patch is ok, with some nits I noted below.
>
> On 2017-09-11 14:57, Tim Wiederhake wrote:
>> 2017-09-11 Tim Wiederhake <tim.wiederhake@intel.com>
>>
>> gdb/ChangeLog:
>> * eval.c (evaluate_subexp_standard): Use new function name.
>> (calc_f77_array_dims): Move ...
>> * f-lang.c (f77_get_array_dims): ... here. Constify argument. Make
>> NULL check explicit.
>> * f-lang.h (calc_f77_arra_dims): Rename to...
>> (f77_get_array_dims): ... this. Add comment.
>> * f-valprint.c (f77_print_array): Use new function name.
>>
>> ---
>> gdb/eval.c | 21 +--------------------
>> gdb/f-lang.c | 16 ++++++++++++++++
>> gdb/f-lang.h | 4 +++-
>> gdb/f-valprint.c | 2 +-
>> 4 files changed, 21 insertions(+), 22 deletions(-)
>>
>> diff --git a/gdb/eval.c b/gdb/eval.c
>> index 24f32f8..7a808a0 100644
>> --- a/gdb/eval.c
>> +++ b/gdb/eval.c
>> @@ -2336,7 +2336,7 @@ evaluate_subexp_standard (struct type
>> *expect_type,
>> if (nargs > MAX_FORTRAN_DIMS)
>> error (_("Too many subscripts for F77 (%d Max)"),
>> MAX_FORTRAN_DIMS);
>>
>> - ndimensions = calc_f77_array_dims (type);
>> + ndimensions = f77_get_array_dims (type);
>>
>> if (nargs != ndimensions)
>> error (_("Wrong number of subscripts"));
>> @@ -3266,22 +3266,3 @@ parse_and_eval_type (char *p, int length)
>> error (_("Internal error in eval_type."));
>> return expr->elts[1].type;
>> }
>> -
>> -int
>> -calc_f77_array_dims (struct type *array_type)
>> -{
>> - int ndimen = 1;
>> - struct type *tmp_type;
>> -
>> - if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
>> - error (_("Can't get dimensions for a non-array type"));
>> -
>> - tmp_type = array_type;
>> -
>> - while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
>> - {
>> - if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
>> - ++ndimen;
>> - }
>> - return ndimen;
>> -}
>> diff --git a/gdb/f-lang.c b/gdb/f-lang.c
>> index 903cfd1..77b759b 100644
>> --- a/gdb/f-lang.c
>> +++ b/gdb/f-lang.c
>> @@ -370,3 +370,19 @@ _initialize_f_language (void)
>> {
>> f_type_data = gdbarch_data_register_post_init
>> (build_fortran_types);
>> }
>> +
>> +/* See f-lang.h. */
>> +
>> +int
>> +f77_get_array_dims (const struct type *array_type)
>> +{
>> + if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
>> + error (_("Can't get dimensions for a non-array type"));
>> +
>> + int ndimen = 0;
>> + for (; array_type != NULL; array_type = TYPE_TARGET_TYPE
>> (array_type))
>> + if (TYPE_CODE (array_type) == TYPE_CODE_ARRAY)
>> + ndimen += 1;
>
> ndimen++; ?
>
> Just a question (just showing off my ignorance of fortran): don't you
> want to stop looping when you reach a type that is a non-array? I
> don't know which types in fortran can have a target, but is it
> possible to have something like this?
>
> array type -> array type -> other type -> array type
>
> The code above would give a dimension of 3, is it what we want? I
> would have thought that the "top-level" array has a dimension of 2,
> but its elements is of type "other type".
>
>> +
>> + return ndimen;
>> +}
>> diff --git a/gdb/f-lang.h b/gdb/f-lang.h
>> index 5633b41..cfe667b 100644
>> --- a/gdb/f-lang.h
>> +++ b/gdb/f-lang.h
>> @@ -55,7 +55,9 @@ extern int f77_get_lowerbound (struct type *);
>>
>> extern void f77_get_dynamic_array_length (struct type *);
>>
>> -extern int calc_f77_array_dims (struct type *);
>> +/* Calculate the number of dimensions of an array. Expects
>> ARRAY_TYPE to be
>> + * the type of an array. */
>
> Nit: remove the star at the beginning of the second line.
>
> I would suggest this wording: Calculate the number of dimensions of an
> array of type ARRAY_TYPE.
>
>> +extern int f77_get_array_dims (const struct type *array_type);
>>
>>
>> /* Fortran (F77) types */
>> diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
>> index 8fc894a..59d1a2f 100644
>> --- a/gdb/f-valprint.c
>> +++ b/gdb/f-valprint.c
>> @@ -180,7 +180,7 @@ f77_print_array (struct type *type, const gdb_byte
>> *valaddr,
>> int ndimensions;
>> int elts = 0;
>>
>> - ndimensions = calc_f77_array_dims (type);
>> + ndimensions = f77_get_array_dims (type);
>>
>> if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
>> error (_("\
>
> Thanks,
>
> Simon
Ahh maybe another nit, it would be nice if you could leave
_initialize_f_language at the bottom of the file, for consistency.
Simon
^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: [PATCH 3/5] Fortran: Allow multi-dimensional subarrays.
2017-09-11 12:58 ` [PATCH 3/5] Fortran: Allow multi-dimensional subarrays Tim Wiederhake
@ 2017-09-15 22:08 ` Simon Marchi
0 siblings, 0 replies; 11+ messages in thread
From: Simon Marchi @ 2017-09-15 22:08 UTC (permalink / raw)
To: Tim Wiederhake; +Cc: gdb-patches, Christoph Weinmann
On 2017-09-11 14:57, Tim Wiederhake wrote:
> From: Christoph Weinmann <christoph.t.weinmann@intel.com>
>
> 1| program prog
> 2| integer :: ary(10,5) = (/ (i,i=1,10) (j, j=1,5) /)
> 3| end program prog
>
> Before:
> (gdb) print ary(2:4,1:3)
> Syntax error in expression near ':3'
>
> After:
> (gdb) print ary(2:4,1:3)
> $1 = ( ( 21, 31, 41) ( 22, 32, 42) ( 23, 33, 43) )
Hi Tim,
The space before the first elements annoys me slightly :).
I have a general question about the algorithm used, I'm just thinking
out loud. There seems to be a lot of copying involved. Let's I have an
array of 100x100x100, and I do arr(10:19,10:19,10:19). From what I
understand, the first call to f90_value_slice won't make a copy, because
we can just make a copy that "points" to a slice into the original array
(because everything we want is contiguous in memory as this point). The
second call to f90_value_slice can't do that, so it will create a
temporary value, and copy 10 x 10 x 100 elements to it. The last call
to f90_value_slice will create another temporary value, and copy 10 x 10
x 10 elements to it. Finally, f90_value_subarray will copy it to the
final value. Do I understand correctly?
Instead, would it be possible to allocate the final value right from the
start (with the ranges we know its size), and copy directly each element
from the original array to its position in the final value?
>
> xxxx-yy-zz Christoph Weinmann <christoph.t.weinmann@intel.com>
> Tim Wiederhake <tim.wiederhake@intel.com>
>
> gdb/ChangeLog:
>
> * eval.c (evaluate_subexp_standard): Treat strings and arrays the
> same.
> * f-exp.y (arglist): Add subrange expression.
> * f-lang.c (f77_get_array_dims): Strings have one dimension.
> (f90_value_slice): New function.
> (f90_value_subarray): New parameter. Allow multi-dimensional
> subarrays.
> * f-lang.h (f90_value_subarray): New parameter.
>
> gdb/testsuite/ChangeLog:
> * gdb.fortran/static-arrays.exp: New file.
> * gdb.fortran/static-arrays.f90: New file.
>
>
> ---
> gdb/eval.c | 56 +-----
> gdb/f-exp.y | 2 +
> gdb/f-lang.c | 215
> ++++++++++++++++++++--
> gdb/f-lang.h | 10 +-
> gdb/testsuite/gdb.fortran/static-arrays.exp | 275
> ++++++++++++++++++++++++++++
> gdb/testsuite/gdb.fortran/static-arrays.f90 | 44 +++++
> 6 files changed, 528 insertions(+), 74 deletions(-)
> create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.exp
> create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.f90
>
> diff --git a/gdb/eval.c b/gdb/eval.c
> index 557ac02..8a4687a 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -1889,19 +1889,8 @@ evaluate_subexp_standard (struct type
> *expect_type,
> switch (code)
> {
> case TYPE_CODE_ARRAY:
> - if (exp->elts[*pos].opcode == OP_RANGE)
> - return f90_value_subarray (arg1, exp, pos, noside);
> - else
> - goto multi_f77_subscript;
> -
> case TYPE_CODE_STRING:
> - if (exp->elts[*pos].opcode == OP_RANGE)
> - return f90_value_subarray (arg1, exp, pos, noside);
> - else
> - {
> - arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
> - return value_subscript (arg1, value_as_long (arg2));
> - }
> + return f90_value_subarray (arg1, exp, pos, nargs, noside);
>
> case TYPE_CODE_PTR:
> case TYPE_CODE_FUNC:
> @@ -2301,49 +2290,6 @@ evaluate_subexp_standard (struct type
> *expect_type,
> }
> return (arg1);
>
> - multi_f77_subscript:
> - {
> - LONGEST subscript_array[MAX_FORTRAN_DIMS];
> - int ndimensions = 1, i;
> - struct value *array = arg1;
> -
> - if (nargs > MAX_FORTRAN_DIMS)
> - error (_("Too many subscripts for F77 (%d Max)"),
> MAX_FORTRAN_DIMS);
> -
> - ndimensions = f77_get_array_dims (type);
> -
> - if (nargs != ndimensions)
> - error (_("Wrong number of subscripts"));
> -
> - gdb_assert (nargs > 0);
> -
> - /* Now that we know we have a legal array subscript expression
> - let us actually find out where this element exists in the array.
> */
> -
> - /* Take array indices left to right. */
> - for (i = 0; i < nargs; i++)
> - {
> - /* Evaluate each subscript; it must be a legal integer in F77.
> */
> - arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
> -
> - /* Fill in the subscript array. */
> -
> - subscript_array[i] = value_as_long (arg2);
> - }
> -
> - /* Internal type of array is arranged right to left. */
> - for (i = nargs; i > 0; i--)
> - {
> - struct type *array_type = check_typedef (value_type (array));
> - LONGEST index = subscript_array[i - 1];
> -
> - array = value_subscripted_rvalue (array, index,
> - f77_get_lowerbound (array_type));
> - }
> -
> - return array;
> - }
> -
> case BINOP_LOGICAL_AND:
> arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
> if (noside == EVAL_SKIP)
> diff --git a/gdb/f-exp.y b/gdb/f-exp.y
> index 8dcc811..bfa9d09 100644
> --- a/gdb/f-exp.y
> +++ b/gdb/f-exp.y
> @@ -254,6 +254,8 @@ arglist : subrange
>
> arglist : arglist ',' exp %prec ABOVE_COMMA
> { arglist_len++; }
> + | arglist ',' subrange %prec ABOVE_COMMA
> + { arglist_len++; }
> ;
>
> /* There are four sorts of subrange types in F90. */
> diff --git a/gdb/f-lang.c b/gdb/f-lang.c
> index 63caf65..25bb758 100644
> --- a/gdb/f-lang.c
> +++ b/gdb/f-lang.c
> @@ -376,6 +376,9 @@ _initialize_f_language (void)
> int
> f77_get_array_dims (const struct type *array_type)
> {
> + if (TYPE_CODE (array_type) == TYPE_CODE_STRING)
> + return 1;
> +
> if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
> error (_("Can't get dimensions for a non-array type"));
>
> @@ -387,29 +390,209 @@ f77_get_array_dims (const struct type
> *array_type)
> return ndimen;
> }
>
> +/* F90_VALUE_SLICE is called for each array dimension to calculate the
> number
> + of elements as defined by the subscript expression
> + array(SLICE_LOW : SLICE_LOW + SLICE_LEN).
> + MULTI_DIM is used to determine if we are working on a
> one-dimensional or
> + multi-dimensional array. The latter case happens in all slicing
> operations
> + following the first subscript that is a range, as a range subscript
> does not
> + decrease the number of dimensions of an array. */
> +
> +static struct value *
> +f90_value_slice (struct value *src_array, LONGEST slice_low, LONGEST
> slice_len,
> + bool multi_dim)
> +{
> + /* If the array is not multidimensional, we use the generic code
> path to
> + generate the slice. */
> + if (!multi_dim)
> + return value_slice (src_array, slice_low, slice_len);
> +
> + type *const src_ary_type = check_typedef (value_type (src_array));
> + type *const src_row_type = check_typedef (TYPE_TARGET_TYPE
> (src_ary_type));
> + type *const src_elm_type = check_typedef (TYPE_TARGET_TYPE
> (src_row_type));
> + type *const src_idx_type = check_typedef (TYPE_INDEX_TYPE
> (src_row_type));
> + const LONGEST slice_offset = slice_low - TYPE_LOW_BOUND
> (src_idx_type);
> + const LONGEST row_count
> + = TYPE_LENGTH (src_ary_type) / TYPE_LENGTH (src_row_type);
> +
> + /* FIXME-type-allocation: need a way to free this type when we are
> + done with it. */
> + type *const dst_rng_type
> + = create_static_range_type (NULL, TYPE_TARGET_TYPE (src_idx_type),
> + TYPE_LOW_BOUND (src_idx_type),
> + TYPE_LOW_BOUND (src_idx_type)
> + + slice_len * row_count - 1);
> +
> + type *const dst_ary_type
> + = create_array_type (NULL, TYPE_TARGET_TYPE (src_row_type),
> dst_rng_type);
> +
> + TYPE_CODE (dst_ary_type) = TYPE_CODE (src_row_type);
> + value *const dst_array = allocate_value (dst_ary_type);
> +
> + for (LONGEST i = 0; i < row_count; ++i)
> + {
> + const LONGEST dst_offset = TYPE_LENGTH (src_elm_type) * i *
> slice_len;
> +
> + const LONGEST src_offset
> + = TYPE_LENGTH (src_row_type) * i
> + + TYPE_LENGTH (src_elm_type) * slice_offset;
> +
> + value_contents_copy (dst_array, dst_offset, src_array,
> src_offset,
> + TYPE_LENGTH (src_elm_type) * slice_len);
> + }
> +
> + const LONGEST offset
> + = TYPE_LENGTH (src_row_type) * row_count
> + + TYPE_LENGTH (src_elm_type) * slice_offset;
> +
> + set_value_component_location (dst_array, src_array);
> + set_value_offset (dst_array, value_offset (src_array) + offset);
I'm not sure this is right. IIUC, these properties are for values whose
contents is a small part of a bigger value. For example when you call
value_slice, it doesn't create a new contents buffer, it just creates a
new struct value whose contents points in the contents buffer of the
original value. In your case, you are creating a new value with its own
contents, so I am not sure these fields apply here (I might be wrong
though).
> +
> + return dst_array;
> +}
> +
> /* See f-lang.h. */
>
> struct value *
> f90_value_subarray (struct value *array, struct expression *exp, int
> *pos,
> - enum noside noside)
> + int nargs, enum noside noside)
> {
> - int pc = (*pos) + 1;
> - LONGEST low_bound, high_bound;
> - struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type
> (array)));
> - enum range_type range_type
> - = (enum range_type) longest_to_int (exp->elts[pc].longconst);
> + /* Local struct to hold user data for Fortran subarray dimensions.
> */
> + struct subscript
> + {
> + enum
> + {
> + SUBSCRIPT_INDEX, /* e.g. "(literal)" */
> + SUBSCRIPT_RANGE /* e.g. "(lowbound:highbound)" */
> + } kind;
> +
> + union
> + {
> + /* If KIND == SUBSCRIPT_INDEX. */
> + LONGEST index;
> +
> + /* If KIND == SUBSCRIPT_RANGE. */
> + struct {
> + int type;
Should TYPE be of type range_type?
> + LONGEST low;
> + LONGEST high;
> + };
> + };
> +
> + subscript (LONGEST index_) : kind (SUBSCRIPT_INDEX), index
> (index_) {}
> +
> + subscript (int type_, LONGEST low_, LONGEST high_) :
> + kind (SUBSCRIPT_RANGE), type (type_), low (low_), high (high_)
> {}
> + };
> +
> + if (nargs != f77_get_array_dims (value_type (array)))
> + error (_("Wrong number of subscripts"));
> +
> + /* Parse the user input into SUBSCRIPT_ARRAY for later use. We need
> to parse
> + it fully first, as evaluation is performed right-to-left. */
> + std::vector<subscript> subscript_array;
> + for (int i = 0; i < nargs; i++)
> + {
> + if (exp->elts[*pos].opcode == OP_RANGE)
> + {
> + /* User input is a range, with or without lower and upper bound,
> + e.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc. */
> + const int type = longest_to_int (exp->elts[*pos + 1].longconst);
> + LONGEST lo = 0;
> + LONGEST hi = 0;
> +
> + *pos += 3;
> +
> + if (type == HIGH_BOUND_DEFAULT || type == NONE_BOUND_DEFAULT)
> + lo = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos,
> noside));
> + if (type == LOW_BOUND_DEFAULT || type == NONE_BOUND_DEFAULT)
> + hi = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos,
> noside));
> +
> + subscript_array.emplace_back (type, lo, hi);
> + }
> + else
> + {
> + /* User input is an index, e.g.: "p arry(5)". The subscript must
> be
> + a legal integer in F77. */
> + value *const val = evaluate_subexp_with_coercion (exp, pos,
> noside);
> + subscript_array.emplace_back (value_as_long (val));
> + }
> + }
>
> - *pos += 3;
> + /* Traverse the array from right to left and evaluate each
> corresponding
> + user input. */
> + bool multi_dim = false;
> + const type *array_type = check_typedef (value_type (array));
> + value *new_array = array;
> + for (auto it = subscript_array.rbegin (); it != subscript_array.rend
> ();
> + array_type = TYPE_TARGET_TYPE (array_type), ++it)
> + {
> + const type *const index_type = TYPE_INDEX_TYPE (array_type);
> + const LONGEST lo = TYPE_LOW_BOUND (index_type);
> + const LONGEST hi = TYPE_HIGH_BOUND (index_type);
>
> - if (range_type == LOW_BOUND_DEFAULT || range_type ==
> BOTH_BOUND_DEFAULT)
> - low_bound = TYPE_LOW_BOUND (range);
> - else
> - low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos,
> noside));
> + if (it->kind == subscript::SUBSCRIPT_RANGE)
> + {
> + if (it->type == LOW_BOUND_DEFAULT || it->type ==
> BOTH_BOUND_DEFAULT)
> + it->low = lo;
> + if (it->type == HIGH_BOUND_DEFAULT || it->type ==
> BOTH_BOUND_DEFAULT)
> + it->high = hi;
> +
> + if (it->low < lo || it->low > hi || it->high < lo || it->high > hi)
> + error (_("slice out of range"));
> +
> + if (it->high - it->low + 1 < 0)
> + error (_("slice out of range"));
Would it be useful to the user to give more detailed errors? Like
"slice out of range (high bound is X, got Y)".
> +
> + new_array = f90_value_slice (new_array, it->low,
> + it->high - it->low + 1,
> + multi_dim);
> +
> + /* A range subscript does not decrease the number of dimensions in
> + array. Therefore we cannot use VALUE_SUBSCRIPTED_RVALUE anymore
> + after we encountered the first range, as we now operate on an
> + array of arrays. */
> + multi_dim = true;
> + }
> + else
> + {
> + if (!multi_dim)
> + {
> + const int lo = f77_get_lowerbound (value_type (new_array));
> + new_array = value_subscripted_rvalue (new_array, it->index,
> lo);
> + continue;
> + }
>
> - if (range_type == HIGH_BOUND_DEFAULT || range_type ==
> BOTH_BOUND_DEFAULT)
> - high_bound = TYPE_HIGH_BOUND (range);
> - else
> - high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos,
> noside));
> + if (it->index < lo || it->index > hi)
> + error (_("no such vector element"));
Is "vector" the right term? Everywhere else "array" is used. Also, it
might be nice to give more info to the user, since we have it handy.
> +
> + new_array = f90_value_slice (new_array, it->index, 1, multi_dim);
> + }
> + }
> +
> + /* If we did not encounter any range subscript, the result is ready
> to go. */
> + if (!multi_dim)
> + return new_array;
> +
> + /* After slicing, NEW_ARRAY is a flat, one-dimensional array. If we
> had any
> + range subscripts, we have to rebuild the dimensions with respect
> to the
> + stride size. */
> + type *elt_type = TYPE_TARGET_TYPE (value_type (new_array));
> + for (const subscript& s : subscript_array)
subscript &s
> + {
> + if (s.kind == subscript::SUBSCRIPT_INDEX)
> + continue;
> +
> + type *const range_type =
> + create_static_range_type (NULL, elt_type, s.low, s.high);
> + type *const interim_array_type =
> + create_array_type (NULL, elt_type, range_type);
> +
> + TYPE_CODE (interim_array_type) = TYPE_CODE (value_type
> (new_array));
> + array = allocate_value (interim_array_type);
> + elt_type = value_type (array);
> + }
>
> - return value_slice (array, low_bound, high_bound - low_bound + 1);
> + value_contents_copy (array, 0, new_array, 0, TYPE_LENGTH
> (elt_type));
> + return array;
> }
> diff --git a/gdb/f-lang.h b/gdb/f-lang.h
> index 013ea5e..0b25db2 100644
> --- a/gdb/f-lang.h
> +++ b/gdb/f-lang.h
> @@ -59,11 +59,15 @@ extern void f77_get_dynamic_array_length (struct
> type *);
> * the type of an array. */
> extern int f77_get_array_dims (const struct type *array_type);
>
> -/* Evaluates any subarray operation on Fortran arrays with at least
> one user
> - provided parameter. Expects the input ARRAY to be an array. */
> +/* Evaluates any subarray operation on Fortran arrays or strings with
> at least
> + one user provided parameter. Expects the input ARRAY to be either
> an array
> + or a string. Evaluates EXP by incrementing *POS. NARGS specifies
> number of
> + arguments the user provided and must be the same number as ARRAY
> has
> + dimensions. */
> extern struct value *f90_value_subarray (struct value *array,
> struct expression *exp,
> - int *pos, enum noside noside);
> + int *pos, int nargs,
> + enum noside noside);
>
> /* Fortran (F77) types */
>
> diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp
> b/gdb/testsuite/gdb.fortran/static-arrays.exp
> new file mode 100644
> index 0000000..0a9f1ab
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/static-arrays.exp
> @@ -0,0 +1,275 @@
> +# Copyright 2017 Free Software Foundation, Inc.
> +#
> +# This program is free software; you can redistribute it and/or modify
> +# it under the terms of the GNU General Public License as published by
> +# the Free Software Foundation; either version 3 of the License, or
> +# (at your option) any later version.
> +#
> +# This program is distributed in the hope that it will be useful,
> +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +# GNU General Public License for more details.
> +#
> +# You should have received a copy of the GNU General Public License
> +# along with this program. If not, see
> <http://www.gnu.org/licenses/>.
> +
> +if { [skip_fortran_tests] } {
> + return -1
> +}
> +
> +standard_testfile static-arrays.f90
> +
> +if { [prepare_for_testing "failed to prepare" $testfile $srcfile
> {debug f90}] } {
> + return -1
> +}
> +
> +if ![runto MAIN__] then {
> + untested "could not run to main"
> + return -1
> +}
> +
> +gdb_breakpoint [gdb_get_line_number "BP1"]
> +gdb_continue_to_breakpoint "BP1" ".*BP1.*"
> +
> +
> +# Test subranges of one-dimensional arrays
> +gdb_test "p ar1" " = \\(1, 2, 3, 4\\)"
> +gdb_test "p ar1\(2:3\)" " = \\(2, 3\\)"
> +gdb_test "p ar1\(2: \)" " = \\(2, 3, 4\\)"
> +gdb_test "p ar1\( :3\)" " = \\(1, 2, 3\\)"
> +gdb_test "p ar1\( : \)" " = \\(1, 2, 3, 4\\)"
> +gdb_test "p ar1\( 3 \)" " = 3"
If you want to make the tests more readable (avoid the backslashes), you
can pass the regexes through string_to_regexp. Make a wrapper like
this:
proc gdb_test_const { cmd regex } {
gdb_test $cmd [string_to_regexp $regex]
}
and then you can do;
gdb_test_const "p ar1( : )" " = (1, 2, 3, 4)"
I don't think you need to escape the parenthesis in the command
argument.
Also, make sure you test names don't end with something in parenthesis:
https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Do_not_use_.22tail_parentheses.22_on_test_messages
If you don't provide a test name (a 3rd argument to gdb_test), the
command will be used as the test name. So I suggest giving names to
your tests.
> +# Check assignment
> +gdb_test_no_output "set \$my_ary = ar1\(2:4\)"
> +gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary one"
> +gdb_test_no_output "set ar1\(2\) = 1"
> +gdb_test "p ar1\(2:4\)" " = \\(1, 3, 4\\)"
> +gdb_test "p \$my_ary" " = \\(2, 3, 4\\)" "p my_ary two"
Out of curiosity, is it possible to assign to a multi-dimensional slice?
(gdb) p arr(1:2,1) = (11, 22)
It doesn't work when I try it, but maybe it makes no sense.
Thanks!
Simon
^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: [PATCH 4/5] Fortran: Change subrange enum to bit field.
2017-09-11 12:58 ` [PATCH 4/5] Fortran: Change subrange enum to bit field Tim Wiederhake
@ 2017-09-15 22:29 ` Simon Marchi
0 siblings, 0 replies; 11+ messages in thread
From: Simon Marchi @ 2017-09-15 22:29 UTC (permalink / raw)
To: Tim Wiederhake; +Cc: gdb-patches, Christoph Weinmann
On 2017-09-11 14:57, Tim Wiederhake wrote:
> From: Christoph Weinmann <christoph.t.weinmann@intel.com>
>
> Change Fortran subrange enum for subrange expressions to represent a
> bitfield
> for easier manipulation. Consequently also change occurences and
> evaluation
> of said enum. The behaviour of GDB is unchanged.
Good idea, I think it makes sense. It might be useful if this enum was
an "enum flags" in some cases (like to avoid having to cast when doing
bitwise or), but it may not help in other. For example, I am not sure
the
case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND):
would work. You can try it if you want, but otherwise I'm fine with the
current version.
> xxxx-yy-zz Christoph Weinmann <christoph.t.weinmann@intel.com>
> Tim Wiederhake <tim.wiederhake@intel.com>
>
> * expprint.c (print_subexp_standard): Use bitfield instead of enum.
> (dump_subexp_body_standard): Same.
> * f-exp.y (subrange): Same.
> * f-lang.c (f90_value_subarray): Same.
> * parse.c (operator_length_standard): Same.
> * rust-exp.y: Same.
> * rust-lang.c (rust_range, rust_compute_range, rust_subscript): Same.
> * expression.h (enum range_type): Turn into a bitfield.
>
>
> ---
> gdb/expprint.c | 20 ++++++++------------
> gdb/expression.h | 15 ++++++---------
> gdb/f-exp.y | 11 ++++++-----
> gdb/f-lang.c | 8 ++++----
> gdb/parse.c | 21 ++++++++-------------
> gdb/rust-exp.y | 12 +++---------
> gdb/rust-lang.c | 17 ++++++++---------
> 7 files changed, 43 insertions(+), 61 deletions(-)
>
> diff --git a/gdb/expprint.c b/gdb/expprint.c
> index 9e04f24..19d1c88 100644
> --- a/gdb/expprint.c
> +++ b/gdb/expprint.c
> @@ -581,12 +581,10 @@ print_subexp_standard (struct expression *exp,
> int *pos,
> *pos += 2;
>
> fputs_filtered ("RANGE(", stream);
> - if (range_type == HIGH_BOUND_DEFAULT
> - || range_type == NONE_BOUND_DEFAULT)
> + if ((range_type & SUBARRAY_LOW_BOUND) != 0)
> print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
> fputs_filtered ("..", stream);
> - if (range_type == LOW_BOUND_DEFAULT
> - || range_type == NONE_BOUND_DEFAULT)
> + if ((range_type & SUBARRAY_HIGH_BOUND) != 0)
> print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
> fputs_filtered (")", stream);
> return;
> @@ -1093,16 +1091,16 @@ dump_subexp_body_standard (struct expression
> *exp,
>
> switch (range_type)
> {
> - case BOTH_BOUND_DEFAULT:
> + case SUBARRAY_NO_BOUND:
> fputs_filtered ("Range '..'", stream);
> break;
> - case LOW_BOUND_DEFAULT:
> + case SUBARRAY_HIGH_BOUND:
> fputs_filtered ("Range '..EXP'", stream);
> break;
> - case HIGH_BOUND_DEFAULT:
> + case SUBARRAY_LOW_BOUND:
> fputs_filtered ("Range 'EXP..'", stream);
> break;
> - case NONE_BOUND_DEFAULT:
> + case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND):
> fputs_filtered ("Range 'EXP..EXP'", stream);
> break;
> default:
> @@ -1110,11 +1108,9 @@ dump_subexp_body_standard (struct expression
> *exp,
> break;
> }
>
> - if (range_type == HIGH_BOUND_DEFAULT
> - || range_type == NONE_BOUND_DEFAULT)
> + if ((range_type & SUBARRAY_LOW_BOUND) != 0)
> elt = dump_subexp (exp, stream, elt);
> - if (range_type == LOW_BOUND_DEFAULT
> - || range_type == NONE_BOUND_DEFAULT)
> + if ((range_type & SUBARRAY_HIGH_BOUND) != 0)
> elt = dump_subexp (exp, stream, elt);
> }
> break;
> diff --git a/gdb/expression.h b/gdb/expression.h
> index 9e4ddf5..c794198 100644
> --- a/gdb/expression.h
> +++ b/gdb/expression.h
> @@ -155,17 +155,14 @@ extern void dump_raw_expression (struct
> expression *,
> struct ui_file *, const char *);
> extern void dump_prefix_expression (struct expression *, struct
> ui_file *);
>
> -/* In an OP_RANGE expression, either bound could be empty, indicating
> - that its value is by default that of the corresponding bound of the
> - array or string. So we have four sorts of subrange. This
> - enumeration type is to identify this. */
> -
> +/* Flags to indicate which boundarys are set in an OP_RANGE
> expression. Values
boundarys -> boundaries
Thanks,
Simon
^ permalink raw reply [flat|nested] 11+ messages in thread
end of thread, other threads:[~2017-09-15 22:29 UTC | newest]
Thread overview: 11+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-09-11 12:58 [PATCH 0/5] Fortran: Array strides Tim Wiederhake
2017-09-11 12:58 ` [PATCH 1/5] Fortran: Move calc_f77_array_dims Tim Wiederhake
2017-09-15 20:22 ` Simon Marchi
2017-09-15 20:28 ` Simon Marchi
2017-09-11 12:58 ` [PATCH 5/5] Fortran: Enable parsing of stride parameter for subranges Tim Wiederhake
2017-09-11 12:58 ` [PATCH 4/5] Fortran: Change subrange enum to bit field Tim Wiederhake
2017-09-15 22:29 ` Simon Marchi
2017-09-11 12:58 ` [PATCH 2/5] Fortran: Move value_f90_subarray Tim Wiederhake
2017-09-15 20:27 ` Simon Marchi
2017-09-11 12:58 ` [PATCH 3/5] Fortran: Allow multi-dimensional subarrays Tim Wiederhake
2017-09-15 22:08 ` Simon Marchi
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox