This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
Re: [PATCH 3/5] Fortran: Allow multi-dimensional subarrays.
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