* [PATCH 0/8] Fortran Array Slicing and Striding Support
@ 2020-08-13 12:58 Andrew Burgess
2020-08-13 12:58 ` [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags Andrew Burgess
` (8 more replies)
0 siblings, 9 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-13 12:58 UTC (permalink / raw)
To: gdb-patches
This series adds support to GDB's CLI for taking slices (including
with strides) from a Fortrn array, so after this series, things like
this will work:
(gdb) p array (8:3:-2,2:9:3)
$2 = ((18, 16, 14) (48, 46, 44) (78, 76, 74))
There have been a couple of attempts to provide Fortran array
slice/stride support in the past that I'm aware of:
https://sourceware.org/pipermail/gdb-patches/2017-September/143121.html
https://sourceware.org/pipermail/gdb-patches/2016-February/131539.html
I know that some variation of these patches are currently used in
Fedora's GDB[1] and the GDB installed on my Fedora machine can pass
most of the tests I've added here.
However, having looked at the past implementations that were posted to
the list, the approach I'm taking here is a little different.
The previous approaches took the approach of walking each dimension of
the array, at each dimension extracting a slighlt smaller slice.
Though this approach is fine, it does have one problem related to
memory usage and large arrays. If the original array is large, and
extracting the slice for the first dimension would exceed the
max-value-size, then GDB would be unable to load the slice, even if
the final value would have been under the max-value-size.
The patches presented here have the following features:
- The type of the array slice, including upper and lower bounds,
correctly match the behaviour within Fortran.
- Extracting small slices from very large arrays will not exceed the
max-value-size.
- The extracted slice is (by default) an in-memory lvalue, which
aliases onto the original array and can be assigned to, and have
addresses of elements taken and the results will be correct.
- A Fortran compiler will sometimes repack arrays to make the slice
data contiguous, GDB can do this too when it is essential, and can
optionally do this in all cases if the user requires.
- Repacking is again done with an eye to memory usage, so repacking a
small slice from a large array will not exceed the max-value-size.
I don't propose that these patches, or at least the later patches in
this series, be merged before the GDB 10 branching, but I would be
interested in any feedback.
Thanks,
Andrew
[1] https://sourceware.org/pipermail/gdb-patches/2016-April/132383.html
---
Andrew Burgess (8):
gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags
gdbsupport: Make function arguments constant in enum-flags.h
gdb/fortran: Clean up array/string expression evaluation
gdb/fortran: Move Fortran expression handling into f-lang.c
gdb/fortran: Change whitespace when printing arrays
gdb: Convert enum range_type to a bit field enum
gdb/testsuite: Add missing expected results
gdb/fortran: Add support for Fortran array slices at the GDB prompt
gdb/ChangeLog | 102 +++
gdb/Makefile.in | 1 +
gdb/NEWS | 13 +
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 30 +
gdb/eval.c | 225 +----
gdb/expprint.c | 114 ++-
gdb/expression.h | 39 +-
gdb/f-array-walker.h | 255 ++++++
gdb/f-exp.y | 52 +-
gdb/f-lang.c | 779 ++++++++++++++++++
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 187 +++--
gdb/fortran-operator.def | 8 +
gdb/gdbtypes.c | 12 +-
gdb/parse.c | 25 +-
gdb/parser-defs.h | 16 +
gdb/rust-exp.y | 21 +-
gdb/rust-lang.c | 25 +-
gdb/std-operator.def | 8 -
gdb/testsuite/ChangeLog | 22 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 +
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 264 +++++-
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 +++++++-
.../gdb.fortran/class-allocatable-array.exp | 2 +-
gdb/testsuite/gdb.fortran/multi-dim.exp | 2 +-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
gdb/testsuite/gdb.fortran/vla-type.exp | 6 +-
gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 2 +-
gdbsupport/ChangeLog | 22 +
gdbsupport/enum-flags.h | 50 +-
34 files changed, 2485 insertions(+), 509 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags
2020-08-13 12:58 [PATCH 0/8] Fortran Array Slicing and Striding Support Andrew Burgess
@ 2020-08-13 12:58 ` Andrew Burgess
2020-08-15 17:16 ` Tom Tromey
2020-08-13 12:58 ` [PATCH 2/8] gdbsupport: Make function arguments constant in enum-flags.h Andrew Burgess
` (7 subsequent siblings)
8 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-08-13 12:58 UTC (permalink / raw)
To: gdb-patches
The current enum bit flags mechanism provides global operators &, |,
^, ~, but does not provide &=, |=, ^=.
The implementation for one of these, |=, would look like this:
template <typename enum_type>
typename enum_flags_type<enum_type>::type &
operator|= (enum_type &e1, enum_type e2)
{
e1 = enum_flags<enum_type> (e1) | e2;
return e1;
}
Then if we create a test within GDB like this:
enum some_flag
{
flag_val1 = 1 << 1,
flag_val2 = 1 << 2,
flag_val3 = 1 << 3,
flag_val4 = 1 << 4,
};
DEF_ENUM_FLAGS_TYPE(enum some_flag, some_flags);
...
enum some_flag f = flag_val1 | flag_val2;
f |= flag_val3;
Initially this didn't compile, with an error like:
..../gdbsupport/enum-flags.h: In instantiation of ‘typename enum_flags_type<T>::type& operator|=(enum_type&, enum_type) [with enum_type = some_flag; typename enum_flags_type<T>::type = enum_flags<some_flag>]’:
..../gdb/main.c:168:8: required from here
..../gdbsupport/enum-flags.h:217:10: error: cannot bind non-const lvalue reference of type ‘enum_flags_type<some_flag>::type&’ {aka ‘enum_flags<some_flag>&’} to an rvalue of type ‘enum_flags_type<some_flag>::type’ {aka ‘enum_flags<some_flag>’}
217 | return e1;
| ^~
..../gdbsupport/enum-flags.h:125:3: note: after user-defined conversion: ‘enum_flags<E>::enum_flags(enum_flags<E>::enum_type) [with E = some_flag; enum_flags<E>::enum_type = some_flag]’
125 | enum_flags (enum_type e)
| ^~~~~~~~~~
If we look at enum_flags_type, which is used in the return type of our
operator, it looks like this:
template<>
struct enum_flags_type<enum_type>
{
typedef enum_flags<enum_type> type;
}
So, with `typename' and `typedef' resolved, our new operator actually
compiled like this:
template <typename enum_type>
enum_flags<enum_type> &
operator|= (enum_type &e1, enum_type e2)
{
e1 = enum_flags<enum_type> (e1) | e2;
return e1;
}
And I think this makes the problem clearer (maybe), the return type
reference is different to the argument types, so the compiler is
forced to try and create a temporary (the result of converting `e1' to
type `enum_flags<enum_type>') and return a reference to that temporary.
What I'd like is for the return type to match the arguments, and this
can be achieved I think by changing the enum_flags_type definition to
this:
template<>
struct enum_flags_type<enum_type>
{
typedef enum_type type;
}
Now, once the `typename' and `typedef' are resolved, our new operator
compiles as this:
template <typename enum_type>
enum_type &
operator|= (enum_type &e1, enum_type e2)
{
e1 = enum_flags<enum_type> (e1) | e2;
return e1;
}
And indeed our original example now compiles fine.
The final thing we must take care to check is that the global
operators are not now picking up _all_ enums, after all, this is part
of what the enum-flags.h file does for us, bitwise operators where we
ask for it, and not otherwise.
A manual test on my demo above (with some_flags) confirms that
removing the DEF_ENUM_FLAGS_TYPE line still prevents the code from
compiling as we'd hope, this is because, just like before
`enum_flags_type<enum_type>::type' is only defined for the enums that
have DEF_ENUM_FLAGS_TYPE applied to them.
gdbsupport/ChangeLog:
* enum-flags.h (DEF_ENUM_FLAGS_TYPE): Update header comment, and
define enum_flags_type<enum_type>::type differently.
(operator|=): New.
(operator&=): New.
(operator^=): New.
---
gdbsupport/ChangeLog | 8 ++++++++
gdbsupport/enum-flags.h | 30 +++++++++++++++++++++++++++---
2 files changed, 35 insertions(+), 3 deletions(-)
diff --git a/gdbsupport/enum-flags.h b/gdbsupport/enum-flags.h
index 825ff4faf2c..78db3c7d88e 100644
--- a/gdbsupport/enum-flags.h
+++ b/gdbsupport/enum-flags.h
@@ -55,15 +55,15 @@
instantiating for non-flag enums. */
template<typename T> struct enum_flags_type {};
-/* Use this to mark an enum as flags enum. It defines FLAGS as
+/* Use this to mark an enum as flags enum. It defines FLAGS_TYPE as
enum_flags wrapper class for ENUM, and enables the global operator
- overloads for ENUM. */
+ overloads for ENUM_TYPE. */
#define DEF_ENUM_FLAGS_TYPE(enum_type, flags_type) \
typedef enum_flags<enum_type> flags_type; \
template<> \
struct enum_flags_type<enum_type> \
{ \
- typedef enum_flags<enum_type> type; \
+ typedef enum_type type; \
}
/* Until we can rely on std::underlying type being universally
@@ -209,6 +209,30 @@ operator~ (enum_type e)
return ~enum_flags<enum_type> (e);
}
+template <typename enum_type>
+typename enum_flags_type<enum_type>::type
+operator|= (enum_type &e1, const enum_type &e2)
+{
+ e1 = enum_flags<enum_type> (e1) | e2;
+ return e1;
+}
+
+template <typename enum_type>
+typename enum_flags_type<enum_type>::type
+operator&= (enum_type &e1, const enum_type &e2)
+{
+ e1 = enum_flags<enum_type> (e1) & e2;
+ return e1;
+}
+
+template <typename enum_type>
+typename enum_flags_type<enum_type>::type
+operator^= (enum_type &e1, const enum_type &e2)
+{
+ e1 = enum_flags<enum_type> (e1) ^ e2;
+ return e1;
+}
+
#else /* __cplusplus */
/* In C, the flags type is just a typedef for the enum type. */
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCH 2/8] gdbsupport: Make function arguments constant in enum-flags.h
2020-08-13 12:58 [PATCH 0/8] Fortran Array Slicing and Striding Support Andrew Burgess
2020-08-13 12:58 ` [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags Andrew Burgess
@ 2020-08-13 12:58 ` Andrew Burgess
2020-08-15 19:45 ` Tom Tromey
2020-08-13 12:58 ` [PATCH 3/8] gdb/fortran: Clean up array/string expression evaluation Andrew Burgess
` (6 subsequent siblings)
8 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-08-13 12:58 UTC (permalink / raw)
To: gdb-patches
Make the arguments used for the operators within enum-flags.h constant
references where possible. There should be no user visible changes
after this commit.
gdbsupport/ChangeLog:
* enum-flags.h (enum_flags) <operator&=>: Make arguments const.
<operator|=>: Likewise.
<operator^=>: Likewise.
<operator&>: Likewise.
<operator&>: Likewise.
<operator|>: Likewise.
<operator^>: Likewise.
(operator&): Likewise.
(operator|): Likewise.
(operator^): Likewise.
(operator~): Likewise.
---
gdbsupport/ChangeLog | 14 ++++++++++++++
gdbsupport/enum-flags.h | 20 ++++++++++----------
2 files changed, 24 insertions(+), 10 deletions(-)
diff --git a/gdbsupport/enum-flags.h b/gdbsupport/enum-flags.h
index 78db3c7d88e..356eb7da785 100644
--- a/gdbsupport/enum-flags.h
+++ b/gdbsupport/enum-flags.h
@@ -129,17 +129,17 @@ class enum_flags
: m_enum_value ((enum_type) 0)
{}
- enum_flags &operator&= (enum_type e)
+ enum_flags &operator&= (const enum_type &e)
{
m_enum_value = (enum_type) (underlying_value () & e);
return *this;
}
- enum_flags &operator|= (enum_type e)
+ enum_flags &operator|= (const enum_type &e)
{
m_enum_value = (enum_type) (underlying_value () | e);
return *this;
}
- enum_flags &operator^= (enum_type e)
+ enum_flags &operator^= (const enum_type &e)
{
m_enum_value = (enum_type) (underlying_value () ^ e);
return *this;
@@ -150,15 +150,15 @@ class enum_flags
return m_enum_value;
}
- enum_flags operator& (enum_type e) const
+ enum_flags operator& (const enum_type &e) const
{
return (enum_type) (underlying_value () & e);
}
- enum_flags operator| (enum_type e) const
+ enum_flags operator| (const enum_type &e) const
{
return (enum_type) (underlying_value () | e);
}
- enum_flags operator^ (enum_type e) const
+ enum_flags operator^ (const enum_type &e) const
{
return (enum_type) (underlying_value () ^ e);
}
@@ -183,28 +183,28 @@ class enum_flags
template <typename enum_type>
typename enum_flags_type<enum_type>::type
-operator& (enum_type e1, enum_type e2)
+operator& (const enum_type &e1, const enum_type &e2)
{
return enum_flags<enum_type> (e1) & e2;
}
template <typename enum_type>
typename enum_flags_type<enum_type>::type
-operator| (enum_type e1, enum_type e2)
+operator| (const enum_type &e1, const enum_type &e2)
{
return enum_flags<enum_type> (e1) | e2;
}
template <typename enum_type>
typename enum_flags_type<enum_type>::type
-operator^ (enum_type e1, enum_type e2)
+operator^ (const enum_type &e1, const enum_type &e2)
{
return enum_flags<enum_type> (e1) ^ e2;
}
template <typename enum_type>
typename enum_flags_type<enum_type>::type
-operator~ (enum_type e)
+operator~ (const enum_type &e)
{
return ~enum_flags<enum_type> (e);
}
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCH 3/8] gdb/fortran: Clean up array/string expression evaluation
2020-08-13 12:58 [PATCH 0/8] Fortran Array Slicing and Striding Support Andrew Burgess
2020-08-13 12:58 ` [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags Andrew Burgess
2020-08-13 12:58 ` [PATCH 2/8] gdbsupport: Make function arguments constant in enum-flags.h Andrew Burgess
@ 2020-08-13 12:58 ` Andrew Burgess
2020-08-13 12:58 ` [PATCH 4/8] gdb/fortran: Move Fortran expression handling into f-lang.c Andrew Burgess
` (5 subsequent siblings)
8 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-13 12:58 UTC (permalink / raw)
To: gdb-patches
In preparation for adding Fortan array stride expression support, this
is the first phase of some clean up to the expression evaluation for
Fortran arrays and strings.
The current code is split into two blocks, linked, weirdly, with a
goto. After this commit all the code is moved to its own function,
and arrays and strings are now handled using the same code; this will
be useful later when I want to add array stride support where strings
will want to be treated just like arrays.
For now the new function is added as a static within eval.c, even
though the function is Fortran only. A following commit will remove
some of the Fortran specific code from eval.c into one of the Fortran
specific files, including this new function.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* eval.c (fortran_value_subarray): New function, content is taken
from...
(evaluate_subexp_standard): ...here, in two places. Now arrays
and strings both call the new function.
(calc_f77_array_dims): Add header comment, handle strings.
---
gdb/ChangeLog | 8 +++
gdb/eval.c | 136 +++++++++++++++++++++++++-------------------------
2 files changed, 75 insertions(+), 69 deletions(-)
diff --git a/gdb/eval.c b/gdb/eval.c
index c62c35f3183..59ba1b69e7c 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -1260,6 +1260,67 @@ is_integral_or_integral_reference (struct type *type)
&& is_integral_type (TYPE_TARGET_TYPE (type)));
}
+/* Called from evaluate_subexp_standard to perform array indexing, and
+ sub-range extraction, for Fortran. As well as arrays this function
+ also handles strings as they can be treated like arrays of characters.
+ ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are
+ as for evaluate_subexp_standard, and NARGS is the number of arguments
+ in this access (e.g. 'array (1,2,3)' would be NARGS 3). */
+
+static struct value *
+fortran_value_subarray (struct value *array, struct expression *exp,
+ int *pos, int nargs, enum noside noside)
+{
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ return value_f90_subarray (array, exp, pos, noside);
+
+ if (noside == EVAL_SKIP)
+ {
+ skip_undetermined_arglist (nargs, exp, pos, noside);
+ /* Return the dummy value with the correct type. */
+ return array;
+ }
+
+ LONGEST subscript_array[MAX_FORTRAN_DIMS];
+ int ndimensions = 1;
+ struct type *type = check_typedef (value_type (array));
+
+ if (nargs > MAX_FORTRAN_DIMS)
+ error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+
+ ndimensions = calc_f77_array_dims (type);
+
+ if (nargs != ndimensions)
+ error (_("Wrong number of subscripts"));
+
+ gdb_assert (nargs > 0);
+
+ /* Now that we know we have a legal array subscript expression let us
+ actually find out where this element exists in the array. */
+
+ /* Take array indices left to right. */
+ for (int i = 0; i < nargs; i++)
+ {
+ /* Evaluate each subscript; it must be a legal integer in F77. */
+ value *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 (int 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;
+}
+
struct value *
evaluate_subexp_standard (struct type *expect_type,
struct expression *exp, int *pos,
@@ -1954,33 +2015,8 @@ evaluate_subexp_standard (struct type *expect_type,
switch (code)
{
case TYPE_CODE_ARRAY:
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (arg1, exp, pos, noside);
- else
- {
- if (noside == EVAL_SKIP)
- {
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return arg1;
- }
- goto multi_f77_subscript;
- }
-
case TYPE_CODE_STRING:
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (arg1, exp, pos, noside);
- else
- {
- if (noside == EVAL_SKIP)
- {
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return arg1;
- }
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- return value_subscript (arg1, value_as_long (arg2));
- }
+ return fortran_value_subarray (arg1, exp, pos, nargs, noside);
case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
@@ -2400,49 +2436,6 @@ evaluate_subexp_standard (struct type *expect_type,
}
return (arg1);
- multi_f77_subscript:
- {
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1, i;
- struct value *array = arg1;
-
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
-
- ndimensions = calc_f77_array_dims (type);
-
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
-
- gdb_assert (nargs > 0);
-
- /* Now that we know we have a legal array subscript expression
- let us actually find out where this element exists in the array. */
-
- /* Take array indices left to right. */
- for (i = 0; i < nargs; i++)
- {
- /* Evaluate each subscript; it must be a legal integer in F77. */
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
-
- /* Fill in the subscript array. */
-
- subscript_array[i] = value_as_long (arg2);
- }
-
- /* Internal type of array is arranged right to left. */
- for (i = nargs; i > 0; i--)
- {
- struct type *array_type = check_typedef (value_type (array));
- LONGEST index = subscript_array[i - 1];
-
- array = value_subscripted_rvalue (array, index,
- f77_get_lowerbound (array_type));
- }
-
- return array;
- }
-
case BINOP_LOGICAL_AND:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
@@ -3356,12 +3349,17 @@ parse_and_eval_type (char *p, int length)
return expr->elts[1].type;
}
+/* Return the number of dimensions for a Fortran array or string. */
+
int
calc_f77_array_dims (struct type *array_type)
{
int ndimen = 1;
struct type *tmp_type;
+ if ((array_type->code () == TYPE_CODE_STRING))
+ return 1;
+
if ((array_type->code () != TYPE_CODE_ARRAY))
error (_("Can't get dimensions for a non-array type"));
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCH 4/8] gdb/fortran: Move Fortran expression handling into f-lang.c
2020-08-13 12:58 [PATCH 0/8] Fortran Array Slicing and Striding Support Andrew Burgess
` (2 preceding siblings ...)
2020-08-13 12:58 ` [PATCH 3/8] gdb/fortran: Clean up array/string expression evaluation Andrew Burgess
@ 2020-08-13 12:58 ` Andrew Burgess
2020-08-13 12:58 ` [PATCH 5/8] gdb/fortran: Change whitespace when printing arrays Andrew Burgess
` (4 subsequent siblings)
8 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-13 12:58 UTC (permalink / raw)
To: gdb-patches
The Fortran specific OP_F77_UNDETERMINED_ARGLIST is currently handled
in the generic expression handling code. As I start to add array
stride support in here the amount of Fortran only code that is forced
into the generic expression evaluation file will grow.
Now seems like a good time to move this Fortran specific operation
into the Fortran specific files.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* eval.c: Remove 'f-lang.h' include.
(value_f90_subarray): Moved to f-lang.c.
(eval_call): Renamed to...
(evaluate_subexp_do_call): ...this, is no longer static, header
comment moved into header file.
(evaluate_funcall): Update call to eval_call.
(skip_undetermined_arglist): Moved to f-lang.c.
(fortran_value_subarray): Likewise.
(evaluate_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to evaluate_subexp_f.
(calc_f77_array_dims): Moved to f-lang.c
* expprint.c (print_subexp_funcall): New function.
(print_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to print_subexp_f, OP_FUNCALL uses new function.
(dump_subexp_body_funcall): New function.
(dump_subexp_body_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to dump_subexp_f, OP_FUNCALL uses new function.
* expression.h (evaluate_subexp_do_call): Declare.
* f-lang.c (value_f90_subarray): Moved from eval.c.
(skip_undetermined_arglist): Likewise.
(calc_f77_array_dims): Likewise.
(fortran_value_subarray): Likewise.
(evaluate_subexp_f): Add OP_F77_UNDETERMINED_ARGLIST support.
(operator_length_f): Likewise.
(print_subexp_f): Likewise.
(dump_subexp_body_f): Likewise.
* fortran-operator.def (OP_F77_UNDETERMINED_ARGLIST): Move
declaration of this operation to here.
* parse.c (operator_length_standard): OP_F77_UNDETERMINED_ARGLIST
support moved to operator_length_f.
* parser-defs.h (dump_subexp_body_funcall): Declare.
(print_subexp_funcall): Declare.
* std-operator.def (OP_F77_UNDETERMINED_ARGLIST): Moved to
fortran-operator.def.
---
gdb/ChangeLog | 37 +++++++
gdb/eval.c | 223 ++-------------------------------------
gdb/expprint.c | 61 ++++++-----
gdb/expression.h | 12 +++
gdb/f-lang.c | 221 ++++++++++++++++++++++++++++++++++++++
gdb/fortran-operator.def | 8 ++
gdb/parse.c | 1 -
gdb/parser-defs.h | 16 +++
gdb/std-operator.def | 8 --
9 files changed, 339 insertions(+), 248 deletions(-)
diff --git a/gdb/eval.c b/gdb/eval.c
index 59ba1b69e7c..c8056c20154 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -26,7 +26,6 @@
#include "frame.h"
#include "gdbthread.h"
#include "language.h" /* For CAST_IS_CONVERSION. */
-#include "f-lang.h" /* For array bound stuff. */
#include "cp-abi.h"
#include "infcall.h"
#include "objc-lang.h"
@@ -371,32 +370,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 (value_type (array)->index_type ());
- 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 = range->bounds ()->low.const_val ();
- 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 = range->bounds ()->high.const_val ();
- 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
@@ -749,17 +722,13 @@ eval_skip_value (expression *exp)
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
}
-/* Evaluate a function call. The function to be called is in
- ARGVEC[0] and the arguments passed to the function are in
- ARGVEC[1..NARGS]. FUNCTION_NAME is the name of the function, if
- known. DEFAULT_RETURN_TYPE is used as the function's return type
- if the return type is unknown. */
+/* See expression.h. */
-static value *
-eval_call (expression *exp, enum noside noside,
- int nargs, value **argvec,
- const char *function_name,
- type *default_return_type)
+value *
+evaluate_subexp_do_call (expression *exp, enum noside noside,
+ int nargs, value **argvec,
+ const char *function_name,
+ type *default_return_type)
{
if (argvec[0] == NULL)
error (_("Cannot evaluate function -- may be inlined"));
@@ -1230,20 +1199,8 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
/* Nothing to be done; argvec already correctly set up. */
}
- return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
-}
-
-/* Helper for skipping all the arguments in an undetermined argument list.
- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
- case of evaluate_subexp_standard as multiple, but not all, code paths
- require a generic skip. */
-
-static void
-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
- enum noside noside)
-{
- for (int i = 0; i < nargs; ++i)
- evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ return evaluate_subexp_do_call (exp, noside, nargs, argvec,
+ var_func_name, expect_type);
}
/* Return true if type is integral or reference to integral */
@@ -1260,67 +1217,6 @@ is_integral_or_integral_reference (struct type *type)
&& is_integral_type (TYPE_TARGET_TYPE (type)));
}
-/* Called from evaluate_subexp_standard to perform array indexing, and
- sub-range extraction, for Fortran. As well as arrays this function
- also handles strings as they can be treated like arrays of characters.
- ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are
- as for evaluate_subexp_standard, and NARGS is the number of arguments
- in this access (e.g. 'array (1,2,3)' would be NARGS 3). */
-
-static struct value *
-fortran_value_subarray (struct value *array, struct expression *exp,
- int *pos, int nargs, enum noside noside)
-{
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (array, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
- {
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return array;
- }
-
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1;
- struct type *type = check_typedef (value_type (array));
-
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
-
- ndimensions = calc_f77_array_dims (type);
-
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
-
- gdb_assert (nargs > 0);
-
- /* Now that we know we have a legal array subscript expression let us
- actually find out where this element exists in the array. */
-
- /* Take array indices left to right. */
- for (int i = 0; i < nargs; i++)
- {
- /* Evaluate each subscript; it must be a legal integer in F77. */
- value *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 (int 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;
-}
-
struct value *
evaluate_subexp_standard (struct type *expect_type,
struct expression *exp, int *pos,
@@ -1335,7 +1231,6 @@ evaluate_subexp_standard (struct type *expect_type,
struct type *type;
int nargs;
struct value **argvec;
- int code;
int ix;
long mem_offset;
struct type **arg_types;
@@ -1977,84 +1872,6 @@ evaluate_subexp_standard (struct type *expect_type,
case OP_FUNCALL:
return evaluate_funcall (expect_type, exp, pos, noside);
- case OP_F77_UNDETERMINED_ARGLIST:
-
- /* Remember that in F77, functions, substring ops and
- array subscript operations cannot be disambiguated
- at parse time. We have made all array subscript operations,
- substring operations as well as function calls come here
- and we now have to discover what the heck this thing actually was.
- If it is a function, we process just as if we got an OP_FUNCALL. */
-
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
- (*pos) += 2;
-
- /* First determine the type code we are dealing with. */
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- type = check_typedef (value_type (arg1));
- code = type->code ();
-
- if (code == TYPE_CODE_PTR)
- {
- /* Fortran always passes variable to subroutines as pointer.
- So we need to look into its target type to see if it is
- array, string or function. If it is, we need to switch
- to the target value the original one points to. */
- struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
-
- if (target_type->code () == TYPE_CODE_ARRAY
- || target_type->code () == TYPE_CODE_STRING
- || target_type->code () == TYPE_CODE_FUNC)
- {
- arg1 = value_ind (arg1);
- type = check_typedef (value_type (arg1));
- code = type->code ();
- }
- }
-
- switch (code)
- {
- case TYPE_CODE_ARRAY:
- case TYPE_CODE_STRING:
- return fortran_value_subarray (arg1, exp, pos, nargs, noside);
-
- case TYPE_CODE_PTR:
- case TYPE_CODE_FUNC:
- case TYPE_CODE_INTERNAL_FUNCTION:
- /* It's a function call. */
- /* Allocate arg vector, including space for the function to be
- called in argvec[0] and a terminating NULL. */
- argvec = (struct value **)
- alloca (sizeof (struct value *) * (nargs + 2));
- argvec[0] = arg1;
- tem = 1;
- for (; tem <= nargs; tem++)
- {
- argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
- /* Arguments in Fortran are passed by address. Coerce the
- arguments here rather than in value_arg_coerce as otherwise
- the call to malloc to place the non-lvalue parameters in
- target memory is hit by this Fortran specific logic. This
- results in malloc being called with a pointer to an integer
- followed by an attempt to malloc the arguments to malloc in
- target memory. Infinite recursion ensues. */
- if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
- {
- bool is_artificial
- = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
- argvec[tem] = fortran_argument_convert (argvec[tem],
- is_artificial);
- }
- }
- argvec[tem] = 0; /* signal end of arglist */
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
- return eval_call (exp, noside, nargs, argvec, NULL, expect_type);
-
- default:
- error (_("Cannot perform substring on this type"));
- }
-
case OP_COMPLEX:
/* We have a complex number, There should be 2 floating
point numbers that compose it. */
@@ -3348,27 +3165,3 @@ parse_and_eval_type (char *p, int length)
error (_("Internal error in eval_type."));
return expr->elts[1].type;
}
-
-/* Return the number of dimensions for a Fortran array or string. */
-
-int
-calc_f77_array_dims (struct type *array_type)
-{
- int ndimen = 1;
- struct type *tmp_type;
-
- if ((array_type->code () == TYPE_CODE_STRING))
- return 1;
-
- if ((array_type->code () != 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 (tmp_type->code () == TYPE_CODE_ARRAY)
- ++ndimen;
- }
- return ndimen;
-}
diff --git a/gdb/expprint.c b/gdb/expprint.c
index 5427a56f6ae..350f291b75e 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -53,6 +53,25 @@ print_subexp (struct expression *exp, int *pos,
exp->language_defn->la_exp_desc->print_subexp (exp, pos, stream, prec);
}
+/* See parser-defs.h. */
+
+void
+print_subexp_funcall (struct expression *exp, int *pos,
+ struct ui_file *stream)
+{
+ (*pos) += 2;
+ unsigned nargs = longest_to_int (exp->elts[*pos].longconst);
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fputs_filtered (" (", stream);
+ for (unsigned tem = 0; tem < nargs; tem++)
+ {
+ if (tem != 0)
+ fputs_filtered (", ", stream);
+ print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
+ }
+ fputs_filtered (")", stream);
+}
+
/* Standard implementation of print_subexp for use in language_defn
vectors. */
void
@@ -187,18 +206,7 @@ print_subexp_standard (struct expression *exp, int *pos,
return;
case OP_FUNCALL:
- case OP_F77_UNDETERMINED_ARGLIST:
- (*pos) += 2;
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered (" (", stream);
- for (tem = 0; tem < nargs; tem++)
- {
- if (tem != 0)
- fputs_filtered (", ", stream);
- print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
- }
- fputs_filtered (")", stream);
+ print_subexp_funcall (exp, pos, stream);
return;
case OP_NAME:
@@ -796,6 +804,22 @@ dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
return exp->language_defn->la_exp_desc->dump_subexp_body (exp, stream, elt);
}
+/* See parser-defs.h. */
+
+int
+dump_subexp_body_funcall (struct expression *exp,
+ struct ui_file *stream, int elt)
+{
+ int nargs = longest_to_int (exp->elts[elt].longconst);
+ fprintf_filtered (stream, "Number of args: %d", nargs);
+ elt += 2;
+
+ for (int i = 1; i <= nargs + 1; i++)
+ elt = dump_subexp (exp, stream, elt);
+
+ return elt;
+}
+
/* Default value for subexp_body in exp_descriptor vector. */
int
@@ -931,18 +955,7 @@ dump_subexp_body_standard (struct expression *exp,
elt += 2;
break;
case OP_FUNCALL:
- case OP_F77_UNDETERMINED_ARGLIST:
- {
- int i, nargs;
-
- nargs = longest_to_int (exp->elts[elt].longconst);
-
- fprintf_filtered (stream, "Number of args: %d", nargs);
- elt += 2;
-
- for (i = 1; i <= nargs + 1; i++)
- elt = dump_subexp (exp, stream, elt);
- }
+ elt = dump_subexp_body_funcall (exp, stream, elt);
break;
case OP_ARRAY:
{
diff --git a/gdb/expression.h b/gdb/expression.h
index f1128c44248..5af10f05db1 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -155,6 +155,18 @@ enum noside
extern struct value *evaluate_subexp_standard
(struct type *, struct expression *, int *, enum noside);
+/* Evaluate a function call. The function to be called is in ARGVEC[0] and
+ the arguments passed to the function are in ARGVEC[1..NARGS].
+ FUNCTION_NAME is the name of the function, if known.
+ DEFAULT_RETURN_TYPE is used as the function's return type if the return
+ type is unknown. */
+
+extern struct value *evaluate_subexp_do_call (expression *exp,
+ enum noside noside,
+ int nargs, value **argvec,
+ const char *function_name,
+ type *default_return_type);
+
/* From expprint.c */
extern void print_expression (struct expression *, struct ui_file *);
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 58b41d11d11..6210522c182 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -114,6 +114,134 @@ enum f_primitive_types {
nr_f_primitive_types
};
+/* Called from fortran_value_subarray to take a slice of an array or a
+ string. ARRAY is the array or string to be accessed. EXP, POS, and
+ NOSIDE are as for evaluate_subexp_standard. Return a value that is a
+ slice of the array. */
+
+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 (value_type (array)->index_type ());
+ 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 = range->bounds ()->low.const_val ();
+ 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 = range->bounds ()->high.const_val ();
+ else
+ high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+
+ return value_slice (array, low_bound, high_bound - low_bound + 1);
+}
+
+/* Helper for skipping all the arguments in an undetermined argument list.
+ This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
+ case of evaluate_subexp_standard as multiple, but not all, code paths
+ require a generic skip. */
+
+static void
+skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
+ enum noside noside)
+{
+ for (int i = 0; i < nargs; ++i)
+ evaluate_subexp (NULL_TYPE, exp, pos, noside);
+}
+
+/* Return the number of dimensions for a Fortran array or string. */
+
+int
+calc_f77_array_dims (struct type *array_type)
+{
+ int ndimen = 1;
+ struct type *tmp_type;
+
+ if ((array_type->code () == TYPE_CODE_STRING))
+ return 1;
+
+ if ((array_type->code () != 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 (tmp_type->code () == TYPE_CODE_ARRAY)
+ ++ndimen;
+ }
+ return ndimen;
+}
+
+/* Called from evaluate_subexp_standard to perform array indexing, and
+ sub-range extraction, for Fortran. As well as arrays this function
+ also handles strings as they can be treated like arrays of characters.
+ ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are
+ as for evaluate_subexp_standard, and NARGS is the number of arguments
+ in this access (e.g. 'array (1,2,3)' would be NARGS 3). */
+
+static struct value *
+fortran_value_subarray (struct value *array, struct expression *exp,
+ int *pos, int nargs, enum noside noside)
+{
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ return value_f90_subarray (array, exp, pos, noside);
+
+ if (noside == EVAL_SKIP)
+ {
+ skip_undetermined_arglist (nargs, exp, pos, noside);
+ /* Return the dummy value with the correct type. */
+ return array;
+ }
+
+ LONGEST subscript_array[MAX_FORTRAN_DIMS];
+ int ndimensions = 1;
+ struct type *type = check_typedef (value_type (array));
+
+ if (nargs > MAX_FORTRAN_DIMS)
+ error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+
+ ndimensions = calc_f77_array_dims (type);
+
+ if (nargs != ndimensions)
+ error (_("Wrong number of subscripts"));
+
+ gdb_assert (nargs > 0);
+
+ /* Now that we know we have a legal array subscript expression let us
+ actually find out where this element exists in the array. */
+
+ /* Take array indices left to right. */
+ for (int i = 0; i < nargs; i++)
+ {
+ /* Evaluate each subscript; it must be a legal integer in F77. */
+ value *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 (int 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;
+}
+
/* Special expression evaluation cases for Fortran. */
static struct value *
@@ -285,6 +413,87 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
TYPE_LENGTH (type));
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
TYPE_LENGTH (TYPE_TARGET_TYPE (type)));
+
+
+ case OP_F77_UNDETERMINED_ARGLIST:
+ /* Remember that in F77, functions, substring ops and array subscript
+ operations cannot be disambiguated at parse time. We have made
+ all array subscript operations, substring operations as well as
+ function calls come here and we now have to discover what the heck
+ this thing actually was. If it is a function, we process just as
+ if we got an OP_FUNCALL. */
+ int nargs = longest_to_int (exp->elts[pc + 1].longconst);
+ (*pos) += 2;
+
+ /* First determine the type code we are dealing with. */
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ type = check_typedef (value_type (arg1));
+ enum type_code code = type->code ();
+
+ if (code == TYPE_CODE_PTR)
+ {
+ /* Fortran always passes variable to subroutines as pointer.
+ So we need to look into its target type to see if it is
+ array, string or function. If it is, we need to switch
+ to the target value the original one points to. */
+ struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
+
+ if (target_type->code () == TYPE_CODE_ARRAY
+ || target_type->code () == TYPE_CODE_STRING
+ || target_type->code () == TYPE_CODE_FUNC)
+ {
+ arg1 = value_ind (arg1);
+ type = check_typedef (value_type (arg1));
+ code = type->code ();
+ }
+ }
+
+ switch (code)
+ {
+ case TYPE_CODE_ARRAY:
+ case TYPE_CODE_STRING:
+ return fortran_value_subarray (arg1, exp, pos, nargs, noside);
+
+ case TYPE_CODE_PTR:
+ case TYPE_CODE_FUNC:
+ case TYPE_CODE_INTERNAL_FUNCTION:
+ {
+ /* It's a function call. Allocate arg vector, including
+ space for the function to be called in argvec[0] and a
+ termination NULL. */
+ struct value **argvec = (struct value **)
+ alloca (sizeof (struct value *) * (nargs + 2));
+ argvec[0] = arg1;
+ int tem = 1;
+ for (; tem <= nargs; tem++)
+ {
+ argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
+ /* Arguments in Fortran are passed by address. Coerce the
+ arguments here rather than in value_arg_coerce as
+ otherwise the call to malloc to place the non-lvalue
+ parameters in target memory is hit by this Fortran
+ specific logic. This results in malloc being called
+ with a pointer to an integer followed by an attempt to
+ malloc the arguments to malloc in target memory.
+ Infinite recursion ensues. */
+ if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
+ {
+ bool is_artificial
+ = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
+ argvec[tem] = fortran_argument_convert (argvec[tem],
+ is_artificial);
+ }
+ }
+ argvec[tem] = 0; /* signal end of arglist */
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ return evaluate_subexp_do_call (exp, noside, nargs, argvec, NULL,
+ expect_type);
+ }
+
+ default:
+ error (_("Cannot perform substring on this type"));
+ }
}
/* Should be unreachable. */
@@ -318,6 +527,11 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp,
oplen = 1;
args = 2;
break;
+
+ case OP_F77_UNDETERMINED_ARGLIST:
+ oplen = 3;
+ args = 1 + longest_to_int (exp->elts[pc - 2].longconst);
+ break;
}
*oplenp = oplen;
@@ -390,6 +604,10 @@ print_subexp_f (struct expression *exp, int *pos,
case BINOP_FORTRAN_MODULO:
print_binop_subexp_f (exp, pos, stream, prec, "MODULO");
return;
+
+ case OP_F77_UNDETERMINED_ARGLIST:
+ print_subexp_funcall (exp, pos, stream);
+ return;
}
}
@@ -432,6 +650,9 @@ dump_subexp_body_f (struct expression *exp,
case BINOP_FORTRAN_MODULO:
operator_length_f (exp, (elt + 1), &oplen, &nargs);
break;
+
+ case OP_F77_UNDETERMINED_ARGLIST:
+ return dump_subexp_body_funcall (exp, stream, elt);
}
elt += oplen;
diff --git a/gdb/fortran-operator.def b/gdb/fortran-operator.def
index fd4051ebe59..bfdbc401711 100644
--- a/gdb/fortran-operator.def
+++ b/gdb/fortran-operator.def
@@ -17,6 +17,14 @@
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
+/* This is EXACTLY like OP_FUNCALL but is semantically different.
+ In F77, array subscript expressions, substring expressions and
+ function calls are all exactly the same syntactically. They
+ may only be disambiguated at runtime. Thus this operator,
+ which indicates that we have found something of the form
+ <name> ( <stuff> ). */
+OP (OP_F77_UNDETERMINED_ARGLIST)
+
/* Single operand builtins. */
OP (UNOP_FORTRAN_KIND)
OP (UNOP_FORTRAN_FLOOR)
diff --git a/gdb/parse.c b/gdb/parse.c
index 2fb474e27f1..435f87a06e4 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -817,7 +817,6 @@ operator_length_standard (const struct expression *expr, int endpos,
break;
case OP_FUNCALL:
- case OP_F77_UNDETERMINED_ARGLIST:
oplen = 3;
args = 1 + longest_to_int (expr->elts[endpos - 2].longconst);
break;
diff --git a/gdb/parser-defs.h b/gdb/parser-defs.h
index a9b8a12959b..bc6fc2f9ba3 100644
--- a/gdb/parser-defs.h
+++ b/gdb/parser-defs.h
@@ -338,6 +338,13 @@ extern int dump_subexp (struct expression *, struct ui_file *, int);
extern int dump_subexp_body_standard (struct expression *,
struct ui_file *, int);
+/* Dump (to STREAM) a function call like expression at position ELT in the
+ expression array EXP. Return a new value for ELT just after the
+ function call expression. */
+
+extern int dump_subexp_body_funcall (struct expression *exp,
+ struct ui_file *stream, int elt);
+
extern void operator_length (const struct expression *, int, int *, int *);
extern void operator_length_standard (const struct expression *, int, int *,
@@ -440,6 +447,15 @@ extern void print_subexp (struct expression *, int *, struct ui_file *,
extern void print_subexp_standard (struct expression *, int *,
struct ui_file *, enum precedence);
+/* Print a function call like expression to STREAM. This is called as a
+ helper function by which point the expression node identifying this as a
+ function call has already been stripped off and POS should point to the
+ number of function call arguments. EXP is the object containing the
+ list of expression elements. */
+
+extern void print_subexp_funcall (struct expression *exp, int *pos,
+ struct ui_file *stream);
+
/* Function used to avoid direct calls to fprintf
in the code generated by the bison parser. */
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index e969bdccaed..6f90875f477 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -168,14 +168,6 @@ OP (OP_FUNCALL)
pointer. This is an Objective C message. */
OP (OP_OBJC_MSGCALL)
-/* This is EXACTLY like OP_FUNCALL but is semantically different.
- In F77, array subscript expressions, substring expressions and
- function calls are all exactly the same syntactically. They
- may only be disambiguated at runtime. Thus this operator,
- which indicates that we have found something of the form
- <name> ( <stuff> ). */
-OP (OP_F77_UNDETERMINED_ARGLIST)
-
/* OP_COMPLEX takes a type in the following element, followed by another
OP_COMPLEX, making three exp_elements. It is followed by two double
args, and converts them into a complex number of the given type. */
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCH 5/8] gdb/fortran: Change whitespace when printing arrays
2020-08-13 12:58 [PATCH 0/8] Fortran Array Slicing and Striding Support Andrew Burgess
` (3 preceding siblings ...)
2020-08-13 12:58 ` [PATCH 4/8] gdb/fortran: Move Fortran expression handling into f-lang.c Andrew Burgess
@ 2020-08-13 12:58 ` Andrew Burgess
2020-08-13 12:58 ` [PATCH 6/8] gdb: Convert enum range_type to a bit field enum Andrew Burgess
` (3 subsequent siblings)
8 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-13 12:58 UTC (permalink / raw)
To: gdb-patches
This commit makes the whitespace usage when printing Fortran arrays
more consistent, and more inline with how we print C arrays.
Currently a 2 dimensional Fotran array is printed like this, I find
the marked whitespace unpleasant:
(( 1, 2, 3) ( 4, 5, 6) )
^ ^ ^
After this commit the same array is printed like this:
((1, 2, 3) (4, 5, 6))
Which seems more inline with how we print C arrays, in the case of C
arrays we don't add extra whitespace before the first element.
gdb/ChangeLog:
* f-valprint.c (f77_print_array_1): Adjust printing of whitespace
for arrays.
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices.exp: Update expected results.
* gdb.fortran/class-allocatable-array.exp: Likewise.
* gdb.fortran/multi-dim.exp: Likewise.
* gdb.fortran/vla-type.exp: Likewise.
* gdb.mi/mi-vla-fortran.exp: Likewise.
---
gdb/ChangeLog | 5 +++++
gdb/f-valprint.c | 7 +++++--
gdb/testsuite/ChangeLog | 8 ++++++++
gdb/testsuite/gdb.fortran/array-slices.exp | 16 ++++++++--------
.../gdb.fortran/class-allocatable-array.exp | 2 +-
gdb/testsuite/gdb.fortran/multi-dim.exp | 2 +-
gdb/testsuite/gdb.fortran/vla-type.exp | 6 +++---
gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 2 +-
8 files changed, 32 insertions(+), 16 deletions(-)
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index fabdf458616..3973984542c 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -137,14 +137,17 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
(TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
+ offs, addr + offs);
- fprintf_filtered (stream, "( ");
+ fprintf_filtered (stream, "(");
f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
value_contents_for_printing (subarray),
value_embedded_offset (subarray),
value_address (subarray),
stream, recurse, subarray, options, elts);
offs += byte_stride;
- fprintf_filtered (stream, ") ");
+ fprintf_filtered (stream, ")");
+
+ if (i < upperbound)
+ fprintf_filtered (stream, " ");
}
if (*elts >= options->print_max && i < upperbound)
fprintf_filtered (stream, "...");
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index 4ca1db90f7f..8587c51e990 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -38,14 +38,14 @@ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
set array_contents \
[list \
- " = \\(\\( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\( 11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\( 21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\( 31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\( 41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\( 51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\( 61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\( 71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\( 81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\( 91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\) \\)" \
- " = \\(\\( 1, 2, 3, 4, 5\\) \\( 11, 12, 13, 14, 15\\) \\( 21, 22, 23, 24, 25\\) \\( 31, 32, 33, 34, 35\\) \\( 41, 42, 43, 44, 45\\) \\)" \
- " = \\(\\( 1, 3, 5, 7, 9\\) \\( 21, 23, 25, 27, 29\\) \\( 41, 43, 45, 47, 49\\) \\( 61, 63, 65, 67, 69\\) \\( 81, 83, 85, 87, 89\\) \\)" \
- " = \\(\\( 1, 4, 7, 10\\) \\( 21, 24, 27, 30\\) \\( 41, 44, 47, 50\\) \\( 61, 64, 67, 70\\) \\( 81, 84, 87, 90\\) \\)" \
- " = \\(\\( 1, 5, 9\\) \\( 31, 35, 39\\) \\( 61, 65, 69\\) \\( 91, 95, 99\\) \\)" \
- " = \\(\\( -26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\( -19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\( -12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\( -5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\( 2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\( 9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\( 16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\( 23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\( 30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\( 37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\) \\)" \
- " = \\(\\( -26, -25, -24, -23, -22, -21\\) \\( -19, -18, -17, -16, -15, -14\\) \\( -12, -11, -10, -9, -8, -7\\) \\)" \
- " = \\(\\( -26, -24, -22, -20, -18\\) \\( -5, -3, -1, 1, 3\\) \\( 16, 18, 20, 22, 24\\) \\( 37, 39, 41, 43, 45\\) \\)" ]
+ " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
+ " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
+ " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
+ " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
+ " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
+ " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
+ " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
+ " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
set message_strings \
[list \
diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
index 9475ba3b393..cdee73ff5cb 100644
--- a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
+++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
@@ -40,4 +40,4 @@ gdb_continue_to_breakpoint "Break Here"
# cetainly going to fail.
gdb_test "print this" " = \\( _data = \[^\r\n\]+, _vptr = \[^\r\n\]+\\)"
gdb_test "print this%_data" " = \\(PTR TO -> \\( Type test_type \\)\\) \[^\r\n\]+"
-gdb_test "print this%_data%b" " = \\(\\( 1, 2, 3\\) \\( 4, 5, 6\\) \\)"
+gdb_test "print this%_data%b" " = \\(\\(1, 2, 3\\) \\(4, 5, 6\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/multi-dim.exp b/gdb/testsuite/gdb.fortran/multi-dim.exp
index ef6c6da8bd5..8cb419a0a7e 100644
--- a/gdb/testsuite/gdb.fortran/multi-dim.exp
+++ b/gdb/testsuite/gdb.fortran/multi-dim.exp
@@ -57,7 +57,7 @@ gdb_test "print foo(3,3,4)" \
"print an invalid array index (3,3,4)"
gdb_test "print foo" \
- { = \(\( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 20\) \) \)} \
+ { = \(\(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 20\)\)\)} \
"print full contents of the array"
gdb_breakpoint [gdb_get_line_number "break-variable"]
diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
index f007ea3a786..ede813c22ce 100755
--- a/gdb/testsuite/gdb.fortran/vla-type.exp
+++ b/gdb/testsuite/gdb.fortran/vla-type.exp
@@ -60,9 +60,9 @@ gdb_test "ptype twov" \
"\\s+$int, allocatable :: ivla1\\\(5,12,99\\\)" \
"\\s+$int, allocatable :: ivla2\\\(9,12\\\)" \
"End Type two" ]
-gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\
- \\\( 1, 1, 321, 1, 1\\\)\
- \\\( 1, 1, 1, 1, 1\\\) .*"
+gdb_test "print twov" " = \\\( ivla1 = \\\(\\\(\\\(1, 1, 1, 1, 1\\\)\
+ \\\(1, 1, 321, 1, 1\\\)\
+ \\\(1, 1, 1, 1, 1\\\) .*"
# Check type with attribute at beginn of type
gdb_breakpoint [gdb_get_line_number "threev-filled"]
diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
index 05e71e57ddd..e862725f48d 100644
--- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
@@ -180,7 +180,7 @@ mi_run_cmd
mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
{ "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
mi_gdb_test "590-data-evaluate-expression pvla2" \
- "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \
+ "590\\^done,value=\"\\(\\(2, 2, 2, 2, 2\\) \\(2, 2, 2, 2, 2\\)\\)\"" \
"evaluate associated vla"
mi_create_varobj_checked pvla2_associated pvla2 \
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCH 6/8] gdb: Convert enum range_type to a bit field enum
2020-08-13 12:58 [PATCH 0/8] Fortran Array Slicing and Striding Support Andrew Burgess
` (4 preceding siblings ...)
2020-08-13 12:58 ` [PATCH 5/8] gdb/fortran: Change whitespace when printing arrays Andrew Burgess
@ 2020-08-13 12:58 ` Andrew Burgess
2020-08-13 12:58 ` [PATCH 7/8] gdb/testsuite: Add missing expected results Andrew Burgess
` (2 subsequent siblings)
8 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-13 12:58 UTC (permalink / raw)
To: gdb-patches
The expression range_type enum represents the following ideas:
- Lower bound is set to default,
- Upper bound is set to default,
- Upper bound is exclusive.
There are currently 6 entries in the enum to represent the combination
of all those ideas.
In a future commit I'd like to add stride information to the range,
this could in theory appear with any of the existing enum entries, so
this would take us to 12 enum entries.
This feels like its getting a little out of hand, so in this commit I
switch the range_type enum over to being a flags style enum. There's
one entry to represent no flags being set, then 3 flags to represent
the 3 ideas above. Adding stride information will require adding only
one more enum flag.
I've then gone through and updated the code to handle this change.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* expprint.c (print_subexp_standard): Update to reflect changes to
enum range_type.
(dump_subexp_body_standard): Likewise.
* expression.h (enum range_type): Convert to a bit field enum.
* f-exp.y (subrange): Update to reflect changes to enum
range_type.
* f-lang.c (value_f90_subarray): Likewise.
* parse.c (operator_length_standard): Likewise.
* rust-exp.y (rust_parser::convert_ast_to_expression): Likewise.
* rust-lang.c (rust_range): Likewise.
(rust_compute_range): Likewise.
(rust_subscript): Likewise.
---
gdb/ChangeLog | 15 +++++++++++++++
gdb/expprint.c | 49 ++++++++++++++----------------------------------
gdb/expression.h | 24 ++++++++++++------------
gdb/f-exp.y | 14 +++++++++-----
gdb/f-lang.c | 4 ++--
gdb/parse.c | 22 +++++++---------------
gdb/rust-exp.y | 21 +++++++++++++--------
gdb/rust-lang.c | 25 +++++++++++-------------
8 files changed, 83 insertions(+), 91 deletions(-)
diff --git a/gdb/expprint.c b/gdb/expprint.c
index 350f291b75e..1d8aedb1fbd 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -584,17 +584,13 @@ print_subexp_standard (struct expression *exp, int *pos,
longest_to_int (exp->elts[pc + 1].longconst);
*pos += 2;
- if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE
- || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)
+ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
fputs_filtered ("EXCLUSIVE_", stream);
fputs_filtered ("RANGE(", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
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 & RANGE_HIGH_BOUND_DEFAULT))
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
@@ -1114,36 +1110,19 @@ dump_subexp_body_standard (struct expression *exp,
longest_to_int (exp->elts[elt].longconst);
elt += 2;
- switch (range_type)
- {
- case BOTH_BOUND_DEFAULT:
- fputs_filtered ("Range '..'", stream);
- break;
- case LOW_BOUND_DEFAULT:
- fputs_filtered ("Range '..EXP'", stream);
- break;
- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- fputs_filtered ("ExclusiveRange '..EXP'", stream);
- break;
- case HIGH_BOUND_DEFAULT:
- fputs_filtered ("Range 'EXP..'", stream);
- break;
- case NONE_BOUND_DEFAULT:
- fputs_filtered ("Range 'EXP..EXP'", stream);
- break;
- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
- break;
- default:
- fputs_filtered ("Invalid Range!", stream);
- break;
- }
+ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
+ fputs_filtered ("Exclusive", stream);
+ fputs_filtered ("Range '", stream);
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ fputs_filtered ("EXP", stream);
+ fputs_filtered ("..", stream);
+ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ fputs_filtered ("EXP", stream);
+ fputs_filtered ("'", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
- if (range_type == LOW_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 5af10f05db1..9dc598984e0 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -187,20 +187,20 @@ extern void dump_prefix_expression (struct expression *, struct ui_file *);
enum range_type
{
- /* Neither the low nor the high bound was given -- so this refers to
- the entire available range. */
- BOTH_BOUND_DEFAULT,
+ /* This is a standard range. Both the lower and upper bounds are
+ defined, and the bounds are inclusive. */
+ RANGE_STANDARD = 0,
+
/* The low bound was not given and the high bound is inclusive. */
- LOW_BOUND_DEFAULT,
+ RANGE_LOW_BOUND_DEFAULT = 1 << 0,
+
/* The high bound was not given and the low bound in inclusive. */
- HIGH_BOUND_DEFAULT,
- /* Both bounds were given and both are inclusive. */
- NONE_BOUND_DEFAULT,
- /* The low bound was not given and the high bound is exclusive. */
- NONE_BOUND_DEFAULT_EXCLUSIVE,
- /* Both bounds were given. The low bound is inclusive and the high
- bound is exclusive. */
- LOW_BOUND_DEFAULT_EXCLUSIVE,
+ RANGE_HIGH_BOUND_DEFAULT = 1 << 1,
+
+ /* The high bound of this range is exclusive. */
+ RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
};
+DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
+
#endif /* !defined (EXPRESSION_H) */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 0fa18dd1860..79b6462b5aa 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -287,26 +287,30 @@ 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, RANGE_STANDARD);
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,
+ RANGE_HIGH_BOUND_DEFAULT);
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,
+ RANGE_LOW_BOUND_DEFAULT);
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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HIGH_BOUND_DEFAULT));
write_exp_elt_opcode (pstate, OP_RANGE); }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 6210522c182..9de71084b11 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -131,12 +131,12 @@ value_f90_subarray (struct value *array,
*pos += 3;
- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ if (range_type & RANGE_LOW_BOUND_DEFAULT)
low_bound = range->bounds ()->low.const_val ();
else
low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ if (range_type & RANGE_HIGH_BOUND_DEFAULT)
high_bound = range->bounds ()->high.const_val ();
else
high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
diff --git a/gdb/parse.c b/gdb/parse.c
index 435f87a06e4..e7509168c77 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -921,21 +921,13 @@ operator_length_standard (const struct expression *expr, int endpos,
range_type = (enum range_type)
longest_to_int (expr->elts[endpos - 2].longconst);
- switch (range_type)
- {
- case LOW_BOUND_DEFAULT:
- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- case HIGH_BOUND_DEFAULT:
- args = 1;
- break;
- case BOTH_BOUND_DEFAULT:
- args = 0;
- break;
- case NONE_BOUND_DEFAULT:
- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- args = 2;
- break;
- }
+ /* Assume the range has 2 arguments (low bound and high bound), then
+ reduce the argument count if any bounds are set to default. */
+ args = 2;
+ if (range_type & RANGE_LOW_BOUND_DEFAULT)
+ --args;
+ if (range_type & RANGE_HIGH_BOUND_DEFAULT)
+ --args;
break;
diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
index 4e7878f67e1..0c29824c61b 100644
--- a/gdb/rust-exp.y
+++ b/gdb/rust-exp.y
@@ -2492,24 +2492,29 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
case OP_RANGE:
{
- enum range_type kind = BOTH_BOUND_DEFAULT;
+ enum range_type kind = (RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_LOW_BOUND_DEFAULT);
if (operation->left.op != NULL)
{
convert_ast_to_expression (operation->left.op, top);
- kind = HIGH_BOUND_DEFAULT;
+ kind = RANGE_HIGH_BOUND_DEFAULT;
}
if (operation->right.op != NULL)
{
convert_ast_to_expression (operation->right.op, top);
- if (kind == BOTH_BOUND_DEFAULT)
- kind = (operation->inclusive
- ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE);
+ if (kind == (RANGE_HIGH_BOUND_DEFAULT | RANGE_LOW_BOUND_DEFAULT))
+ {
+ kind = RANGE_LOW_BOUND_DEFAULT;
+ if (!operation->inclusive)
+ kind |= RANGE_HIGH_BOUND_EXCLUSIVE;
+ }
else
{
- gdb_assert (kind == HIGH_BOUND_DEFAULT);
- kind = (operation->inclusive
- ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE);
+ gdb_assert (kind == RANGE_HIGH_BOUND_DEFAULT);
+ kind = RANGE_STANDARD;
+ if (!operation->inclusive)
+ kind |= RANGE_HIGH_BOUND_EXCLUSIVE;
}
}
else
diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
index ddd4b57d294..491297d27a6 100644
--- a/gdb/rust-lang.c
+++ b/gdb/rust-lang.c
@@ -1082,13 +1082,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
*pos += 3;
- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT
- || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(kind & RANGE_LOW_BOUND_DEFAULT))
low = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE
- || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(kind & RANGE_HIGH_BOUND_DEFAULT))
high = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT);
+ bool inclusive = !(kind & RANGE_HIGH_BOUND_EXCLUSIVE);
if (noside == EVAL_SKIP)
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
@@ -1171,13 +1169,13 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
static void
rust_compute_range (struct type *type, struct value *range,
LONGEST *low, LONGEST *high,
- enum range_type *kind)
+ range_types *kind)
{
int i;
*low = 0;
*high = 0;
- *kind = BOTH_BOUND_DEFAULT;
+ *kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
if (type->num_fields () == 0)
return;
@@ -1185,15 +1183,15 @@ 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 = RANGE_HIGH_BOUND_DEFAULT;
*low = value_as_long (value_field (range, 0));
++i;
}
if (type->num_fields () > i
&& strcmp (TYPE_FIELD_NAME (type, i), "end") == 0)
{
- *kind = (*kind == BOTH_BOUND_DEFAULT
- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
+ *kind = (*kind == (RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT)
+ ? RANGE_LOW_BOUND_DEFAULT : RANGE_STANDARD);
*high = value_as_long (value_field (range, i));
if (rust_inclusive_range_type_p (type))
@@ -1211,7 +1209,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;
+ range_types kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
LONGEST high = 0;
int want_slice = 0;
@@ -1308,8 +1306,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
else
error (_("Cannot subscript non-array type"));
- if (want_slice
- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT))
+ if (want_slice && (kind & RANGE_LOW_BOUND_DEFAULT))
low = low_bound;
if (low < 0)
error (_("Index less than zero"));
@@ -1327,7 +1324,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 & RANGE_HIGH_BOUND_DEFAULT)
high = high_bound;
if (high < 0)
error (_("High index less than zero"));
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCH 7/8] gdb/testsuite: Add missing expected results
2020-08-13 12:58 [PATCH 0/8] Fortran Array Slicing and Striding Support Andrew Burgess
` (5 preceding siblings ...)
2020-08-13 12:58 ` [PATCH 6/8] gdb: Convert enum range_type to a bit field enum Andrew Burgess
@ 2020-08-13 12:58 ` Andrew Burgess
2020-08-13 12:58 ` [PATCH 8/8] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
8 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-13 12:58 UTC (permalink / raw)
To: gdb-patches
The tests in this script are driven from two lists of expected
results, one of the lists is missing some data so DejaGNU ends up
matching against the empty string (which passes).
This commit adds the missing expected results into the script.
I could rewrite this test to make things more robust, however, a later
commit is going to completely rewrite this test script, I'm simply
adding this here so that _before_ the rewrite the test is complete,
then if anyone ever digs into the history of this test script things
will make sense (I hope).
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices.exp: Add missing message data.
---
gdb/testsuite/ChangeLog | 4 ++++
gdb/testsuite/gdb.fortran/array-slices.exp | 5 ++++-
2 files changed, 8 insertions(+), 1 deletion(-)
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index 8587c51e990..31f95a3668d 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -53,7 +53,10 @@ set message_strings \
" = 'array \\(1:5,1:5\\)'" \
" = 'array \\(1:10:2,1:10:2\\)'" \
" = 'array \\(1:10:3,1:10:2\\)'" \
- " = 'array \\(1:10:5,1:10:3\\)'" ]
+ " = 'array \\(1:10:5,1:10:3\\)'" \
+ " = 'other'" \
+ " = 'other \\(-5:0, -2:0\\)'" \
+ " = 'other \\(-5:4:2, -2:7:3\\)'" ]
set i 0
foreach result $array_contents msg $message_strings {
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCH 8/8] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-08-13 12:58 [PATCH 0/8] Fortran Array Slicing and Striding Support Andrew Burgess
` (6 preceding siblings ...)
2020-08-13 12:58 ` [PATCH 7/8] gdb/testsuite: Add missing expected results Andrew Burgess
@ 2020-08-13 12:58 ` Andrew Burgess
2020-08-13 13:31 ` Eli Zaretskii
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
8 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-08-13 12:58 UTC (permalink / raw)
To: gdb-patches
This commit brings array slice support to GDB.
WARNING: This patch contains a rather big hack which is limited to
Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More
details on this below.
This patch rewrites two areas of GDB's Fortran support, the code to
extract an array slice, and the code to print an array.
After this commit a user can, from the GDB prompt, ask for a slice of
a Fortran array and should get the correct result back. Slices can
(optionally) have the lower bound, upper bound, and a stride
specified. Slices can also have a negative stride.
Fortran has the concept of repacking array slices. Within a compiled
Fortran program if a user passes a non-contiguous array slice to a
function then the compiler may have to repack the slice, this involves
copying the elements of the slice to a new area of memory before the
call, and copying the elements back to the original array after the
call. Whether repacking occurs will depend on which version of
Fortran is being used, and what type of function is being called.
This commit adds support for both packed, and unpacked array slicing,
with the default being unpacked.
With an unpacked array slice, when the user asks for a slice of an
array GDB creates a new type that accurately describes where the
elements of the slice can be found within the original array, a
value of this type is then returned to the user. The address of an
element within the slice will be equal to the address of an element
within the original array.
A user can choose to selected packed array slices instead using:
(gdb) set fortran repack-array-slices on|off
(gdb) show fortran repack-array-slices
With packed array slices GDB creates a new type that reflects how the
elements of the slice would look if they were laid out in contiguous
memory, allocates a value of this type, and then fetches the elements
from the original array and places then into the contents buffer of
the new value.
One benefit of using packed slices over unapacked slices is the memory
usage, taking a small slice of N elements from a large array will
require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked
array will also include all of the "padding" between the
non-contiguous elements. There are new tests added that highlight
this difference.
There is also a new debugging flag added with this commit that
introduces these commands:
(gdb) set debug fortran-array-slicing on|off
(gdb) show debug fortran-array-slicing
This prints information about how the array slices are being built.
As both the repacking, and the array printing requires GDB to walk
through a multi-dimensional Fortran array visiting each element, this
commit adds the file f-array-walk.h, which introduces some
infrastructure to support this process. This means the array printing
code in f-valprint.c is significantly reduced.
The only slight issue with this commit is the "rather big hack" that I
mentioned above. This hack allows us to handle one specific case,
array slices with negative strides. This is something that I don't
believe the current GDB value contents model will allow us to
"correctly" handle, and rather than rewrite the value contents code
right now, I'm hoping to slip this hack in as a work around.
The problem is that as I see it the current value contents model
assumes that an object base address will be the lowest address within
that object, and that the contents of the object start at this base
address and occupy the TYPE_LENGTH bytes after that.
We do have the embedded_offset, which is used for C++ sub-classes,
such that an object can start at some offset from the content buffer,
however, the assumption that the object then occupies the next
TYPE_LENGTH bytes is still true within GDB.
The problem is that Fortran arrays with a negative stride don't follow
this pattern. In this case the base address of the object points to
the element with the highest address, the contents of the array then
start at some offset _before_ the base address, and proceed for one
element _past_ the base address.
This is further complicated because arrays with negative strides like
this are always dynamic types, the program being debugged has passed a
slice with a negative stride to a function, and it is only when we
actually try to look at the slice within the function that the dynamic
type is resolved, and the negative type is seen. When dealing with
dynamic types like this the address is actually stored on the _type_,
not the value, this dynamic address then overrides the value's address
in the value_address function.
I currently don't see any way to handle this address configuration
with GDB's current dynamic type and value system, which is why I've
added this hack:
When we resolve a dynamic Fortran array type, if the stride is
negative, then we adjust the base address to point to the lowest
address required by the array. The printing and slicing code is aware
of this adjustment and will correctly slice and print Fortran arrays.
Where this hack will show through to the user is if they ask for the
address of an array in their program with a negative array stride, the
address they get from GDB will not match the address that would be
computed within the Fortran program.
gdb/ChangeLog:
* Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
* NEWS: Mention new options.
* expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE.
* expression.h (enum range_type): Add RANGE_HAS_STRIDE.
* f-array-walker.h: New file.
* f-exp.y (arglist): Allow for a series of subranges.
(subrange): Add cases for subranges with strides.
* f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
(repack_array_slices): New static global.
(show_repack_array_slices): New function.
(fortran_array_slicing_debug): New static global.
(show_fortran_array_slicing_debug): New function.
(value_f90_subarray): Delete.
(skip_undetermined_arglist): Delete.
(class fortran_array_repacker_base_impl): New class.
(class fortran_lazy_array_repacker_impl): New class.
(class fortran_array_repacker_impl): New class.
(fortran_value_subarray): Complete rewrite.
(set_fortran_list): New static global.
(show_fortran_list): Likewise.
(_initialize_f_language): Register new commands.
(fortran_adjust_dynamic_array_base_address_hack): New function.
* f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
Declare.
* f-valprint.c: Include 'f-array-walker.h'.
(class fortran_array_printer_impl): New class.
(f77_print_array_1): Delete.
(f77_print_array): Delete.
(fortran_print_array): New.
(f_value_print_inner): Update to call fortran_print_array.
* gdbtypes.c: Include 'f-lang.h'.
(resolve_dynamic_type_internal): Call
fortran_adjust_dynamic_array_base_address_hack.
* parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE.
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices-bad.exp: New file.
* gdb.fortran/array-slices-bad.f90: New file.
* gdb.fortran/array-slices-sub-slices.exp: New file.
* gdb.fortran/array-slices-sub-slices.f90: New file.
* gdb.fortran/array-slices.exp: Rewrite tests.
* gdb.fortran/array-slices.f90: Rewrite tests.
* gdb.fortran/vla-sizeof.exp: Correct expected results.
gdb/doc/ChangeLog:
* gdb.texinfo (Debugging Output): Document 'set/show debug
fotran-array-slicing'.
(Special Fortran Commands): Document 'set/show fortran
repack-array-slices'.
---
gdb/ChangeLog | 37 +
gdb/Makefile.in | 1 +
gdb/NEWS | 13 +
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 30 +
gdb/expprint.c | 4 +
gdb/expression.h | 3 +
gdb/f-array-walker.h | 255 +++++++
gdb/f-exp.y | 38 +
gdb/f-lang.c | 704 ++++++++++++++++--
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 190 ++---
gdb/gdbtypes.c | 12 +-
gdb/parse.c | 2 +
gdb/testsuite/ChangeLog | 10 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 ++
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 267 ++++++-
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
22 files changed, 2048 insertions(+), 230 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
diff --git a/gdb/Makefile.in b/gdb/Makefile.in
index 67dc9daf16a..089a5087635 100644
--- a/gdb/Makefile.in
+++ b/gdb/Makefile.in
@@ -1263,6 +1263,7 @@ HFILES_NO_SRCDIR = \
expression.h \
extension.h \
extension-priv.h \
+ f-array-walker.h \
f-lang.h \
fbsd-nat.h \
fbsd-tdep.h \
diff --git a/gdb/NEWS b/gdb/NEWS
index 3f57eb93d1d..2239b488c37 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -104,6 +104,19 @@ maintenance print core-file-backed-mappings
Prints file-backed mappings loaded from a core file's note section.
Output is expected to be similar to that of "info proc mappings".
+set debug fortran-array-slicing on|off
+show debug fortran-array-slicing
+ Print debugging when taking slices of Fortran arrays.
+
+set fortran repack-array-slices on|off
+show fortran repack-array-slices
+ When taking slices from Fortran arrays and strings, if the slice is
+ non-contiguous within the original value then, when this option is
+ on, the new value will be repacked into a single contiguous value.
+ When this option is off then the value returned will consist of a
+ descriptor that describes the slice within the memory of the
+ original parent value.
+
* Changed commands
alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...]
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index 77013648b2f..f9f932cefac 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -16919,6 +16919,29 @@
block whose name is @var{common-name}. With no argument, the names of
all @code{COMMON} blocks visible at the current program location are
printed.
+@cindex arrays slices (Fortran)
+@kindex set fortran repack-array-slices
+@kindex show fortran repack-array-slices
+@item set fortran repack-array-slices [on|off]
+@item show fortran repack-array-slices
+When taking a slice from an array a Fortran compiler can choose to
+either produce an array descriptor that describes the slice in place,
+or it may repack the slice, copying the elements of the slice into a
+new region of memory.
+
+When this setting is on then @value{GDBN} will also repack array
+slices in some situations. When this setting is off then @value{GDBN}
+will create array descriptors for slices that reference the original
+data in place.
+
+@value{GDBN} will never repack an array slice if the data for the
+slice is contiguous within the original array.
+
+@value{GDBN} will always repack string slices if the data for the
+slice is non-contiguous within the original string as @value{GDBN}
+does not support printing non-contiguous strings.
+
+The default for this setting is @code{off}.
@end table
@node Pascal
@@ -26486,6 +26509,13 @@
Turns on or off debugging messages from the FreeBSD native target.
@item show debug fbsd-nat
Show the current state of FreeBSD native target debugging messages.
+@item set debug fortran-array-slicing
+@cindex fortran array slicing debugging info
+Turns on or off display of @value{GDBN} Fortran array slicing
+debugging info. The default is off.
+@item show debug fortran-array-slicing
+Displays the current state of displaying @value{GDBN} Fortran array
+slicing debugging info.
@item set debug frame
@cindex frame debugging info
Turns on or off display of @value{GDBN} frame debugging info. The
diff --git a/gdb/expprint.c b/gdb/expprint.c
index 1d8aedb1fbd..5162eb33996 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -1118,12 +1118,16 @@ dump_subexp_body_standard (struct expression *exp,
fputs_filtered ("..", stream);
if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
fputs_filtered ("EXP", stream);
+ if (range_type & RANGE_HAS_STRIDE)
+ fputs_filtered (":EXP", stream);
fputs_filtered ("'", stream);
if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
+ if (range_type & RANGE_HAS_STRIDE)
+ elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 9dc598984e0..4d712a7735c 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -199,6 +199,9 @@ enum range_type
/* The high bound of this range is exclusive. */
RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
+
+ /* The range has a stride. */
+ RANGE_HAS_STRIDE = 1 << 3,
};
DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h
new file mode 100644
index 00000000000..395c26e5350
--- /dev/null
+++ b/gdb/f-array-walker.h
@@ -0,0 +1,255 @@
+/* Copyright (C) 2020 Free Software Foundation, Inc.
+
+ This file is part of GDB.
+
+ 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/>. */
+
+/* Support classes to wrap up the process of iterating over a
+ multi-dimensional Fortran array. */
+
+#ifndef F_ARRAY_WALKER_H
+#define F_ARRAY_WALKER_H
+
+#include "defs.h"
+#include "gdbtypes.h"
+#include "f-lang.h"
+
+/* Class for calculating the byte offset for elements within a single
+ dimension of a Fortran array. */
+class fortran_array_offset_calculator
+{
+public:
+ /* Create a new offset calculator for TYPE, which is either an array or a
+ string. */
+ fortran_array_offset_calculator (struct type *type)
+ {
+ /* Validate the type. */
+ type = check_typedef (type);
+ if (type->code () != TYPE_CODE_ARRAY
+ && (type->code () != TYPE_CODE_STRING))
+ error (_("can only compute offsets for arrays and strings"));
+
+ /* Get the range, and extract the bounds. */
+ struct type *range_type = type->index_type ();
+ if (get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound) < 0)
+ error ("unable to read array bounds");
+
+ /* Figure out the stride for this array. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ m_stride = type->index_type ()->bounds ()->bit_stride ();
+ if (m_stride == 0)
+ m_stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ m_stride /= (unit_size * 8);
+ }
+ };
+
+ /* Get the byte offset for element INDEX within the type we are working
+ on. There is no bounds checking done on INDEX. If the stride is
+ negative then we still assume that the base address (for the array
+ object) points to the element with the lowest memory address, we then
+ calculate an offset assuming that index 0 will be the element at the
+ highest address, index 1 the next highest, and so on. This is not
+ quite how Fortran works in reality; in reality the base address of
+ the object would point at the element with the highest address, and
+ we would index backwards from there in the "normal" way, however,
+ GDB's current value contents model doesn't support having the base
+ address be near to the end of the value contents, so we currently
+ adjust the base address of Fortran arrays with negative strides so
+ their base address points at the lowest memory address. This code
+ here is part of working around this weirdness. */
+ LONGEST index_offset (LONGEST index)
+ {
+ LONGEST offset;
+ if (m_stride < 0)
+ offset = std::abs (m_stride) * (m_upperbound - index);
+ else
+ offset = std::abs (m_stride) * (index - m_lowerbound);
+ return offset;
+ }
+
+private:
+
+ /* The stride for the type we are working with. */
+ LONGEST m_stride;
+
+ /* The upper bound for the type we are working with. */
+ LONGEST m_upperbound;
+
+ /* The lower bound for the type we are working with. */
+ LONGEST m_lowerbound;
+};
+
+/* A base class used by fortran_array_walker. */
+class fortran_array_walker_base_impl
+{
+public:
+ /* Constructor. */
+ explicit fortran_array_walker_base_impl ()
+ { /* Nothing. */ }
+
+ /* Called when iterating between the lower and upper bounds of each
+ dimension of the array. Return true if GDB should continue iterating,
+ otherwise, return false.
+
+ SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
+ be taken into consideration when deciding what to return. If
+ SHOULD_CONTINUE is false then this function must also return false,
+ the function is still called though in case extra work needs to be
+ done as part of the stopping process. */
+ bool continue_walking (bool should_continue)
+ { return should_continue; }
+
+ /* Called when GDB starts iterating over a dimension of the array. This
+ function will be called once for each of the bounds in this dimension.
+ DIM is the current dimension number, NDIM is the total number of
+ dimensions, and FIRST_P is true for the first bound of this
+ dimension, and false in all other cases. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ { /* Nothing. */ }
+
+ /* Called when GDB finishes iterating over a dimension of the array.
+ This function will be called once for each of the bounds in this
+ dimension. DIM is the current dimension number, NDIM is the total
+ number of dimensions, and LAST_P is true for the last bound of this
+ dimension, and false in all other cases. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ { /* Nothing. */ }
+
+ /* Called when processing the inner most dimension of the array, for
+ every element in the array. PARENT_VALUE is the value from which
+ elements are being extracted, ELT_TYPE is the type of the element
+ being extracted, and ELT_OFF is the offset of the element from the
+ start of PARENT_VALUE. */
+ void process_element (struct value *parent_value, struct type *elt_type,
+ LONGEST elt_off)
+ { /* Nothing. */ }
+};
+
+/* A class to wrap up the process of iterating over a multi-dimensional
+ Fortran array. IMPL is used to specialise what happens as we walk over
+ the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
+ methods than can be used to customise the array walk. */
+template<typename Impl>
+class fortran_array_walker
+{
+ /* Ensure that Impl is derived from the required base class. This just
+ ensures that all of the required API methods are available and have a
+ sensible default implementation. */
+ gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
+
+public:
+ /* Create a new array walker. TYPE is the type of the array being walked
+ over, and ADDRESS is the base address for the object of TYPE in
+ memory. All other arguments are forwarded to the constructor of the
+ template parameter class IMPL. */
+ template <typename ...Args>
+ fortran_array_walker (struct type *type, CORE_ADDR address,
+ Args... args)
+ : m_type (type),
+ m_address (address),
+ m_impl (type, address, args...)
+ {
+ m_ndimensions = calc_f77_array_dims (m_type);
+ }
+
+ /* Walk the array. */
+ void
+ walk ()
+ {
+ walk_1 (1, m_type, 0);
+ }
+
+private:
+ /* The core of the array walking algorithm. NSS is the current
+ dimension number being processed, TYPE is the type of this dimension,
+ and OFFSET is the offset (in bytes) for the start of this dimension. */
+ void
+ walk_1 (int nss, struct type *type, int offset)
+ {
+ /* Extract the range, and get lower and upper bounds. */
+ struct type *range_type = check_typedef (type)->index_type ();
+ LONGEST lowerbound, upperbound;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* CALC is used to calculate the offsets for each element in this
+ dimension. */
+ fortran_array_offset_calculator calc (type);
+
+ if (nss != m_ndimensions)
+ {
+ /* For dimensions other than the inner most, walk each element and
+ recurse while peeling off one more dimension of the array. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ m_impl.start_dimension (nss, m_ndimensions, (i == lowerbound));
+
+ /* Use the index and the stride to work out a new offset. */
+ LONGEST new_offset = offset + calc.index_offset (i);
+
+ /* Now print the lower dimension. */
+ struct type *subarray_type
+ = TYPE_TARGET_TYPE (check_typedef (type));
+ walk_1 (nss + 1, subarray_type, new_offset);
+
+ m_impl.finish_dimension (nss, m_ndimensions, (i == upperbound));
+ }
+ }
+ else
+ {
+ /* For the inner most dimension of the array, process each element
+ within this dimension. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ m_impl.start_dimension (nss, m_ndimensions, (i == lowerbound));
+
+ LONGEST elt_off = offset + calc.index_offset (i);
+
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ if (is_dynamic_type (elt_type))
+ {
+ CORE_ADDR e_address = m_address + elt_off;
+ elt_type = resolve_dynamic_type (elt_type, {}, e_address);
+ }
+
+ m_impl.process_element (elt_type, elt_off);
+
+ m_impl.finish_dimension (nss, m_ndimensions, (i == upperbound));
+ }
+ }
+ }
+
+ /* The array type being processed. */
+ struct type *m_type;
+
+ /* The address in target memory for the object of M_TYPE being
+ processed. This is required in order to resolve dynamic types. */
+ CORE_ADDR m_address;
+
+ /* An instance of the template specialisation class. */
+ Impl m_impl;
+
+ /* The total number of dimensions in M_TYPE. */
+ int m_ndimensions;
+};
+
+#endif /* F_ARRAY_WALKER_H */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 79b6462b5aa..c7d20547feb 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -284,6 +284,10 @@ arglist : arglist ',' exp %prec ABOVE_COMMA
{ pstate->arglist_len++; }
;
+arglist : arglist ',' subrange %prec ABOVE_COMMA
+ { pstate->arglist_len++; }
+ ;
+
/* There are four sorts of subrange types in F90. */
subrange: exp ':' exp %prec ABOVE_COMMA
@@ -314,6 +318,40 @@ subrange: ':' %prec ABOVE_COMMA
write_exp_elt_opcode (pstate, OP_RANGE); }
;
+/* And each of the four subrange types can also have a stride. */
+subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (pstate, OP_RANGE);
+ write_exp_elt_longcst (pstate,
+ (RANGE_STANDARD
+ | RANGE_HAS_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,
+ (RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_HAS_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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HAS_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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_HAS_STRIDE));
+ write_exp_elt_opcode (pstate, OP_RANGE); }
+ ;
+
complexnum: exp ',' exp
{ }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 9de71084b11..3c7fabe0498 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -36,9 +36,36 @@
#include "c-lang.h"
#include "target-float.h"
#include "gdbarch.h"
+#include "gdbcmd.h"
+#include "f-array-walker.h"
#include <math.h>
+/* Whether GDB should repack array slices created by the user. */
+static bool repack_array_slices = false;
+
+/* Implement 'show fortran repack-array-slices'. */
+static void
+show_repack_array_slices (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c, const char *value)
+{
+ fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"),
+ value);
+}
+
+/* Debugging of Fortran's array slicing. */
+static bool fortran_array_slicing_debug = false;
+
+/* Implement 'show debug fortran-array-slicing'. */
+static void
+show_fortran_array_slicing_debug (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c,
+ const char *value)
+{
+ fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"),
+ value);
+}
+
/* Local functions */
/* Return the encoding that should be used for the character type
@@ -114,49 +141,6 @@ enum f_primitive_types {
nr_f_primitive_types
};
-/* Called from fortran_value_subarray to take a slice of an array or a
- string. ARRAY is the array or string to be accessed. EXP, POS, and
- NOSIDE are as for evaluate_subexp_standard. Return a value that is a
- slice of the array. */
-
-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 (value_type (array)->index_type ());
- enum range_type range_type
- = (enum range_type) longest_to_int (exp->elts[pc].longconst);
-
- *pos += 3;
-
- if (range_type & RANGE_LOW_BOUND_DEFAULT)
- low_bound = range->bounds ()->low.const_val ();
- else
- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
-
- if (range_type & RANGE_HIGH_BOUND_DEFAULT)
- high_bound = range->bounds ()->high.const_val ();
- else
- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
-
- return value_slice (array, low_bound, high_bound - low_bound + 1);
-}
-
-/* Helper for skipping all the arguments in an undetermined argument list.
- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
- case of evaluate_subexp_standard as multiple, but not all, code paths
- require a generic skip. */
-
-static void
-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
- enum noside noside)
-{
- for (int i = 0; i < nargs; ++i)
- evaluate_subexp (NULL_TYPE, exp, pos, noside);
-}
-
/* Return the number of dimensions for a Fortran array or string. */
int
@@ -181,6 +165,145 @@ calc_f77_array_dims (struct type *array_type)
return ndimen;
}
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This is a base class for two alternative repacking mechanisms,
+ one for when repacking from a lazy value, and one for repacking from a
+ non-lazy (already loaded) value. */
+class fortran_array_repacker_base_impl
+ : public fortran_array_walker_base_impl
+{
+public:
+ /* Constructor, DEST is the value we are repacking into. */
+ fortran_array_repacker_base_impl (struct value *dest)
+ : m_dest (dest),
+ m_dest_offset (0)
+ { /* Nothing. */ }
+
+ /* When we start processing the inner most dimension, this is where we
+ will be creating values for each element as we load them and then copy
+ them into the M_DEST value. Set a value mark so we can free these
+ temporary values. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ {
+ if (dim == ndim && first_p)
+ {
+ gdb_assert (m_mark == nullptr);
+ m_mark = value_mark ();
+ }
+ }
+
+ /* When we finish processing the inner most dimension free all temporary
+ value that were created. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ {
+ if (dim == ndim && last_p)
+ {
+ gdb_assert (m_mark != nullptr);
+ value_free_to_mark (m_mark);
+ m_mark = nullptr;
+ }
+ }
+
+protected:
+ /* Copy the contents of array element ELT into M_DEST at the next
+ available offset. */
+ void copy_element_to_dest (struct value *elt)
+ {
+ value_contents_copy (m_dest, m_dest_offset, elt, 0,
+ TYPE_LENGTH (value_type (elt)));
+ m_dest_offset += TYPE_LENGTH (value_type (elt));
+ }
+
+ /* The value being written to. */
+ struct value *m_dest;
+
+ /* The byte offset in M_DEST at which the next element should be
+ written. */
+ LONGEST m_dest_offset;
+
+ /* Set with a call to VALUE_MARK, and then reset after calling
+ VALUE_FREE_TO_MARK. */
+ struct value *m_mark = nullptr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ lazy array value, as such it does not require the parent array value to
+ be loaded into GDB's memory; the parent value could be huge, while the
+ slice could be tiny. */
+class fortran_lazy_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type of the slice being loaded from the
+ parent value, so this type will correctly reflect the strides required
+ to find all of the elements from the parent value. ADDRESS is the
+ address in target memory of value matching TYPE, and DEST is the value
+ we are repacking into. */
+ explicit fortran_lazy_array_repacker_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_addr (address)
+ { /* Nothing. */ }
+
+ /* Create a lazy value in target memory representing a single element,
+ then load the element into GDB's memory and copy the contents into the
+ destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off));
+ }
+
+private:
+ /* The address in target memory where the parent value starts. */
+ CORE_ADDR m_addr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ previously loaded (non-lazy) array value, as such it fetches the
+ element values from the contents of the parent value. */
+class fortran_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type for the array slice within the parent
+ value, as such it has stride values as required to find the elements
+ within the original parent value. ADDRESS is the address in target
+ memory of the value matching TYPE. BASE_OFFSET is the offset from
+ the start of VAL's content buffer to the start of the object of TYPE,
+ VAL is the parent object from which we are loading the value, and
+ DEST is the value into which we are repacking. */
+ explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address,
+ LONGEST base_offset,
+ struct value *val, struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_base_offset (base_offset),
+ m_val (val)
+ {
+ gdb_assert (!value_lazy (val));
+ }
+
+ /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF)
+ from the content buffer of M_VAL then copy this extracted value into
+ the repacked destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ struct value *elt
+ = value_from_component (m_val, elt_type, (elt_off + m_base_offset));
+ copy_element_to_dest (elt);
+ }
+
+private:
+ /* The offset into the content buffer of M_VAL to the start of the slice
+ being extracted. */
+ LONGEST m_base_offset;
+
+ /* The parent value from which we are extracting a slice. */
+ struct value *m_val;
+};
+
/* Called from evaluate_subexp_standard to perform array indexing, and
sub-range extraction, for Fortran. As well as arrays this function
also handles strings as they can be treated like arrays of characters.
@@ -192,51 +315,394 @@ static struct value *
fortran_value_subarray (struct value *array, struct expression *exp,
int *pos, int nargs, enum noside noside)
{
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (array, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
+ type *original_array_type = check_typedef (value_type (array));
+ bool is_string_p = original_array_type->code () == TYPE_CODE_STRING;
+
+ /* Perform checks for ARRAY not being available. The somewhat overly
+ complex logic here is just to keep backward compatibility with the
+ errors that we used to get before FORTRAN_VALUE_SUBARRAY was
+ rewritten. Maybe a future task would streamline the error messages we
+ get here, and update all the expected test results. */
+ if (exp->elts[*pos].opcode != OP_RANGE)
{
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return array;
+ if (type_not_associated (original_array_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (original_array_type))
+ error (_("no such vector element (vector not allocated)"));
+ }
+ else
+ {
+ if (type_not_associated (original_array_type))
+ error (_("array not associated"));
+ else if (type_not_allocated (original_array_type))
+ error (_("array not allocated"));
}
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1;
- struct type *type = check_typedef (value_type (array));
+ /* First check that the number of dimensions in the type we are slicing
+ matches the number of arguments we were passed. */
+ int ndimensions = calc_f77_array_dims (original_array_type);
+ if (nargs != ndimensions)
+ error (_("Wrong number of subscripts"));
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+ /* This will be initialised below with the type of the elements held in
+ ARRAY. */
+ struct type *inner_element_type;
+
+ /* Extract the types of each array dimension from the original array
+ type. We need these available so we can fill in the default upper and
+ lower bounds if the user requested slice doesn't provide that
+ information. Additionally unpacking the dimensions like this gives us
+ the inner element type. */
+ std::vector<struct type *> dim_types;
+ {
+ dim_types.reserve (ndimensions);
+ struct type *type = original_array_type;
+ for (int i = 0; i < ndimensions; ++i)
+ {
+ dim_types.push_back (type);
+ type = TYPE_TARGET_TYPE (type);
+ }
+ /* TYPE is now the inner element type of the array, we start the new
+ array slice off as this type, then as we process the requested slice
+ (from the user) we wrap new types around this to build up the final
+ slice type. */
+ inner_element_type = type;
+ }
- ndimensions = calc_f77_array_dims (type);
+ /* As we analyse the new slice type we need to understand if the data
+ being referenced is contiguous. Do decide this we must track the size
+ of an element at each dimension of the new slice array. Initially the
+ elements of the inner most dimension of the array are the same inner
+ most elements as the original ARRAY. */
+ LONGEST slice_element_size = TYPE_LENGTH (inner_element_type);
+
+ /* Start off assuming all data is contiguous, this will be set to false
+ if access to any dimension results in non-contiguous data. */
+ bool is_all_contiguous = true;
+
+ /* The TOTAL_OFFSET is the distance in bytes from the start of the
+ original ARRAY to the start of the new slice. This is calculated as
+ we process the information from the user. */
+ LONGEST total_offset = 0;
+
+ /* A structure representing information about each dimension of the
+ resulting slice. */
+ struct slice_dim
+ {
+ /* Constructor. */
+ slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx)
+ : low (l),
+ high (h),
+ stride (s),
+ index (idx)
+ { /* Nothing. */ }
+
+ /* The low bound for this dimension of the slice. */
+ LONGEST low;
+
+ /* The high bound for this dimension of the slice. */
+ LONGEST high;
+
+ /* The byte stride for this dimension of the slice. */
+ LONGEST stride;
+
+ struct type *index;
+ };
+
+ /* The dimensions of the resulting slice. */
+ std::vector<slice_dim> slice_dims;
+
+ /* Process the incoming arguments. These arguments are in the reverse
+ order to the array dimensions, that is the first argument refers to
+ the last array dimension. */
+ if (fortran_array_slicing_debug)
+ debug_printf ("Processing array access:\n");
+ for (int i = 0; i < nargs; ++i)
+ {
+ /* For each dimension of the array the user will have either provided
+ a ranged access with optional lower bound, upper bound, and
+ stride, or the user will have supplied a single index. */
+ struct type *dim_type = dim_types[ndimensions - (i + 1)];
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ {
+ int pc = (*pos) + 1;
+ enum range_type range_type = (enum range_type) exp->elts[pc].longconst;
+ *pos += 3;
+
+ LONGEST low, high, stride;
+ low = high = stride = 0;
+
+ if ((range_type & RANGE_LOW_BOUND_DEFAULT) == 0)
+ low = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ else
+ low = f77_get_lowerbound (dim_type);
+ if ((range_type & RANGE_HIGH_BOUND_DEFAULT) == 0)
+ high = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ else
+ high = f77_get_upperbound (dim_type);
+ if ((range_type & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
+ stride = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ else
+ stride = 1;
+
+ if (stride == 0)
+ error (_("stride must not be 0"));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride ();
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type) * 8;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Range access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Bit stride: %ld\n", sd);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd / 8);
+ debug_printf ("| | |-> Type size: %ld\n",
+ TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| |-> Accessing:\n");
+ debug_printf ("| | |-> Low bound: %ld\n",
+ low);
+ debug_printf ("| | |-> High bound: %ld\n",
+ high);
+ debug_printf ("| | '-> Element stride: %ld\n",
+ stride);
+ }
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
+ /* Check the user hasn't asked for something invalid. */
+ if (high > ub || low < lb)
+ error (_("array subscript out of bounds"));
+
+ /* Calculate what this dimension of the new slice array will look
+ like. OFFSET is the byte offset from the start of the
+ previous (more outer) dimension to the start of this
+ dimension. E_COUNT is the number of elements in this
+ dimension. REMAINDER is the number of elements remaining
+ between the last included element and the upper bound. For
+ example an access '1:6:2' will include elements 1, 3, 5 and
+ have a remainder of 1 (element #6). */
+ LONGEST lowest = std::min (low, high);
+ LONGEST offset = (sd / 8) * (lowest - lb);
+ LONGEST e_count = std::abs (high - low) + 1;
+ e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride);
+ LONGEST new_low = 1;
+ LONGEST new_high = new_low + e_count - 1;
+ LONGEST new_stride = (sd * stride) / 8;
+ LONGEST last_elem = low + ((e_count - 1) * stride);
+ LONGEST remainder = high - last_elem;
+ if (low > high)
+ {
+ offset += std::abs (remainder) * TYPE_LENGTH (target_type);
+ if (stride > 0)
+ error (_("incorrect stride and boundary combination"));
+ }
+ else if (stride < 0)
+ error (_("incorrect stride and boundary combination"));
+
+ /* Is the data within this dimension contiguous? It is if the
+ newly computed stride is the same size as a single element of
+ this dimension. */
+ bool is_dim_contiguous = (new_stride == slice_element_size);
+ is_all_contiguous &= is_dim_contiguous;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("| '-> Results:\n");
+ debug_printf ("| |-> Offset = %ld\n", offset);
+ debug_printf ("| |-> Elements = %ld\n", e_count);
+ debug_printf ("| |-> Low bound = %ld\n", new_low);
+ debug_printf ("| |-> High bound = %ld\n", new_high);
+ debug_printf ("| |-> Byte stride = %ld\n", new_stride);
+ debug_printf ("| |-> Last element = %ld\n", last_elem);
+ debug_printf ("| |-> Remainder = %ld\n", remainder);
+ debug_printf ("| '-> Contiguous = %s\n",
+ (is_dim_contiguous ? "Yes" : "No"));
+ }
+
+ /* Figure out how big (in bytes) an element of this dimension of
+ the new array slice will be. */
+ slice_element_size = std::abs (new_stride * e_count);
+
+ slice_dims.emplace_back (new_low, new_high, new_stride,
+ index_type);
+
+ /* Update the total offset. */
+ total_offset += offset;
+ }
+ else
+ {
+ /* There is a single index for this dimension. */
+ LONGEST index
+ = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride () / 8;
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type);
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Index access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd);
+ debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| '-> Accessing:\n");
+ debug_printf ("| '-> Index: %ld\n", index);
+ }
- gdb_assert (nargs > 0);
+ /* If the array has actual content then check the index is in
+ bounds. An array without content (an unbound array) doesn't
+ have a known upper bound, so don't error check in that
+ situation. */
+ if (index < lb
+ || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED
+ && index > ub)
+ || (VALUE_LVAL (array) != lval_memory
+ && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED))
+ {
+ if (type_not_associated (dim_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (dim_type))
+ error (_("no such vector element (vector not allocated)"));
+ else
+ error (_("no such vector element"));
+ }
- /* Now that we know we have a legal array subscript expression let us
- actually find out where this element exists in the array. */
+ /* Calculate using the type stride, not the target type size. */
+ LONGEST offset = sd * (index - lb);
+ total_offset += offset;
+ }
+ }
- /* Take array indices left to right. */
- for (int i = 0; i < nargs; i++)
+ if (noside == EVAL_SKIP)
+ return array;
+
+ /* Build a type that represents the new array slice in the target memory
+ of the original ARRAY, this type makes use of strides to correctly
+ find only those elements that are part of the new slice. */
+ struct type *array_slice_type = inner_element_type;
+ for (const auto &d : slice_dims)
{
- /* Evaluate each subscript; it must be a legal integer in F77. */
- value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (d.stride);
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ array_slice_type
+ = create_array_type (nullptr, array_slice_type, new_range);
+ }
- /* Fill in the subscript array. */
- subscript_array[i] = value_as_long (arg2);
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("'-> Final result:\n");
+ debug_printf (" |-> Type: %s\n",
+ type_to_string (array_slice_type).c_str ());
+ debug_printf (" |-> Total offset: %ld\n", total_offset);
+ debug_printf (" |-> Base address: %s\n",
+ core_addr_to_string (value_address (array)));
+ debug_printf (" '-> Contiguous = %s\n",
+ (is_all_contiguous ? "Yes" : "No"));
}
- /* Internal type of array is arranged right to left. */
- for (int i = nargs; i > 0; i--)
+ /* Should we repack this array slice? */
+ if (!is_all_contiguous && (repack_array_slices || is_string_p))
{
- struct type *array_type = check_typedef (value_type (array));
- LONGEST index = subscript_array[i - 1];
+ /* Build a type for the repacked slice. */
+ struct type *repacked_array_type = inner_element_type;
+ for (const auto &d : slice_dims)
+ {
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (TYPE_LENGTH (repacked_array_type));
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ repacked_array_type
+ = create_array_type (nullptr, repacked_array_type, new_range);
+ }
- array = value_subscripted_rvalue (array, index,
- f77_get_lowerbound (array_type));
+ /* Now copy the elements from the original ARRAY into the packed
+ array value DEST. */
+ struct value *dest = allocate_value (repacked_array_type);
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ {
+ fortran_array_walker<fortran_lazy_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset, dest);
+ p.walk ();
+ }
+ else
+ {
+ fortran_array_walker<fortran_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset,
+ total_offset, array, dest);
+ p.walk ();
+ }
+ array = dest;
+ }
+ else
+ {
+ if (VALUE_LVAL (array) == lval_memory)
+ {
+ /* If the value we're taking a slice from is not yet loaded, or
+ the requested slice is outside the values content range then
+ just create a new lazy value pointing at the memory where the
+ contents we're looking for exist. */
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ array = value_at_lazy (array_slice_type,
+ value_address (array) + total_offset);
+ else
+ array = value_from_contents_and_address (array_slice_type,
+ (value_contents (array)
+ + total_offset),
+ (value_address (array)
+ + total_offset));
+ }
+ else if (!value_lazy (array))
+ {
+ const void *valaddr = value_contents (array) + total_offset;
+ array = allocate_value (array_slice_type);
+ memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type));
+ }
+ else
+ error (_("cannot subscript arrays that are not in memory"));
}
return array;
@@ -1023,11 +1489,50 @@ builtin_f_type (struct gdbarch *gdbarch)
return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
}
+/* Command-list for the "set/show fortran" prefix command. */
+static struct cmd_list_element *set_fortran_list;
+static struct cmd_list_element *show_fortran_list;
+
void _initialize_f_language ();
void
_initialize_f_language ()
{
f_type_data = gdbarch_data_register_post_init (build_fortran_types);
+
+ add_basic_prefix_cmd ("fortran", no_class,
+ _("Prefix command for changing Fortran-specific settings."),
+ &set_fortran_list, "set fortran ", 0, &setlist);
+
+ add_show_prefix_cmd ("fortran", no_class,
+ _("Generic command for showing Fortran-specific settings."),
+ &show_fortran_list, "show fortran ", 0, &showlist);
+
+ add_setshow_boolean_cmd ("repack-array-slices", class_vars,
+ &repack_array_slices, _("\
+Enable or disable repacking of non-contiguous array slices."), _("\
+Show whether non-contiguous array slices are repacked."), _("\
+When the user requests a slice of a Fortran array then we can either return\n\
+a descriptor that describes the array in place (using the original array data\n\
+in its existing location) or the original data can be repacked (copied) to a\n\
+new location.\n\
+\n\
+When the content of the array slice is contiguous within the original array\n\
+then the result will never be repacked, but when the data for the new array\n\
+is non-contiguous within the original array repacking will only be performed\n\
+when this setting is on."),
+ NULL,
+ show_repack_array_slices,
+ &set_fortran_list, &show_fortran_list);
+
+ /* Debug Fortran's array slicing logic. */
+ add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance,
+ &fortran_array_slicing_debug, _("\
+Set debugging of Fortran array slicing."), _("\
+Show debugging of Fortran array slicing."), _("\
+When on, debugging of Fortran array slicing is enabled."),
+ NULL,
+ show_fortran_array_slicing_debug,
+ &setdebuglist, &showdebuglist);
}
/* See f-lang.h. */
@@ -1066,3 +1571,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type)
return value_type (arg);
return type;
}
+
+/* See f-lang.h. */
+
+CORE_ADDR
+fortran_adjust_dynamic_array_base_address_hack (struct type *type,
+ CORE_ADDR address)
+{
+ gdb_assert (type->code () == TYPE_CODE_ARRAY);
+
+ int ndimensions = calc_f77_array_dims (type);
+ LONGEST total_offset = 0;
+
+ /* Walk through each of the dimensions of this array type and figure out
+ if any of the dimensions are "backwards", that is the base address
+ for this dimension points to the element at the highest memory
+ address and the stride is negative. */
+ struct type *tmp_type = type;
+ for (int i = 0 ; i < ndimensions; ++i)
+ {
+ /* Grab the range for this dimension and extract the lower and upper
+ bounds. */
+ tmp_type = check_typedef (tmp_type);
+ struct type *range_type = tmp_type->index_type ();
+ LONGEST lowerbound, upperbound, stride;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* Figure out the stride for this dimension. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
+ stride = tmp_type->index_type ()->bounds ()->bit_stride ();
+ if (stride == 0)
+ stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ stride /= (unit_size * 8);
+ }
+
+ /* If this dimension is "backward" then figure out the offset
+ adjustment required to point to the element at the lowest memory
+ address, and add this to the total offset. */
+ LONGEST offset = 0;
+ if (stride < 0 && lowerbound < upperbound)
+ offset = (upperbound - lowerbound) * stride;
+ total_offset += offset;
+ tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ }
+
+ /* Adjust the address of this object and return it. */
+ address += total_offset;
+ return address;
+}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 4710b14aa62..dee63158ff4 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -64,7 +64,6 @@ extern void f77_get_dynamic_array_length (struct type *);
extern int calc_f77_array_dims (struct type *);
-
/* Fortran (F77) types */
struct builtin_f_type
@@ -122,4 +121,22 @@ extern struct value *fortran_argument_convert (struct value *value,
extern struct type *fortran_preserve_arg_pointer (struct value *arg,
struct type *type);
+/* Fortran arrays can have a negative stride. When this happens it is
+ often the case that the base address for an object is not the lowest
+ address occupied by that object. For example, an array slice (10:1:-1)
+ will be encoded with lower bound 1, upper bound 10, a stride of
+ -ELEMENT_SIZE, and have a base address pointer that points at the
+ element with the highest address in memory.
+
+ This really doesn't play well with our current model of value contents,
+ but could easily require a significant update in order to be supported
+ "correctly".
+
+ For now, we manually force the base address to be the lowest addressed
+ element here. Yes, this will break some things, but it fixes other
+ things. The hope is that it fixes more than it breaks. */
+
+extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
+ (struct type *type, CORE_ADDR address);
+
#endif /* F_LANG_H */
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 3973984542c..e7b1d672d09 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -35,6 +35,7 @@
#include "dictionary.h"
#include "cli/cli-style.h"
#include "gdbarch.h"
+#include "f-array-walker.h"
static void f77_get_dynamic_length_of_aggregate (struct type *);
@@ -100,100 +101,110 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
* TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
}
-/* Actual function which prints out F77 arrays, Valaddr == address in
- the superior. Address == the address in the inferior. */
+/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array
+ walking template. This specialisation prints Fortran arrays. */
-static void
-f77_print_array_1 (int nss, int ndimensions, struct type *type,
- const gdb_byte *valaddr,
- int embedded_offset, CORE_ADDR address,
- struct ui_file *stream, int recurse,
- const struct value *val,
- const struct value_print_options *options,
- int *elts)
+class fortran_array_printer_impl : public fortran_array_walker_base_impl
{
- struct type *range_type = check_typedef (type)->index_type ();
- CORE_ADDR addr = address + embedded_offset;
- LONGEST lowerbound, upperbound;
- LONGEST i;
-
- get_discrete_bounds (range_type, &lowerbound, &upperbound);
-
- if (nss != ndimensions)
- {
- struct gdbarch *gdbarch = get_type_arch (type);
- size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type));
- int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
- size_t byte_stride = type->bit_stride () / (unit_size * 8);
- if (byte_stride == 0)
- byte_stride = dim_size;
- size_t offs = 0;
-
- for (i = lowerbound;
- (i < upperbound + 1 && (*elts) < options->print_max);
- i++)
- {
- struct value *subarray = value_from_contents_and_address
- (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
- + offs, addr + offs);
-
- fprintf_filtered (stream, "(");
- f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
- value_contents_for_printing (subarray),
- value_embedded_offset (subarray),
- value_address (subarray),
- stream, recurse, subarray, options, elts);
- offs += byte_stride;
- fprintf_filtered (stream, ")");
-
- if (i < upperbound)
- fprintf_filtered (stream, " ");
- }
- if (*elts >= options->print_max && i < upperbound)
- fprintf_filtered (stream, "...");
- }
- else
- {
- for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
- i++, (*elts)++)
- {
- struct value *elt = value_subscript ((struct value *)val, i);
-
- common_val_print (elt, stream, recurse, options, current_language);
-
- if (i != upperbound)
- fprintf_filtered (stream, ", ");
-
- if ((*elts == options->print_max - 1)
- && (i != upperbound))
- fprintf_filtered (stream, "...");
- }
- }
-}
+public:
+ /* Constructor. TYPE is the array type being printed, ADDRESS is the
+ address in target memory for the object of TYPE being printed. VAL is
+ the GDB value (of TYPE) being printed. STREAM is where to print to,
+ RECOURSE is passed through (and prevents infinite recursion), and
+ OPTIONS are the printing control options. */
+ explicit fortran_array_printer_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *val,
+ struct ui_file *stream,
+ int recurse,
+ const struct value_print_options *options)
+ : m_elts (0),
+ m_val (val),
+ m_stream (stream),
+ m_recurse (recurse),
+ m_options (options)
+ { /* Nothing. */ }
+
+ /* Called while iterating over the array bounds. When SHOULD_CONTINUE is
+ false then we must return false, as we have reached the end of the
+ array bounds for this dimension. However, we also return false if we
+ have printed too many elements (after printing '...'). In all other
+ cases, return true. */
+ bool continue_walking (bool should_continue)
+ {
+ bool cont = should_continue && (m_elts < m_options->print_max);
+ if (!cont && should_continue)
+ fprintf_filtered (m_stream, "...");
+ return cont;
+ }
+
+ /* Called when we start iterating over a dimension. If it's not the
+ inner most dimension then print an opening '(' character. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ {
+ if (dim != ndim)
+ fprintf_filtered (m_stream, "(");
+ }
+
+ /* Called when we finish processing a batch of items within a dimension
+ of the array. Depending on whether this is the inner most dimension
+ or not we print different things, but this is all about adding
+ separators between elements, and dimensions of the array. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ {
+ if (dim != ndim)
+ {
+ fprintf_filtered (m_stream, ")");
+ if (!last_p)
+ fprintf_filtered (m_stream, " ");
+ }
+ else
+ {
+ if (!last_p)
+ fprintf_filtered (m_stream, ", ");
+ }
+ }
+
+ /* Called to process an element of ELT_TYPE at offset ELT_OFF from the
+ start of the parent object. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ /* Extract the element value from the parent value. */
+ struct value *e_val
+ = value_from_component (m_val, elt_type, elt_off);
+ common_val_print (e_val, m_stream, m_recurse, m_options, current_language);
+ ++m_elts;
+ }
+
+private:
+ /* The number of elements printed so far. */
+ int m_elts;
+
+ /* The value from which we are printing elements. */
+ struct value *m_val;
+
+ /* The stream we should print too. */
+ struct ui_file *m_stream;
+
+ /* The recursion counter, passed through when we print each element. */
+ int m_recurse;
+
+ /* The print control options. Gives us the maximum number of elements to
+ print, and is passed through to each element that we print. */
+ const struct value_print_options *m_options = nullptr;
+};
-/* This function gets called to print an F77 array, we set up some
- stuff and then immediately call f77_print_array_1(). */
+/* This function gets called to print a Fortran array. */
static void
-f77_print_array (struct type *type, const gdb_byte *valaddr,
- int embedded_offset,
- CORE_ADDR address, struct ui_file *stream,
- int recurse,
- const struct value *val,
- const struct value_print_options *options)
+fortran_print_array (struct type *type, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ const struct value *val,
+ const struct value_print_options *options)
{
- int ndimensions;
- int elts = 0;
-
- ndimensions = calc_f77_array_dims (type);
-
- if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
- error (_("\
-Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
- ndimensions, MAX_FORTRAN_DIMS);
-
- f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
- address, stream, recurse, val, options, &elts);
+ fortran_array_walker<fortran_array_printer_impl> p
+ (type, address, (struct value *) val, stream, recurse, options);
+ p.walk ();
}
\f
@@ -238,8 +249,7 @@ f_value_print_inner (struct value *val, struct ui_file *stream, int recurse,
if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR)
{
fprintf_filtered (stream, "(");
- f77_print_array (type, valaddr, 0,
- address, stream, recurse, val, options);
+ fortran_print_array (type, address, stream, recurse, val, options);
fprintf_filtered (stream, ")");
}
else
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index da1c58c65c1..4fae13afb19 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -39,6 +39,7 @@
#include "dwarf2/loc.h"
#include "gdbcore.h"
#include "floatformat.h"
+#include "f-lang.h"
#include <algorithm>
/* Initialize BADNESS constants. */
@@ -2617,7 +2618,16 @@ resolve_dynamic_type_internal (struct type *type,
prop = TYPE_DATA_LOCATION (resolved_type);
if (prop != NULL
&& dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
- prop->set_const_val (value);
+ {
+ /* Start of Fortran hack. See comment in f-lang.h for what is going
+ on here.*/
+ if (current_language->la_language == language_fortran
+ && resolved_type->code () == TYPE_CODE_ARRAY)
+ value = fortran_adjust_dynamic_array_base_address_hack (resolved_type,
+ value);
+ /* End of Fortran hack. */
+ prop->set_const_val (value);
+ }
return resolved_type;
}
diff --git a/gdb/parse.c b/gdb/parse.c
index e7509168c77..85cef9ba616 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -924,6 +924,8 @@ operator_length_standard (const struct expression *expr, int endpos,
/* Assume the range has 2 arguments (low bound and high bound), then
reduce the argument count if any bounds are set to default. */
args = 2;
+ if (range_type & RANGE_HAS_STRIDE)
+ ++args;
if (range_type & RANGE_LOW_BOUND_DEFAULT)
--args;
if (range_type & RANGE_HIGH_BOUND_DEFAULT)
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
new file mode 100644
index 00000000000..2583cdecc94
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
@@ -0,0 +1,69 @@
+# Copyright 2020 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/> .
+
+# Test invalid element and slice array accesses.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "First Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Second Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+gdb_continue_to_breakpoint "First Breakpoint"
+
+# Access not yet allocated array.
+gdb_test "print other" " = <not allocated>"
+gdb_test "print other(0:4,2:3)" "array not allocated"
+gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)"
+
+# Access not yet associated pointer.
+gdb_test "print pointer2d" " = <not associated>"
+gdb_test "print pointer2d(1:2,1:2)" "array not associated"
+gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)"
+
+gdb_continue_to_breakpoint "Second Breakpoint"
+
+# Accessing just outside the arrays.
+foreach name {array pointer2d other} {
+ gdb_test "print $name (0:,:)" "array subscript out of bounds"
+ gdb_test "print $name (:11,:)" "array subscript out of bounds"
+ gdb_test "print $name (:,0:)" "array subscript out of bounds"
+ gdb_test "print $name (:,:11)" "array subscript out of bounds"
+
+ gdb_test "print $name (0,:)" "no such vector element"
+ gdb_test "print $name (11,:)" "no such vector element"
+ gdb_test "print $name (:,0)" "no such vector element"
+ gdb_test "print $name (:,11)" "no such vector element"
+}
+
+# Stride in the wrong direction.
+gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination"
+gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
new file mode 100644
index 00000000000..0f3d45ab8cd
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
@@ -0,0 +1,42 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Declare variables used in this test.
+ integer, dimension (1:10,1:10) :: array
+ integer, allocatable :: other (:, :)
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(1:10,1:10), target :: tarray
+
+ print *, "" ! First Breakpoint.
+
+ ! Allocate or associate any variables as needed.
+ allocate (other (1:10, 1:10))
+ pointer2d => tarray
+ array = 0
+
+ print *, "" ! Second Breakpoint.
+
+ ! All done. Deallocate.
+ deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
new file mode 100644
index 00000000000..05b4802c678
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
@@ -0,0 +1,111 @@
+# Copyright 2020 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/> .
+
+# Create a slice of an array, then take a slice of that slice.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Stop Here"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We're going to print some reasonably large arrays.
+gdb_test_no_output "set print elements unlimited"
+
+gdb_continue_to_breakpoint "Stop Here"
+
+# Print a slice, capture the convenience variable name created.
+set cmd "print array (1:10:2, 1:10:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ }
+}
+
+# Now check that we can correctly extract all the elements from this
+# slice.
+for { set j 1 } { $j < 6 } { incr j } {
+ for { set i 1 } { $i < 6 } { incr i } {
+ set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1]
+ gdb_test "print ${varname} ($i,$j)" " = $val"
+ }
+}
+
+# Now take a slice of the slice.
+gdb_test "print ${varname} (3:5, 3:5)" \
+ " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)"
+
+# Now take a different slice of a slice.
+set cmd "print ${varname} (1:5:2, 1:5:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Now take a slice from the slice, of a slice!
+set cmd "print ${varname} (1:3:2, 1:3:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# And again!
+set cmd "print ${varname} (1:2:2, 1:2:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Test taking a slice with stride of a string. This isn't actually
+# supported within gfortran (at least), but naturally drops out of how
+# GDB models arrays and strings in a similar way, so we may as well
+# test that this is still working.
+gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'"
+gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'"
+gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'"
+
+# Now test the memory requirements of taking a slice from an array.
+# The idea is that we shouldn't require more memory to extract a slice
+# than the size of the slice.
+#
+# This will only work if array repacking is turned on, otherwise GDB
+# will create the slice by generating a new type that sits over the
+# existing value in memory.
+gdb_test_no_output "set fortran repack-array-slices on"
+set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"]
+set slice_size [expr $element_size * 4]
+gdb_test_no_output "set max-value-size $slice_size"
+gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)"
+gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)"
+gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
new file mode 100644
index 00000000000..c3530f567d4
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
@@ -0,0 +1,96 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+ integer, dimension (1:10,1:11) :: array
+ character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz"
+
+ call fill_array_2d (array)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Stop Here
+
+ print *, array
+ print *, str
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index 31f95a3668d..ff00fae886f 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -18,6 +18,21 @@
# the subroutine. This should exercise GDB's ability to handle
# different strides for the different dimensions.
+# Testing GDB's ability to print array (and string) slices, including
+# slices that make use of array strides.
+#
+# In the Fortran code various arrays of different ranks are filled
+# with data, and slices are passed to a series of show functions.
+#
+# In this test script we break in each of the show functions, print
+# the array slice that was passed in, and then move up the stack to
+# the parent frame and check GDB can manually extract the same slice.
+#
+# This test also checks that the size of the array slice passed to the
+# function (so as extracted and described by the compiler and the
+# debug information) matches the size of the slice manually extracted
+# by GDB.
+
if {[skip_fortran_tests]} { return -1 }
standard_testfile ".f90"
@@ -28,44 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
return -1
}
-if ![fortran_runto_main] {
- untested "could not run to main"
- return -1
+# Takes the name of an array slice as used in the test source, and extracts
+# the base array name. For example: 'array (1,2)' becomes 'array'.
+proc array_slice_to_var { slice_str } {
+ regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname
+ return $varname
}
-gdb_breakpoint "show"
-gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
-
-set array_contents \
- [list \
- " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
- " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
- " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
- " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
- " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
- " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
-
-set message_strings \
- [list \
- " = 'array'" \
- " = 'array \\(1:5,1:5\\)'" \
- " = 'array \\(1:10:2,1:10:2\\)'" \
- " = 'array \\(1:10:3,1:10:2\\)'" \
- " = 'array \\(1:10:5,1:10:3\\)'" \
- " = 'other'" \
- " = 'other \\(-5:0, -2:0\\)'" \
- " = 'other \\(-5:4:2, -2:7:3\\)'" ]
-
-set i 0
-foreach result $array_contents msg $message_strings {
- incr i
- with_test_prefix "test $i" {
- gdb_continue_to_breakpoint "show"
- gdb_test "p array" $result
- gdb_test "p message" "$msg"
+proc run_test { repack } {
+ global binfile gdb_prompt
+
+ clean_restart ${binfile}
+
+ if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
}
+
+ gdb_test_no_output "set fortran repack-array-slices $repack"
+
+ # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+ gdb_breakpoint [gdb_get_line_number "Display Element"]
+ gdb_breakpoint [gdb_get_line_number "Display String"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"]
+ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+ # We're going to print some reasonably large arrays.
+ gdb_test_no_output "set print elements unlimited"
+
+ set found_final_breakpoint false
+
+ # We place a limit on the number of tests that can be run, just in
+ # case something goes wrong, and GDB gets stuck in an loop here.
+ set test_count 0
+ while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ set found_final_breakpoint false
+ set expected_result ""
+ set func_name ""
+ gdb_test_multiple "continue" "continue" {
+ -re ".*GDB = (\[^\r\n\]+)\r\n" {
+ set expected_result $expect_out(1,string)
+ exp_continue
+ }
+ -re "! Display Element" {
+ set func_name "show_elem"
+ exp_continue
+ }
+ -re "! Display String" {
+ set func_name "show_str"
+ exp_continue
+ }
+ -re "! Display Array Slice (.)D" {
+ set func_name "show_$expect_out(1,string)d"
+ exp_continue
+ }
+ -re "! Final Breakpoint" {
+ set found_final_breakpoint true
+ exp_continue
+ }
+ -re "$gdb_prompt $" {
+ # We're done.
+ }
+ }
+
+ if ($found_final_breakpoint) {
+ break
+ }
+
+ # We want to take a look at the line in the previous frame that
+ # called the current function. I couldn't find a better way of
+ # doing this than 'up', which will print the line, then 'down'
+ # again.
+ #
+ # I don't want to fill the log with passes for these up/down
+ # commands, so we don't report any. If something goes wrong then we
+ # should get a fail from gdb_test_multiple.
+ set array_slice_name ""
+ set unique_id ""
+ array unset replacement_vars
+ array set replacement_vars {}
+ gdb_test_multiple "up" "up" {
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ }
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ set unique_id $expect_out(2,string)
+ }
+ }
+ if {$unique_id != ""} {
+ set str ""
+ foreach v [split $unique_id ,] {
+ set val [get_integer_valueof "${v}" "??"\
+ "get variable '$v' for '$array_slice_name'"]
+ set replacement_vars($v) $val
+ if {$str != ""} {
+ set str "Str,"
+ }
+ set str "$str$v=$val"
+ }
+ set unique_id " $str"
+ }
+ gdb_test_multiple "down" "down" {
+ -re "\r\n$gdb_prompt $" {
+ # Don't issue a pass here.
+ }
+ }
+
+ # Check we have all the information we need to successfully run one
+ # of these tests.
+ if { $expected_result == "" } {
+ perror "failed to extract expected results"
+ return 0
+ }
+ if { $array_slice_name == "" } {
+ perror "failed to extract array slice name"
+ return 0
+ }
+
+ # Check GDB can correctly print the array slice that was passed into
+ # the current frame.
+ set pattern [string_to_regexp " = $expected_result"]
+ gdb_test "p array" "$pattern" \
+ "check value of '$array_slice_name'$unique_id"
+
+ # Get the size of the slice.
+ set size_in_show \
+ [get_integer_valueof "sizeof (array)" "show_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in show"]
+ set addr_in_show \
+ [get_hexadecimal_valueof "&array" "show_unknown" \
+ "get address '$array_slice_name'$unique_id in show"]
+
+ # Now move into the previous frame, and see if GDB can extract the
+ # array slice from the original parent object. Again, use of
+ # gdb_test_multiple to avoid filling the logs with unnecessary
+ # passes.
+ gdb_test_multiple "up" "up" {
+ -re "\r\n$gdb_prompt $" {
+ # Do nothing.
+ }
+ }
+
+ # Print the array slice, this will force GDB to manually extract the
+ # slice from the parent array.
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted"
+
+ # Get the size of the slice in the calling frame.
+ set size_in_parent \
+ [get_integer_valueof "sizeof ($array_slice_name)" \
+ "parent_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in parent"]
+
+ # Figure out the start and end addresses of the full array in the
+ # parent frame.
+ set full_var_name [array_slice_to_var $array_slice_name]
+ set start_addr [get_hexadecimal_valueof "&${full_var_name}" \
+ "start unknown"]
+ set end_addr [get_hexadecimal_valueof \
+ "(&${full_var_name}) + sizeof (${full_var_name})" \
+ "end unknown"]
+
+ # The Fortran compiler can choose to either send a descriptor that
+ # describes the array slice to the subroutine, or it can repack the
+ # slice into an array section and send that.
+ #
+ # We find the address range of the original array in the parent,
+ # and the address of the slice in the show function, if the
+ # address of the slice (from show) is in the range of the original
+ # array then repacking has not occurred, otherwise, the slice is
+ # outside of the parent, and repacking must have occurred.
+ #
+ # The goal here is to compare the sizes of the slice in show with
+ # the size of the slice extracted by GDB. So we can only compare
+ # sizes when GDB's repacking setting matches the repacking
+ # behaviour we got from the compiler.
+ if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \
+ == ($repack == "on") } {
+ gdb_assert {$size_in_show == $size_in_parent} \
+ "check sizes match"
+ } elseif { $repack == "off" } {
+ # GDB's repacking is off (so slices are left unpacked), but
+ # the compiler did pack this one. As a result we can't
+ # compare the sizes between the compiler's slice and GDB's
+ # slice.
+ verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared"
+ } else {
+ # Like the above, but the reverse, GDB's repacking is on, but
+ # the compiler didn't repack this slice.
+ verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared"
+ }
+
+ # If the array name we just tested included variable names, then
+ # test again with all the variables expanded.
+ if {$unique_id != ""} {
+ foreach v [array names replacement_vars] {
+ set val $replacement_vars($v)
+ set array_slice_name \
+ [regsub "\\y${v}\\y" $array_slice_name $val]
+ }
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded"
+ }
+ }
+ }
+
+ # Ensure we reached the final breakpoint. If more tests have been added
+ # to the test script, and this starts failing, then the safety 'while'
+ # loop above might need to be increased.
+ gdb_assert {$found_final_breakpoint} "ran all tests"
}
-gdb_continue_to_breakpoint "continue to Final Breakpoint"
+foreach_with_prefix repack { on off } {
+ run_test $repack
+}
diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
index a66fa6ba784..6d75a385699 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.f90
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -13,58 +13,368 @@
! 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 show (message, array)
- character (len=*) :: message
+subroutine show_elem (array)
+ integer :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = "
+ write(*, fmt="(I0)", advance="no") array
+ write(*, fmt="(A)", advance="yes") ""
+
+ print *, "" ! Display Element
+end subroutine show_elem
+
+subroutine show_str (array)
+ character (len=*) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+ write (*, fmt="(A)", advance="no") "GDB = '"
+ write (*, fmt="(A)", advance="no") array
+ write (*, fmt="(A)", advance="yes") "'"
+
+ print *, "" ! Display String
+end subroutine show_str
+
+subroutine show_1d (array)
+ integer, dimension (:) :: array
+
+ print *, "Array Contents:"
+ print *, ""
+
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ write(*, fmt="(i4)", advance="no") array (i)
+ end do
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (i > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+
+ print *, "" ! Display Array Slice 1D
+end subroutine show_1d
+
+subroutine show_2d (array)
integer, dimension (:,:) :: array
- print *, message
+ print *, "Array Contents:"
+ print *, ""
+
do i=LBOUND (array, 2), UBOUND (array, 2), 1
do j=LBOUND (array, 1), UBOUND (array, 1), 1
write(*, fmt="(i4)", advance="no") array (j, i)
end do
print *, ""
- end do
- print *, array
- print *, ""
+ end do
-end subroutine show
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
-program test
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (i > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (j > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 2D
+end subroutine show_2d
+
+subroutine show_3d (array)
+ integer, dimension (:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (i > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (j > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (k > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 3D
+end subroutine show_3d
+
+subroutine show_4d (array)
+ integer, dimension (:,:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ if (i > LBOUND (array, 4)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (j > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (k > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (l > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (l, k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 4D
+end subroutine show_4d
+!
+! Start of test program.
+!
+program test
interface
- subroutine show (message, array)
- character (len=*) :: message
+ subroutine show_str (array)
+ character (len=*) :: array
+ end subroutine show_str
+
+ subroutine show_1d (array)
+ integer, dimension (:) :: array
+ end subroutine show_1d
+
+ subroutine show_2d (array)
integer, dimension(:,:) :: array
- end subroutine show
+ end subroutine show_2d
+
+ subroutine show_3d (array)
+ integer, dimension(:,:,:) :: array
+ end subroutine show_3d
+
+ subroutine show_4d (array)
+ integer, dimension(:,:,:,:) :: array
+ end subroutine show_4d
end interface
+ ! Declare variables used in this test.
+ integer, dimension (-10:-1,-10:-2) :: neg_array
integer, dimension (1:10,1:10) :: array
integer, allocatable :: other (:, :)
+ character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz"
+ integer, dimension (-2:2,-2:2,-2:2) :: array3d
+ integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d
+ integer, dimension (10:20) :: array1d
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(-1:9,-1:9), target :: tarray
+ ! Allocate or associate any variables as needed.
allocate (other (-5:4, -2:7))
+ pointer2d => tarray
- do i=LBOUND (array, 2), UBOUND (array, 2), 1
- do j=LBOUND (array, 1), UBOUND (array, 1), 1
- array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
- end do
- end do
+ ! Fill arrays with contents ready for testing.
+ call fill_array_1d (array1d)
+
+ call fill_array_2d (neg_array)
+ call fill_array_2d (array)
+ call fill_array_2d (other)
+ call fill_array_2d (tarray)
+
+ call fill_array_3d (array3d)
+ call fill_array_4d (array4d)
+
+ ! The tests. Each call to a show_* function must have a unique set
+ ! of arguments as GDB uses the arguments are part of the test name
+ ! string, so duplicate arguments will result in duplicate test
+ ! names.
+ !
+ ! If a show_* line ends with VARS=... where '...' is a comma
+ ! separated list of variable names, these variables are assumed to
+ ! be part of the call line, and will be expanded by the test script,
+ ! for example:
+ !
+ ! do x=1,9,1
+ ! do y=x,10,1
+ ! call show_1d (some_array (x,y)) ! VARS=x,y
+ ! end do
+ ! end do
+ !
+ ! In this example the test script will automatically expand 'x' and
+ ! 'y' in order to better test different aspects of GDB. Do take
+ ! care, the expansion is not very "smart", so try to avoid clashing
+ ! with other text on the line, in the example above, avoid variables
+ ! named 'some' or 'array', as these will likely clash with
+ ! 'some_array'.
+ call show_str (str_1)
+ call show_str (str_1 (1:20))
+ call show_str (str_1 (10:20))
- do i=LBOUND (other, 2), UBOUND (other, 2), 1
- do j=LBOUND (other, 1), UBOUND (other, 1), 1
- other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
+ call show_elem (array1d (11))
+ call show_elem (pointer2d (2,3))
+
+ call show_1d (array1d)
+ call show_1d (array1d (13:17))
+ call show_1d (array1d (17:13:-1))
+ call show_1d (array (1:5,1))
+ call show_1d (array4d (1,7,3,:))
+ call show_1d (pointer2d (-1:3, 2))
+ call show_1d (pointer2d (-1, 2:4))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_1d ((array (1:5,1)))
+
+ call show_2d (pointer2d)
+ call show_2d (array)
+ call show_2d (array (1:5,1:5))
+ do i=1,10,2
+ do j=1,10,3
+ call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j
+ call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j
end do
end do
+ call show_2d (array (6:2:-1,3:9))
+ call show_2d (array (1:10:2, 1:10:2))
+ call show_2d (other)
+ call show_2d (other (-5:0, -2:0))
+ call show_2d (other (-5:4:2, -2:7:3))
+ call show_2d (neg_array)
+ call show_2d (neg_array (-10:-3,-8:-4:2))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_2d ((array (1:10:3, 1:10:2)))
+ call show_2d ((neg_array (-10:-3,-8:-4:2)))
- call show ("array", array)
- call show ("array (1:5,1:5)", array (1:5,1:5))
- call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
- call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
- call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
+ call show_3d (array3d)
+ call show_3d (array3d(-1:1,-1:1,-1:1))
+ call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1))
- call show ("other", other)
- call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
- call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1)))
+ call show_4d (array4d)
+ call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1))
+ call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1)))
+
+ ! All done. Deallocate.
deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
end program test
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
index d26b8c60f80..1e7ffd04430 100644
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -42,7 +42,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
gdb_test "print sizeof(vla1(3,2,1))" "4" \
"print sizeof element from allocated vla1"
-gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
+gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
"print sizeof sliced vla1"
# Try to access values in undefined pointer to VLA (dangling)
@@ -59,7 +59,7 @@ gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
gdb_test "print sizeof(pvla(3,2,1))" "4" \
"print sizeof element from associated pvla"
-gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
+gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCH 8/8] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-08-13 12:58 ` [PATCH 8/8] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
@ 2020-08-13 13:31 ` Eli Zaretskii
0 siblings, 0 replies; 62+ messages in thread
From: Eli Zaretskii @ 2020-08-13 13:31 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
> From: Andrew Burgess <andrew.burgess@embecosm.com>
> Date: Thu, 13 Aug 2020 13:58:45 +0100
>
> This commit brings array slice support to GDB.
>
> WARNING: This patch contains a rather big hack which is limited to
> Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More
> details on this below.
>
> This patch rewrites two areas of GDB's Fortran support, the code to
> extract an array slice, and the code to print an array.
>
> After this commit a user can, from the GDB prompt, ask for a slice of
> a Fortran array and should get the correct result back. Slices can
> (optionally) have the lower bound, upper bound, and a stride
> specified. Slices can also have a negative stride.
>
> Fortran has the concept of repacking array slices. Within a compiled
> Fortran program if a user passes a non-contiguous array slice to a
> function then the compiler may have to repack the slice, this involves
> copying the elements of the slice to a new area of memory before the
> call, and copying the elements back to the original array after the
> call. Whether repacking occurs will depend on which version of
> Fortran is being used, and what type of function is being called.
>
> This commit adds support for both packed, and unpacked array slicing,
> with the default being unpacked.
>
> With an unpacked array slice, when the user asks for a slice of an
> array GDB creates a new type that accurately describes where the
> elements of the slice can be found within the original array, a
> value of this type is then returned to the user. The address of an
> element within the slice will be equal to the address of an element
> within the original array.
>
> A user can choose to selected packed array slices instead using:
>
> (gdb) set fortran repack-array-slices on|off
> (gdb) show fortran repack-array-slices
>
> With packed array slices GDB creates a new type that reflects how the
> elements of the slice would look if they were laid out in contiguous
> memory, allocates a value of this type, and then fetches the elements
> from the original array and places then into the contents buffer of
> the new value.
>
> One benefit of using packed slices over unapacked slices is the memory
> usage, taking a small slice of N elements from a large array will
> require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked
> array will also include all of the "padding" between the
> non-contiguous elements. There are new tests added that highlight
> this difference.
>
> There is also a new debugging flag added with this commit that
> introduces these commands:
>
> (gdb) set debug fortran-array-slicing on|off
> (gdb) show debug fortran-array-slicing
>
> This prints information about how the array slices are being built.
>
> As both the repacking, and the array printing requires GDB to walk
> through a multi-dimensional Fortran array visiting each element, this
> commit adds the file f-array-walk.h, which introduces some
> infrastructure to support this process. This means the array printing
> code in f-valprint.c is significantly reduced.
>
> The only slight issue with this commit is the "rather big hack" that I
> mentioned above. This hack allows us to handle one specific case,
> array slices with negative strides. This is something that I don't
> believe the current GDB value contents model will allow us to
> "correctly" handle, and rather than rewrite the value contents code
> right now, I'm hoping to slip this hack in as a work around.
>
> The problem is that as I see it the current value contents model
> assumes that an object base address will be the lowest address within
> that object, and that the contents of the object start at this base
> address and occupy the TYPE_LENGTH bytes after that.
>
> We do have the embedded_offset, which is used for C++ sub-classes,
> such that an object can start at some offset from the content buffer,
> however, the assumption that the object then occupies the next
> TYPE_LENGTH bytes is still true within GDB.
>
> The problem is that Fortran arrays with a negative stride don't follow
> this pattern. In this case the base address of the object points to
> the element with the highest address, the contents of the array then
> start at some offset _before_ the base address, and proceed for one
> element _past_ the base address.
>
> This is further complicated because arrays with negative strides like
> this are always dynamic types, the program being debugged has passed a
> slice with a negative stride to a function, and it is only when we
> actually try to look at the slice within the function that the dynamic
> type is resolved, and the negative type is seen. When dealing with
> dynamic types like this the address is actually stored on the _type_,
> not the value, this dynamic address then overrides the value's address
> in the value_address function.
>
> I currently don't see any way to handle this address configuration
> with GDB's current dynamic type and value system, which is why I've
> added this hack:
>
> When we resolve a dynamic Fortran array type, if the stride is
> negative, then we adjust the base address to point to the lowest
> address required by the array. The printing and slicing code is aware
> of this adjustment and will correctly slice and print Fortran arrays.
>
> Where this hack will show through to the user is if they ask for the
> address of an array in their program with a negative array stride, the
> address they get from GDB will not match the address that would be
> computed within the Fortran program.
>
> gdb/ChangeLog:
>
> * Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
> * NEWS: Mention new options.
> * expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE.
> * expression.h (enum range_type): Add RANGE_HAS_STRIDE.
> * f-array-walker.h: New file.
> * f-exp.y (arglist): Allow for a series of subranges.
> (subrange): Add cases for subranges with strides.
> * f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
> (repack_array_slices): New static global.
> (show_repack_array_slices): New function.
> (fortran_array_slicing_debug): New static global.
> (show_fortran_array_slicing_debug): New function.
> (value_f90_subarray): Delete.
> (skip_undetermined_arglist): Delete.
> (class fortran_array_repacker_base_impl): New class.
> (class fortran_lazy_array_repacker_impl): New class.
> (class fortran_array_repacker_impl): New class.
> (fortran_value_subarray): Complete rewrite.
> (set_fortran_list): New static global.
> (show_fortran_list): Likewise.
> (_initialize_f_language): Register new commands.
> (fortran_adjust_dynamic_array_base_address_hack): New function.
> * f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
> Declare.
> * f-valprint.c: Include 'f-array-walker.h'.
> (class fortran_array_printer_impl): New class.
> (f77_print_array_1): Delete.
> (f77_print_array): Delete.
> (fortran_print_array): New.
> (f_value_print_inner): Update to call fortran_print_array.
> * gdbtypes.c: Include 'f-lang.h'.
> (resolve_dynamic_type_internal): Call
> fortran_adjust_dynamic_array_base_address_hack.
> * parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE.
>
> gdb/testsuite/ChangeLog:
>
> * gdb.fortran/array-slices-bad.exp: New file.
> * gdb.fortran/array-slices-bad.f90: New file.
> * gdb.fortran/array-slices-sub-slices.exp: New file.
> * gdb.fortran/array-slices-sub-slices.f90: New file.
> * gdb.fortran/array-slices.exp: Rewrite tests.
> * gdb.fortran/array-slices.f90: Rewrite tests.
> * gdb.fortran/vla-sizeof.exp: Correct expected results.
>
> gdb/doc/ChangeLog:
>
> * gdb.texinfo (Debugging Output): Document 'set/show debug
> fotran-array-slicing'.
> (Special Fortran Commands): Document 'set/show fortran
> repack-array-slices'.
Thanks, the documentation parts are okay.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags
2020-08-13 12:58 ` [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags Andrew Burgess
@ 2020-08-15 17:16 ` Tom Tromey
2020-08-16 9:13 ` Andrew Burgess
2020-08-17 10:40 ` Andrew Burgess
0 siblings, 2 replies; 62+ messages in thread
From: Tom Tromey @ 2020-08-15 17:16 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> The current enum bit flags mechanism provides global operators &, |,
Andrew> ^, ~, but does not provide &=, |=, ^=.
Andrew> The implementation for one of these, |=, would look like this:
Andrew> template <typename enum_type>
Andrew> typename enum_flags_type<enum_type>::type &
Andrew> operator|= (enum_type &e1, enum_type e2)
Why "enum_type &e1" and not "enum_flags_type<enum_type>::type &e1" here?
Andrew> DEF_ENUM_FLAGS_TYPE(enum some_flag, some_flags);
Andrew> enum some_flag f = flag_val1 | flag_val2;
Andrew> f |= flag_val3;
To me this example looks incorrect -- the idea behind enum flags is to
not use the "enum some_flag" type, but instead the wrapper. So it
should be:
some_flags f = flag_val1 | flag_val2;
f |= flag_val3;
Could you say why you want to use the enum type instead? That would
help me understand this patch.
Tom
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCH 2/8] gdbsupport: Make function arguments constant in enum-flags.h
2020-08-13 12:58 ` [PATCH 2/8] gdbsupport: Make function arguments constant in enum-flags.h Andrew Burgess
@ 2020-08-15 19:45 ` Tom Tromey
2020-08-16 9:08 ` Andrew Burgess
0 siblings, 1 reply; 62+ messages in thread
From: Tom Tromey @ 2020-08-15 19:45 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> Make the arguments used for the operators within enum-flags.h constant
Andrew> references where possible. There should be no user visible changes
Andrew> after this commit.
enum_flags is a standard layout value-like class. Normally the compiler
will be able to treat objects of this type as if they were the
underlying scalar type -- there will be no abstraction penalty, the
object will be passed in registers, etc.
So, I think it's best not to use references here, unless there's a
strong reason for it.
Tom
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCH 2/8] gdbsupport: Make function arguments constant in enum-flags.h
2020-08-15 19:45 ` Tom Tromey
@ 2020-08-16 9:08 ` Andrew Burgess
0 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-16 9:08 UTC (permalink / raw)
To: Tom Tromey; +Cc: gdb-patches
* Tom Tromey <tom@tromey.com> [2020-08-15 13:45:51 -0600]:
> >>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
>
> Andrew> Make the arguments used for the operators within enum-flags.h constant
> Andrew> references where possible. There should be no user visible changes
> Andrew> after this commit.
>
> enum_flags is a standard layout value-like class. Normally the compiler
> will be able to treat objects of this type as if they were the
> underlying scalar type -- there will be no abstraction penalty, the
> object will be passed in registers, etc.
>
> So, I think it's best not to use references here, unless there's a
> strong reason for it.
Thanks for the feedback. This patch can be dropped from the series.
Andrew
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags
2020-08-15 17:16 ` Tom Tromey
@ 2020-08-16 9:13 ` Andrew Burgess
2020-08-17 10:40 ` Andrew Burgess
1 sibling, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-16 9:13 UTC (permalink / raw)
To: Tom Tromey; +Cc: gdb-patches
* Tom Tromey <tom@tromey.com> [2020-08-15 11:16:46 -0600]:
> >>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
>
> Andrew> The current enum bit flags mechanism provides global operators &, |,
> Andrew> ^, ~, but does not provide &=, |=, ^=.
>
> Andrew> The implementation for one of these, |=, would look like this:
>
> Andrew> template <typename enum_type>
> Andrew> typename enum_flags_type<enum_type>::type &
> Andrew> operator|= (enum_type &e1, enum_type e2)
>
> Why "enum_type &e1" and not "enum_flags_type<enum_type>::type &e1" here?
>
> Andrew> DEF_ENUM_FLAGS_TYPE(enum some_flag, some_flags);
>
> Andrew> enum some_flag f = flag_val1 | flag_val2;
> Andrew> f |= flag_val3;
>
> To me this example looks incorrect -- the idea behind enum flags is to
> not use the "enum some_flag" type, but instead the wrapper. So it
> should be:
>
> some_flags f = flag_val1 | flag_val2;
> f |= flag_val3;
>
> Could you say why you want to use the enum type instead? That would
> help me understand this patch.
Thanks for the feedback. I believe that I was trying to make the
header work with existing code in GDB where 'enum' is used.
I'll double check this (I wrote this patch a long time ago now), but
if this is the case then, based on your comments, I suspect the
"correct" fix is to patch GDB to remove the use of 'enum' (in those
places where 'DEF_ENUM_FLAGS_TYPE' is used), and then add the extra
operators I need.
I'll update this patch and repost.
I don't think this should impact the rest of this series in any
significant way.
Thanks,
Andrew
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags
2020-08-15 17:16 ` Tom Tromey
2020-08-16 9:13 ` Andrew Burgess
@ 2020-08-17 10:40 ` Andrew Burgess
2020-08-20 16:00 ` Pedro Alves
2020-08-21 14:49 ` Pedro Alves
1 sibling, 2 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-17 10:40 UTC (permalink / raw)
To: Tom Tromey; +Cc: gdb-patches
Tom,
I think I gave up on this patch too easily. I'd like to push back and
argue in favour of this change.
* Tom Tromey <tom@tromey.com> [2020-08-15 11:16:46 -0600]:
> >>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
>
> Andrew> The current enum bit flags mechanism provides global operators &, |,
> Andrew> ^, ~, but does not provide &=, |=, ^=.
>
> Andrew> The implementation for one of these, |=, would look like this:
>
> Andrew> template <typename enum_type>
> Andrew> typename enum_flags_type<enum_type>::type &
> Andrew> operator|= (enum_type &e1, enum_type e2)
>
> Why "enum_type &e1" and not "enum_flags_type<enum_type>::type &e1"
> here?
Unless I'm really messing up here, then when I try this I get the
compiler error:
enum-flags.h:217:41: error: declaration of ‘operator|=’ as non-function
217 | operator|= (enum_flags_type<enum_type>::type &e1, enum_type e2)
Though I can't understand what the error is trying to tell me, I can
understand why the compiler is unhappy. When you consider the
enum_flags operator|= and the global operator|= they both now have the
exact same function signature, so there's no way for the compiler to
pick between them.
>
> Andrew> DEF_ENUM_FLAGS_TYPE(enum some_flag, some_flags);
>
> Andrew> enum some_flag f = flag_val1 | flag_val2;
> Andrew> f |= flag_val3;
>
> To me this example looks incorrect -- the idea behind enum flags is to
> not use the "enum some_flag" type, but instead the wrapper. So it
> should be:
>
> some_flags f = flag_val1 | flag_val2;
> f |= flag_val3;
>
> Could you say why you want to use the enum type instead? That would
> help me understand this patch.
I agree, but...
My argument would be:
1. By making the change I propose we loose nothing, but my example
above will just work, so we do gain something.
2. We already have some global operators, these are only used when we
run into cases like my original example, so clearly the code was
originally written (I'm assuming) with the idea of supporting both
use cases.
3. Instead of writing 'enum some_flag', a developer might just write
'some_flag'. In this case they still require the changes from my
patch if they ever want to use operator|=. I think spotting the
missing 's' is much harder during review, so it's easy for uses of
'some_flag' to creep into the code base, then a future developer
wanting to use 'operator|=' will need to fix up the 'some_flag' to
'some_flags' miss-match. Though it's easy to argue that the first
developer made a mistake, and we frequently have to fix the mistakes
of those going before, in this case we don't have to, so why force
the matter?
I guess my argument would be, lets commit. We should either remove
the existing global operators from enum-flags.h, fix up the fall out,
and so make it much harder to developers to use the 'some_flag'
version (so forcing the use of 'some_flags'), or make the change I
propose which allows the full range of operators while loosing non of
the protection that already exists.
Thanks,
Andrew
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags
2020-08-17 10:40 ` Andrew Burgess
@ 2020-08-20 16:00 ` Pedro Alves
2020-08-21 14:49 ` Pedro Alves
1 sibling, 0 replies; 62+ messages in thread
From: Pedro Alves @ 2020-08-20 16:00 UTC (permalink / raw)
To: Andrew Burgess, Tom Tromey; +Cc: gdb-patches
On 8/17/20 11:40 AM, Andrew Burgess wrote:
>> Andrew> The current enum bit flags mechanism provides global operators &, |,
>> Andrew> ^, ~, but does not provide &=, |=, ^=.
>>
>> Andrew> The implementation for one of these, |=, would look like this:
>>
>> Andrew> template <typename enum_type>
>> Andrew> typename enum_flags_type<enum_type>::type &
>> Andrew> operator|= (enum_type &e1, enum_type e2)
>>
>> Why "enum_type &e1" and not "enum_flags_type<enum_type>::type &e1"
>> here?
The
typename enum_flags_type<enum_type>::type
in the return type is written that way instead of simply
enum_flags<enum_type> &
operator|= (enum_type &e1, enum_type e2)
in order to have SFINAE disable the function if
enum_flags_type<enum_type> is not defined for the flags
type. I.e., that's what makes sure the function is only
defined for enums we only want it defined for.
There's no point in doing the SFINAE trick in both the return type
and in the parameters.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags
2020-08-17 10:40 ` Andrew Burgess
2020-08-20 16:00 ` Pedro Alves
@ 2020-08-21 14:49 ` Pedro Alves
2020-08-21 15:57 ` Andrew Burgess
1 sibling, 1 reply; 62+ messages in thread
From: Pedro Alves @ 2020-08-21 14:49 UTC (permalink / raw)
To: Andrew Burgess, Tom Tromey; +Cc: gdb-patches
On 8/17/20 11:40 AM, Andrew Burgess wrote:
>
> 3. Instead of writing 'enum some_flag', a developer might just write
> 'some_flag'.
I suspect you meant 'some_flags' in the latter case.
> In this case they still require the changes from my
> patch if they ever want to use operator|=. I think spotting the
> missing 's' is much harder during review,
I'd argue that that's an issue of naming. If people thing it's a
problem, we can use a more distinct name for the raw enums.
Some cases use enum foo_flag_value / foo_flags, which seems reasonable
to me.
> so it's easy for uses of
> 'some_flag' to creep into the code base, then a future developer
> wanting to use 'operator|=' will need to fix up the 'some_flag' to
> 'some_flags' miss-match. Though it's easy to argue that the first
> developer made a mistake, and we frequently have to fix the mistakes
> of those going before, in this case we don't have to, so why force
> the matter?
>
> I guess my argument would be, lets commit. We should either remove
> the existing global operators from enum-flags.h, fix up the fall out,
> and so make it much harder to developers to use the 'some_flag'
> version (so forcing the use of 'some_flags'), or make the change I
> propose which allows the full range of operators while loosing non of
> the protection that already exists.
This (again) reminded me of my enum-flags.h rewrite that I never
managed to commit...
I spent time around it yesterday/today, and posted it here:
https://sourceware.org/pipermail/gdb-patches/2020-August/171392.html
Thanks,
Pedro Alves
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags
2020-08-21 14:49 ` Pedro Alves
@ 2020-08-21 15:57 ` Andrew Burgess
2020-08-21 18:10 ` Pedro Alves
0 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-08-21 15:57 UTC (permalink / raw)
To: Pedro Alves; +Cc: Tom Tromey, gdb-patches
* Pedro Alves <pedro@palves.net> [2020-08-21 15:49:15 +0100]:
> On 8/17/20 11:40 AM, Andrew Burgess wrote:
>
> >
> > 3. Instead of writing 'enum some_flag', a developer might just write
> > 'some_flag'.
>
> I suspect you meant 'some_flags' in the latter case.
No, I meant 'some_flag'.
>
> > In this case they still require the changes from my
> > patch if they ever want to use operator|=. I think spotting the
> > missing 's' is much harder during review,
>
> I'd argue that that's an issue of naming. If people thing it's a
> problem, we can use a more distinct name for the raw enums.
> Some cases use enum foo_flag_value / foo_flags, which seems reasonable
> to me.
I don't understand where 'enum foo_flag_value' came from, so I can't
really respond to this.
>
> > so it's easy for uses of
> > 'some_flag' to creep into the code base, then a future developer
> > wanting to use 'operator|=' will need to fix up the 'some_flag' to
> > 'some_flags' miss-match. Though it's easy to argue that the first
> > developer made a mistake, and we frequently have to fix the mistakes
> > of those going before, in this case we don't have to, so why force
> > the matter?
> >
> > I guess my argument would be, lets commit. We should either remove
> > the existing global operators from enum-flags.h, fix up the fall out,
> > and so make it much harder to developers to use the 'some_flag'
> > version (so forcing the use of 'some_flags'), or make the change I
> > propose which allows the full range of operators while loosing non of
> > the protection that already exists.
>
> This (again) reminded me of my enum-flags.h rewrite that I never
> managed to commit...
>
> I spent time around it yesterday/today, and posted it here:
> https://sourceware.org/pipermail/gdb-patches/2020-August/171392.html
I saw this. Once this gets merged I'll rebase the rest of my series
on top of your work, at which point I assume that this patch will not
be required.
Thanks for your help,
Andrew
>
> Thanks,
> Pedro Alves
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags
2020-08-21 15:57 ` Andrew Burgess
@ 2020-08-21 18:10 ` Pedro Alves
0 siblings, 0 replies; 62+ messages in thread
From: Pedro Alves @ 2020-08-21 18:10 UTC (permalink / raw)
To: Andrew Burgess; +Cc: Tom Tromey, gdb-patches
On 8/21/20 4:57 PM, Andrew Burgess wrote:
> * Pedro Alves <pedro@palves.net> [2020-08-21 15:49:15 +0100]:
>
>> On 8/17/20 11:40 AM, Andrew Burgess wrote:
>>
>>>
>>> 3. Instead of writing 'enum some_flag', a developer might just write
>>> 'some_flag'.
>>
>> I suspect you meant 'some_flags' in the latter case.
>
> No, I meant 'some_flag'.
>
Oh, I see now.
>>
>>> In this case they still require the changes from my
>>> patch if they ever want to use operator|=. I think spotting the
>>> missing 's' is much harder during review,
>>
>> I'd argue that that's an issue of naming. If people thing it's a
>> problem, we can use a more distinct name for the raw enums.
>> Some cases use enum foo_flag_value / foo_flags, which seems reasonable
>> to me.
>
> I don't understand where 'enum foo_flag_value' came from, so I can't
> really respond to this.
I mean, this naming:
enum foo_flag { .... };
DEF_ENUM_FLAGS_TYPE (foo_flag, foo_flags);
could lead to the situation you mentioned more easily than this:
enum foo_flag_value { .... };
DEF_ENUM_FLAGS_TYPE (foo_flag_value, foo_flags);
As in:
DEF_ENUM_FLAGS_TYPE (enum c_string_type_values, c_string_type);
DEF_ENUM_FLAGS_TYPE (enum user_selected_what_flag, user_selected_what);
DEF_ENUM_FLAGS_TYPE (enum type_instance_flag_value, type_instance_flags);
DEF_ENUM_FLAGS_TYPE (enum linux_siginfo_extra_field_values, linux_siginfo_extra_fields);
vs:
DEF_ENUM_FLAGS_TYPE (enum btrace_insn_flag, btrace_insn_flags);
DEF_ENUM_FLAGS_TYPE (enum btrace_function_flag, btrace_function_flags);
DEF_ENUM_FLAGS_TYPE (enum btrace_thread_flag, btrace_thread_flags);
etc.
>
>>
>>> so it's easy for uses of
>>> 'some_flag' to creep into the code base, then a future developer
>>> wanting to use 'operator|=' will need to fix up the 'some_flag' to
>>> 'some_flags' miss-match. Though it's easy to argue that the first
>>> developer made a mistake, and we frequently have to fix the mistakes
>>> of those going before, in this case we don't have to, so why force
>>> the matter?
>>>
>>> I guess my argument would be, lets commit. We should either remove
>>> the existing global operators from enum-flags.h, fix up the fall out,
>>> and so make it much harder to developers to use the 'some_flag'
>>> version (so forcing the use of 'some_flags'), or make the change I
>>> propose which allows the full range of operators while loosing non of
>>> the protection that already exists.
>>
>> This (again) reminded me of my enum-flags.h rewrite that I never
>> managed to commit...
>>
>> I spent time around it yesterday/today, and posted it here:
>> https://sourceware.org/pipermail/gdb-patches/2020-August/171392.html
>
> I saw this. Once this gets merged I'll rebase the rest of my series
> on top of your work, at which point I assume that this patch will not
> be required.
I think so. I've now pushed my series to the
users/palves/enum-flags-rewrite branch if you ever want to give
it a try.
I don't plan to push that to master before the branch is cut.
Thanks,
Pedro Alves
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 00/10] Fortran Array Slicing and Striding Support
2020-08-13 12:58 [PATCH 0/8] Fortran Array Slicing and Striding Support Andrew Burgess
` (7 preceding siblings ...)
2020-08-13 12:58 ` [PATCH 8/8] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 01/10] Rewrite valid-expr.h's internals in terms of the detection idiom (C++17/N4502) Andrew Burgess
` (10 more replies)
8 siblings, 11 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
Since the V1 series I have rebased these patches on top of Pedro's
enum-flags rewrite[1]. As such patches 1 -> 4 should not be reviewed
in this sereis, but at[1].
The actual content of the remaining patches has not changed since the
V1 series. I'm still keen to get any feedback.
Patches 5, 6, 7, and 9 are independent of the earlier patches, and could be
merged before the GDB 10 branching if I get positive feedback.
Patches 8 and 10 I'd like to leave until after the GDB 10 branch has
been created, it's these patches that depend on the earlier 1->4 patch
series.
All feedback welcome.
Thanks,
Andrew
[1] https://sourceware.org/pipermail/gdb-patches/2020-August/171392.html
----
Andrew Burgess (7):
gdb: additional changes to make use of type_instance_flags more
gdb/fortran: Clean up array/string expression evaluation
gdb/fortran: Move Fortran expression handling into f-lang.c
gdb/fortran: Change whitespace when printing arrays
gdb: Convert enum range_type to a bit field enum
gdb/testsuite: Add missing expected results
gdb/fortran: Add support for Fortran array slices at the GDB prompt
Pedro Alves (3):
Rewrite valid-expr.h's internals in terms of the detection idiom
(C++17/N4502)
Use type_instance_flags more throughout
Rewrite enum_flags, add unit tests, fix problems
gdb/ChangeLog | 121 +++
gdb/Makefile.in | 2 +
gdb/NEWS | 13 +
gdb/avr-tdep.c | 13 +-
gdb/btrace.c | 4 +-
gdb/compile/compile-c-types.c | 3 +-
gdb/compile/compile-cplus-symbols.c | 4 +-
gdb/compile/compile-cplus-types.c | 10 +-
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 30 +
gdb/dwarf2/read.c | 7 +-
gdb/eval.c | 227 +----
gdb/expprint.c | 114 ++-
gdb/expression.h | 39 +-
gdb/f-array-walker.h | 255 ++++++
gdb/f-exp.y | 52 +-
gdb/f-lang.c | 779 ++++++++++++++++++
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 187 +++--
gdb/fortran-operator.def | 8 +
gdb/ft32-tdep.c | 13 +-
gdb/gdbarch.c | 8 +-
gdb/gdbarch.h | 16 +-
gdb/gdbarch.sh | 10 +-
gdb/gdbtypes.c | 70 +-
gdb/gdbtypes.h | 15 +-
gdb/go-exp.y | 2 +-
gdb/parse.c | 25 +-
gdb/parser-defs.h | 16 +
gdb/record-btrace.c | 10 +-
gdb/rust-exp.y | 21 +-
gdb/rust-lang.c | 25 +-
gdb/s390-tdep.c | 13 +-
gdb/stabsread.c | 2 +-
gdb/std-operator.def | 8 -
gdb/testsuite/ChangeLog | 22 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 +
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 264 +++++-
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 +++++++-
.../gdb.fortran/class-allocatable-array.exp | 2 +-
gdb/testsuite/gdb.fortran/multi-dim.exp | 2 +-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
gdb/testsuite/gdb.fortran/vla-type.exp | 6 +-
gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 2 +-
gdb/type-stack.c | 4 +-
gdb/unittests/enum-flags-selftests.c | 586 +++++++++++++
gdbsupport/enum-flags.h | 366 ++++++--
gdbsupport/traits.h | 67 ++
gdbsupport/valid-expr.h | 35 +-
52 files changed, 3505 insertions(+), 685 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
create mode 100644 gdb/unittests/enum-flags-selftests.c
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 01/10] Rewrite valid-expr.h's internals in terms of the detection idiom (C++17/N4502)
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 02/10] Use type_instance_flags more throughout Andrew Burgess
` (9 subsequent siblings)
10 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
From: Pedro Alves <pedro@palves.net>
An earlier attempt at doing this had failed (wouldn't work in GCCs
around 4.8, IIRC), but now that I try again, it works. I suspect that
my previous attempt did not use the pre C++14-safe void_t (in
traits.h).
I want to switch to this model because:
- It's the standard detection idiom that folks will learn starting
with C++17.
- In the enum_flags unit tests, I have a static_assert that triggers
a warning (resulting in build error), which GCC does not suppress
because the warning is not being triggered in the SFINAE context.
Switching to the detection idiom fixes that. Alternatively,
switching to the C++03-style expression-validity checking with a
varargs overload would allow addressing that, but I think that
would be going backwards idiomatically speaking.
- While this patch shows a net increase of lines of code, the magic
being added to traits.h can be removed in a few years when we start
requiring C++17.
gdbsupport/ChangeLog:
* traits.h (struct nonesuch, struct detector, detected_or)
(detected_or_t, is_detected, detected_t, detected_or)
(detected_or_t, is_detected_exact, is_detected_convertible): New.
* valid-expr.h (CHECK_VALID_EXPR_INT): Use gdb::is_detected_exact.
---
gdbsupport/traits.h | 67 +++++++++++++++++++++++++++++++++++++++++
gdbsupport/valid-expr.h | 20 ++----------
2 files changed, 70 insertions(+), 17 deletions(-)
diff --git a/gdbsupport/traits.h b/gdbsupport/traits.h
index 2a6f00654c7..93b609ac109 100644
--- a/gdbsupport/traits.h
+++ b/gdbsupport/traits.h
@@ -52,6 +52,73 @@ struct make_void { typedef void type; };
template<typename... Ts>
using void_t = typename make_void<Ts...>::type;
+/* Implementation of the detection idiom:
+
+ - http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2015/n4502.pdf
+ - http://en.cppreference.com/w/cpp/experimental/is_detected
+
+*/
+
+struct nonesuch
+{
+ nonesuch () = delete;
+ ~nonesuch () = delete;
+ nonesuch (const nonesuch &) = delete;
+ void operator= (const nonesuch &) = delete;
+};
+
+namespace detection_detail {
+/* Implementation of the detection idiom (negative case). */
+template<typename Default, typename AlwaysVoid,
+ template<typename...> class Op, typename... Args>
+struct detector
+{
+ using value_t = std::false_type;
+ using type = Default;
+};
+
+/* Implementation of the detection idiom (positive case). */
+template<typename Default, template<typename...> class Op, typename... Args>
+struct detector<Default, void_t<Op<Args...>>, Op, Args...>
+{
+ using value_t = std::true_type;
+ using type = Op<Args...>;
+};
+
+/* Detect whether Op<Args...> is a valid type, use Default if not. */
+template<typename Default, template<typename...> class Op,
+ typename... Args>
+using detected_or = detector<Default, void, Op, Args...>;
+
+/* Op<Args...> if that is a valid type, otherwise Default. */
+template<typename Default, template<typename...> class Op,
+ typename... Args>
+using detected_or_t
+ = typename detected_or<Default, Op, Args...>::type;
+
+} /* detection_detail */
+
+template<template<typename...> class Op, typename... Args>
+using is_detected
+ = typename detection_detail::detector<nonesuch, void, Op, Args...>::value_t;
+
+template<template<typename...> class Op, typename... Args>
+using detected_t
+ = typename detection_detail::detector<nonesuch, void, Op, Args...>::type;
+
+template<typename Default, template<typename...> class Op, typename... Args>
+using detected_or = detection_detail::detected_or<Default, Op, Args...>;
+
+template<typename Default, template<typename...> class Op, typename... Args>
+using detected_or_t = typename detected_or<Default, Op, Args...>::type;
+
+template<typename Expected, template<typename...> class Op, typename... Args>
+using is_detected_exact = std::is_same<Expected, detected_t<Op, Args...>>;
+
+template<typename To, template<typename...> class Op, typename... Args>
+using is_detected_convertible
+ = std::is_convertible<detected_t<Op, Args...>, To>;
+
/* A few trait helpers, mainly stolen from libstdc++. Uppercase
because "and/or", etc. are reserved keywords. */
diff --git a/gdbsupport/valid-expr.h b/gdbsupport/valid-expr.h
index b1c84468147..a22fa61134f 100644
--- a/gdbsupport/valid-expr.h
+++ b/gdbsupport/valid-expr.h
@@ -58,26 +58,12 @@
#define CHECK_VALID_EXPR_INT(TYPENAMES, TYPES, VALID, EXPR_TYPE, EXPR) \
namespace CONCAT (check_valid_expr, __LINE__) { \
\
- template<typename, typename, typename = void> \
- struct is_valid_expression \
- : std::false_type {}; \
- \
template <TYPENAMES> \
- struct is_valid_expression<TYPES, gdb::void_t<decltype (EXPR)>> \
- : std::true_type {}; \
+ using archetype = decltype (EXPR); \
\
- static_assert (is_valid_expression<TYPES>::value == VALID, \
+ static_assert (gdb::is_detected_exact<EXPR_TYPE, \
+ archetype, TYPES>::value == VALID, \
""); \
- \
- template<TYPENAMES, typename = void> \
- struct is_same_type \
- : std::is_same<EXPR_TYPE, void> {}; \
- \
- template <TYPENAMES> \
- struct is_same_type<TYPES, gdb::void_t<decltype (EXPR)>> \
- : std::is_same<EXPR_TYPE, decltype (EXPR)> {}; \
- \
- static_assert (is_same_type<TYPES>::value, ""); \
} /* namespace */
/* A few convenience macros that support expressions involving a
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 02/10] Use type_instance_flags more throughout
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 01/10] Rewrite valid-expr.h's internals in terms of the detection idiom (C++17/N4502) Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 03/10] Rewrite enum_flags, add unit tests, fix problems Andrew Burgess
` (8 subsequent siblings)
10 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
From: Pedro Alves <pedro@palves.net>
The next patch in this series will rewrites enum_flags fixing some API
holes. That would cause build failures around code using
type_instance_flags. Or rather, that should be using it, but wasn't.
This patch fixes it by using type_instance_flags throughout instead of
plain integers.
Note that we can't make the seemingly obvious change to struct
type::instance_flags:
- unsigned instance_flags : 9;
+ ENUM_BITFIELD (type_instance_flag_value) instance_flags : 9;
Because G++ complains then that 9 bits isn't sufficient for holding
all values of type_instance_flag_value.
So the patch adds a cast to TYPE_INSTANCE_FLAGS, and adds a separate
SET_TYPE_INSTANCE_FLAGS macro.
gdb/ChangeLog:
* dwarf2/read.c (read_tag_pointer_type): Use type_instance_flags.
* eval.c (fake_method::fake_method): Use SET_TYPE_INSTANCE_FLAGS.
* gdbarch.h, gdbarch.c: Regenerate.
* gdbarch.sh (address_class_type_flags): Use type_instance_flags.
(address_class_name_to_type_flags): Use type_instance_flags and
bool.
* gdbtypes.c (address_space_name_to_int)
(address_space_int_to_name, make_qualified_type): Use
type_instance_flags.
(make_qualified_type): Use type_instance_flags and
SET_TYPE_INSTANCE_FLAGS.
(make_type_with_address_space, make_cv_type, make_vector_type)
(check_typedef): Use type_instance_flags.
(recursive_dump_type): Cast type_instance_flags to unsigned for
printing.
(copy_type_recursive): Use SET_TYPE_INSTANCE_FLAGS.
* gdbtypes.h (TYPE_INSTANCE_FLAGS): Return a type_instance_flags.
(SET_TYPE_INSTANCE_FLAGS): New.
(address_space_name_to_int, address_space_int_to_name)
(make_type_with_address_space): Pass flags using
type_instance_flags instead of int.
* stabsread.c (cleanup_undefined_types_noname): Use
SET_TYPE_INSTANCE_FLAGS.
* type-stack.c (type_stack::follow_types): Use type_instance_flags.
---
gdb/dwarf2/read.c | 7 +++---
gdb/eval.c | 2 +-
gdb/gdbarch.c | 6 ++---
gdb/gdbarch.h | 12 +++++-----
gdb/gdbarch.sh | 8 +++----
gdb/gdbtypes.c | 58 ++++++++++++++++++++++++++---------------------
gdb/gdbtypes.h | 15 ++++++++----
gdb/stabsread.c | 2 +-
gdb/type-stack.c | 4 ++--
9 files changed, 62 insertions(+), 52 deletions(-)
diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
index 0ac8533263a..4ced5ac02bf 100644
--- a/gdb/dwarf2/read.c
+++ b/gdb/dwarf2/read.c
@@ -17292,10 +17292,9 @@ read_tag_pointer_type (struct die_info *die, struct dwarf2_cu *cu)
{
if (gdbarch_address_class_type_flags_p (gdbarch))
{
- int type_flags;
-
- type_flags = gdbarch_address_class_type_flags
- (gdbarch, byte_size, addr_class);
+ type_instance_flags type_flags
+ = gdbarch_address_class_type_flags (gdbarch, byte_size,
+ addr_class);
gdb_assert ((type_flags & ~TYPE_INSTANCE_FLAG_ADDRESS_CLASS_ALL)
== 0);
type = make_type_with_address_space (type, type_flags);
diff --git a/gdb/eval.c b/gdb/eval.c
index c62c35f3183..cd300ddfef6 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -659,7 +659,7 @@ fake_method::fake_method (type_instance_flags flags,
TYPE_LENGTH (type) = 1;
type->set_code (TYPE_CODE_METHOD);
TYPE_CHAIN (type) = type;
- TYPE_INSTANCE_FLAGS (type) = flags;
+ SET_TYPE_INSTANCE_FLAGS (type, flags);
if (num_types > 0)
{
if (param_types[num_types - 1] == NULL)
diff --git a/gdb/gdbarch.c b/gdb/gdbarch.c
index f8fe03ca682..2be959ecfc9 100644
--- a/gdb/gdbarch.c
+++ b/gdb/gdbarch.c
@@ -3501,7 +3501,7 @@ gdbarch_address_class_type_flags_p (struct gdbarch *gdbarch)
return gdbarch->address_class_type_flags != NULL;
}
-int
+type_instance_flags
gdbarch_address_class_type_flags (struct gdbarch *gdbarch, int byte_size, int dwarf2_addr_class)
{
gdb_assert (gdbarch != NULL);
@@ -3566,8 +3566,8 @@ gdbarch_address_class_name_to_type_flags_p (struct gdbarch *gdbarch)
return gdbarch->address_class_name_to_type_flags != NULL;
}
-int
-gdbarch_address_class_name_to_type_flags (struct gdbarch *gdbarch, const char *name, int *type_flags_ptr)
+bool
+gdbarch_address_class_name_to_type_flags (struct gdbarch *gdbarch, const char *name, type_instance_flags *type_flags_ptr)
{
gdb_assert (gdbarch != NULL);
gdb_assert (gdbarch->address_class_name_to_type_flags != NULL);
diff --git a/gdb/gdbarch.h b/gdb/gdbarch.h
index 7a3060e628d..8a4a384fda9 100644
--- a/gdb/gdbarch.h
+++ b/gdb/gdbarch.h
@@ -848,8 +848,8 @@ extern void set_gdbarch_have_nonsteppable_watchpoint (struct gdbarch *gdbarch, i
extern int gdbarch_address_class_type_flags_p (struct gdbarch *gdbarch);
-typedef int (gdbarch_address_class_type_flags_ftype) (int byte_size, int dwarf2_addr_class);
-extern int gdbarch_address_class_type_flags (struct gdbarch *gdbarch, int byte_size, int dwarf2_addr_class);
+typedef type_instance_flags (gdbarch_address_class_type_flags_ftype) (int byte_size, int dwarf2_addr_class);
+extern type_instance_flags gdbarch_address_class_type_flags (struct gdbarch *gdbarch, int byte_size, int dwarf2_addr_class);
extern void set_gdbarch_address_class_type_flags (struct gdbarch *gdbarch, gdbarch_address_class_type_flags_ftype *address_class_type_flags);
extern int gdbarch_address_class_type_flags_to_name_p (struct gdbarch *gdbarch);
@@ -866,13 +866,13 @@ extern bool gdbarch_execute_dwarf_cfa_vendor_op (struct gdbarch *gdbarch, gdb_by
extern void set_gdbarch_execute_dwarf_cfa_vendor_op (struct gdbarch *gdbarch, gdbarch_execute_dwarf_cfa_vendor_op_ftype *execute_dwarf_cfa_vendor_op);
/* Return the appropriate type_flags for the supplied address class.
- This function should return 1 if the address class was recognized and
- type_flags was set, zero otherwise. */
+ This function should return true if the address class was recognized and
+ type_flags was set, false otherwise. */
extern int gdbarch_address_class_name_to_type_flags_p (struct gdbarch *gdbarch);
-typedef int (gdbarch_address_class_name_to_type_flags_ftype) (struct gdbarch *gdbarch, const char *name, int *type_flags_ptr);
-extern int gdbarch_address_class_name_to_type_flags (struct gdbarch *gdbarch, const char *name, int *type_flags_ptr);
+typedef bool (gdbarch_address_class_name_to_type_flags_ftype) (struct gdbarch *gdbarch, const char *name, type_instance_flags *type_flags_ptr);
+extern bool gdbarch_address_class_name_to_type_flags (struct gdbarch *gdbarch, const char *name, type_instance_flags *type_flags_ptr);
extern void set_gdbarch_address_class_name_to_type_flags (struct gdbarch *gdbarch, gdbarch_address_class_name_to_type_flags_ftype *address_class_name_to_type_flags);
/* Is a register in a group */
diff --git a/gdb/gdbarch.sh b/gdb/gdbarch.sh
index 6d3c5c889d6..7e9204119bd 100755
--- a/gdb/gdbarch.sh
+++ b/gdb/gdbarch.sh
@@ -689,16 +689,16 @@ v;int;cannot_step_breakpoint;;;0;0;;0
# See comment in target.h about continuable, steppable and
# non-steppable watchpoints.
v;int;have_nonsteppable_watchpoint;;;0;0;;0
-F;int;address_class_type_flags;int byte_size, int dwarf2_addr_class;byte_size, dwarf2_addr_class
+F;type_instance_flags;address_class_type_flags;int byte_size, int dwarf2_addr_class;byte_size, dwarf2_addr_class
M;const char *;address_class_type_flags_to_name;int type_flags;type_flags
# Execute vendor-specific DWARF Call Frame Instruction. OP is the instruction.
# FS are passed from the generic execute_cfa_program function.
m;bool;execute_dwarf_cfa_vendor_op;gdb_byte op, struct dwarf2_frame_state *fs;op, fs;;default_execute_dwarf_cfa_vendor_op;;0
# Return the appropriate type_flags for the supplied address class.
-# This function should return 1 if the address class was recognized and
-# type_flags was set, zero otherwise.
-M;int;address_class_name_to_type_flags;const char *name, int *type_flags_ptr;name, type_flags_ptr
+# This function should return true if the address class was recognized and
+# type_flags was set, false otherwise.
+M;bool;address_class_name_to_type_flags;const char *name, type_instance_flags *type_flags_ptr;name, type_flags_ptr
# Is a register in a group
m;int;register_reggroup_p;int regnum, struct reggroup *reggroup;regnum, reggroup;;default_register_reggroup_p;;0
# Fetch the pointer to the ith function argument.
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index c1eb03d8984..64e44bfe23d 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -574,11 +574,11 @@ lookup_function_type_with_arguments (struct type *type,
/* Identify address space identifier by name --
return the integer flag defined in gdbtypes.h. */
-int
+type_instance_flags
address_space_name_to_int (struct gdbarch *gdbarch,
const char *space_identifier)
{
- int type_flags;
+ type_instance_flags type_flags;
/* Check for known address space delimiters. */
if (!strcmp (space_identifier, "code"))
@@ -598,7 +598,8 @@ address_space_name_to_int (struct gdbarch *gdbarch,
gdbtypes.h -- return the string version of the adress space name. */
const char *
-address_space_int_to_name (struct gdbarch *gdbarch, int space_flag)
+address_space_int_to_name (struct gdbarch *gdbarch,
+ type_instance_flags space_flag)
{
if (space_flag & TYPE_INSTANCE_FLAG_CODE_SPACE)
return "code";
@@ -617,7 +618,7 @@ address_space_int_to_name (struct gdbarch *gdbarch, int space_flag)
STORAGE must be in the same obstack as TYPE. */
static struct type *
-make_qualified_type (struct type *type, int new_flags,
+make_qualified_type (struct type *type, type_instance_flags new_flags,
struct type *storage)
{
struct type *ntype;
@@ -657,7 +658,7 @@ make_qualified_type (struct type *type, int new_flags,
TYPE_CHAIN (type) = ntype;
/* Now set the instance flags and return the new type. */
- TYPE_INSTANCE_FLAGS (ntype) = new_flags;
+ SET_TYPE_INSTANCE_FLAGS (ntype, new_flags);
/* Set length of new type to that of the original type. */
TYPE_LENGTH (ntype) = TYPE_LENGTH (type);
@@ -675,13 +676,14 @@ make_qualified_type (struct type *type, int new_flags,
representations. */
struct type *
-make_type_with_address_space (struct type *type, int space_flag)
+make_type_with_address_space (struct type *type,
+ type_instance_flags space_flag)
{
- int new_flags = ((TYPE_INSTANCE_FLAGS (type)
- & ~(TYPE_INSTANCE_FLAG_CODE_SPACE
- | TYPE_INSTANCE_FLAG_DATA_SPACE
- | TYPE_INSTANCE_FLAG_ADDRESS_CLASS_ALL))
- | space_flag);
+ type_instance_flags new_flags = ((TYPE_INSTANCE_FLAGS (type)
+ & ~(TYPE_INSTANCE_FLAG_CODE_SPACE
+ | TYPE_INSTANCE_FLAG_DATA_SPACE
+ | TYPE_INSTANCE_FLAG_ADDRESS_CLASS_ALL))
+ | space_flag);
return make_qualified_type (type, new_flags, NULL);
}
@@ -705,9 +707,9 @@ make_cv_type (int cnst, int voltl,
{
struct type *ntype; /* New type */
- int new_flags = (TYPE_INSTANCE_FLAGS (type)
- & ~(TYPE_INSTANCE_FLAG_CONST
- | TYPE_INSTANCE_FLAG_VOLATILE));
+ type_instance_flags new_flags = (TYPE_INSTANCE_FLAGS (type)
+ & ~(TYPE_INSTANCE_FLAG_CONST
+ | TYPE_INSTANCE_FLAG_VOLATILE));
if (cnst)
new_flags |= TYPE_INSTANCE_FLAG_CONST;
@@ -1410,7 +1412,6 @@ void
make_vector_type (struct type *array_type)
{
struct type *inner_array, *elt_type;
- int flags;
/* Find the innermost array type, in case the array is
multi-dimensional. */
@@ -1421,7 +1422,8 @@ make_vector_type (struct type *array_type)
elt_type = TYPE_TARGET_TYPE (inner_array);
if (elt_type->code () == TYPE_CODE_INT)
{
- flags = TYPE_INSTANCE_FLAGS (elt_type) | TYPE_INSTANCE_FLAG_NOTTEXT;
+ type_instance_flags flags
+ = TYPE_INSTANCE_FLAGS (elt_type) | TYPE_INSTANCE_FLAG_NOTTEXT;
elt_type = make_qualified_type (elt_type, flags, NULL);
TYPE_TARGET_TYPE (inner_array) = elt_type;
}
@@ -2732,12 +2734,13 @@ struct type *
check_typedef (struct type *type)
{
struct type *orig_type = type;
- /* While we're removing typedefs, we don't want to lose qualifiers.
- E.g., const/volatile. */
- int instance_flags = TYPE_INSTANCE_FLAGS (type);
gdb_assert (type);
+ /* While we're removing typedefs, we don't want to lose qualifiers.
+ E.g., const/volatile. */
+ type_instance_flags instance_flags = TYPE_INSTANCE_FLAGS (type);
+
while (type->code () == TYPE_CODE_TYPEDEF)
{
if (!TYPE_TARGET_TYPE (type))
@@ -2778,10 +2781,13 @@ check_typedef (struct type *type)
outer cast in a chain of casting win), instead of assuming
"it can't happen". */
{
- const int ALL_SPACES = (TYPE_INSTANCE_FLAG_CODE_SPACE
- | TYPE_INSTANCE_FLAG_DATA_SPACE);
- const int ALL_CLASSES = TYPE_INSTANCE_FLAG_ADDRESS_CLASS_ALL;
- int new_instance_flags = TYPE_INSTANCE_FLAGS (type);
+ const type_instance_flags ALL_SPACES
+ = (TYPE_INSTANCE_FLAG_CODE_SPACE
+ | TYPE_INSTANCE_FLAG_DATA_SPACE);
+ const type_instance_flags ALL_CLASSES
+ = TYPE_INSTANCE_FLAG_ADDRESS_CLASS_ALL;
+ type_instance_flags new_instance_flags
+ = TYPE_INSTANCE_FLAGS (type);
/* Treat code vs data spaces and address classes separately. */
if ((instance_flags & ALL_SPACES) != 0)
@@ -5026,7 +5032,7 @@ recursive_dump_type (struct type *type, int spaces)
gdb_print_host_address (TYPE_CHAIN (type), gdb_stdout);
printf_filtered ("\n");
printfi_filtered (spaces, "instance_flags 0x%x",
- TYPE_INSTANCE_FLAGS (type));
+ (unsigned) TYPE_INSTANCE_FLAGS (type));
if (TYPE_CONST (type))
{
puts_filtered (" TYPE_CONST");
@@ -5300,7 +5306,7 @@ copy_type_recursive (struct objfile *objfile,
if (type->name ())
new_type->set_name (xstrdup (type->name ()));
- TYPE_INSTANCE_FLAGS (new_type) = TYPE_INSTANCE_FLAGS (type);
+ SET_TYPE_INSTANCE_FLAGS (new_type, TYPE_INSTANCE_FLAGS (type));
TYPE_LENGTH (new_type) = TYPE_LENGTH (type);
/* Copy the fields. */
@@ -5427,7 +5433,7 @@ copy_type (const struct type *type)
gdb_assert (TYPE_OBJFILE_OWNED (type));
new_type = alloc_type_copy (type);
- TYPE_INSTANCE_FLAGS (new_type) = TYPE_INSTANCE_FLAGS (type);
+ SET_TYPE_INSTANCE_FLAGS (new_type, TYPE_INSTANCE_FLAGS (type));
TYPE_LENGTH (new_type) = TYPE_LENGTH (type);
memcpy (TYPE_MAIN_TYPE (new_type), TYPE_MAIN_TYPE (type),
sizeof (struct main_type));
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 55a6dafb7e2..b42cef61371 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -1585,7 +1585,10 @@ extern void allocate_gnat_aux_type (struct type *);
TYPE_ZALLOC (type, \
sizeof (*TYPE_MAIN_TYPE (type)->type_specific.func_stuff)))
-#define TYPE_INSTANCE_FLAGS(thistype) (thistype)->instance_flags
+#define TYPE_INSTANCE_FLAGS(thistype) \
+ type_instance_flags ((enum type_instance_flag_value) (thistype)->instance_flags)
+#define SET_TYPE_INSTANCE_FLAGS(thistype, flags) \
+ (thistype)->instance_flags = flags
#define TYPE_MAIN_TYPE(thistype) (thistype)->main_type
#define TYPE_TARGET_TYPE(thistype) TYPE_MAIN_TYPE(thistype)->target_type
#define TYPE_POINTER_TYPE(thistype) (thistype)->pointer_type
@@ -2117,12 +2120,14 @@ extern struct type *make_atomic_type (struct type *);
extern void replace_type (struct type *, struct type *);
-extern int address_space_name_to_int (struct gdbarch *, const char *);
+extern type_instance_flags address_space_name_to_int (struct gdbarch *,
+ const char *);
-extern const char *address_space_int_to_name (struct gdbarch *, int);
+extern const char *address_space_int_to_name (struct gdbarch *,
+ type_instance_flags);
-extern struct type *make_type_with_address_space (struct type *type,
- int space_identifier);
+extern struct type *make_type_with_address_space
+ (struct type *type, type_instance_flags space_identifier);
extern struct type *lookup_memberptr_type (struct type *, struct type *);
diff --git a/gdb/stabsread.c b/gdb/stabsread.c
index d2ff54a47bd..ed31dc01112 100644
--- a/gdb/stabsread.c
+++ b/gdb/stabsread.c
@@ -4397,7 +4397,7 @@ cleanup_undefined_types_noname (struct objfile *objfile)
and needs to be copied over from the reference type.
Since replace_type expects them to be identical, we need
to set these flags manually before hand. */
- TYPE_INSTANCE_FLAGS (nat.type) = TYPE_INSTANCE_FLAGS (*type);
+ SET_TYPE_INSTANCE_FLAGS (nat.type, TYPE_INSTANCE_FLAGS (*type));
replace_type (nat.type, *type);
}
}
diff --git a/gdb/type-stack.c b/gdb/type-stack.c
index f8661d75653..608142c8494 100644
--- a/gdb/type-stack.c
+++ b/gdb/type-stack.c
@@ -109,7 +109,7 @@ type_stack::follow_types (struct type *follow_type)
int done = 0;
int make_const = 0;
int make_volatile = 0;
- int make_addr_space = 0;
+ type_instance_flags make_addr_space = 0;
bool make_restrict = false;
bool make_atomic = false;
int array_size;
@@ -128,7 +128,7 @@ type_stack::follow_types (struct type *follow_type)
make_volatile = 1;
break;
case tp_space_identifier:
- make_addr_space = pop_int ();
+ make_addr_space = (enum type_instance_flag_value) pop_int ();
break;
case tp_atomic:
make_atomic = true;
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 03/10] Rewrite enum_flags, add unit tests, fix problems
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 01/10] Rewrite valid-expr.h's internals in terms of the detection idiom (C++17/N4502) Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 02/10] Use type_instance_flags more throughout Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 04/10] gdb: additional changes to make use of type_instance_flags more Andrew Burgess
` (7 subsequent siblings)
10 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
From: Pedro Alves <pedro@palves.net>
This patch started by adding comprehensive unit tests for enum_flags.
For the testing part, it adds:
- tests of normal expected uses of the API.
- checks that _invalid_ uses of the API would fail to compile. I.e.,
it validates that enum_flags really is a strong type, and that
incorrect mixing of enum types would be caught at compile time. It
pulls that off making use of SFINEA and C++11's decltype/constexpr.
This revealed many holes in the enum_flags API. For example, the f1
assignment below currently incorrectly fails to compile:
enum_flags<flags> f1 = FLAG1;
enum_flags<flags> f2 = FLAG2 | f1;
The unit tests also revealed that this useful use case doesn't work:
enum flag { FLAG1 = 1, FLAG2 = 2 };
enum_flags<flag> src = FLAG1;
enum_flags<flag> f1 = condition ? src : FLAG2;
It fails to compile because enum_flags<flag> and flag are convertible
to each other.
Turns out that making enum_flags be implicitly convertible to the
backing raw enum type was not a good idea.
If we make it convertible to the underlying type instead, we fix that
ternary operator use case, and, we find cases throughout the codebase
that should be using the enum_flags but were using the raw backing
enum instead. So it's a good change overall.
Also, several operators were missing.
These holes and more are plugged by this patch, by reworking how the
enum_flags operators are implemented, and making use of C++11's
feature of being able to delete methods/functions.
There are cases in gdb/compile/ where we need to call a function in a
C plugin API that expects the raw enum. To address cases like that,
this adds a "raw()" method to enum_flags. This way we can keep using
the safer enum_flags to construct the value, and then be explicit when
we need to get at the raw enum.
This makes most of the enum_flags operators constexpr. Beyond
enabling more compiler optimizations and enabling the new unit tests,
this has other advantages, like making it possible to use operator|
with enum_flags values in switch cases, where only compile-time
constants are allowed:
enum_flags<flags> f = FLAG1 | FLAG2;
switch (f)
{
case FLAG1 | FLAG2:
break;
}
Currently that fails to compile.
It also switches to a different mechanism of enabling the global
operators. The current mechanism isn't namespace friendly, the new
one is.
It also switches to C++11-style SFINAE -- instead of wrapping the
return type in a SFINAE-friently structure, we use an unnamed template
parameter. I.e., this:
template <typename enum_type,
typename = is_enum_flags_enum_type_t<enum_type>>
enum_type
operator& (enum_type e1, enum_type e2)
instead of:
template <typename enum_type>
typename enum_flags_type<enum_type>::type
operator& (enum_type e1, enum_type e2)
Note that the static_assert inside operator~() was converted to a
couple overloads (signed vs unsigned), because static_assert is too
late for SFINAE-based tests, which is important for the CHECK_VALID
unit tests.
Tested with gcc {4.8, 7.1, 9.3} and clang {5.0.2, 10.0.0}.
gdb/ChangeLog:
* Makefile.in (SELFTESTS_SRCS): Add
unittests/enum-flags-selftests.c.
* btrace.c (ftrace_update_caller, ftrace_fixup_calle): Use
btrace_function_flags instead of enum btrace_function_flag.
* compile/compile-c-types.c (convert_qualified): Use
enum_flags::raw.
* compile/compile-cplus-symbols.c (convert_one_symbol)
(convert_symbol_bmsym):
* compile/compile-cplus-types.c (compile_cplus_convert_method)
(compile_cplus_convert_struct_or_union_methods)
(compile_cplus_instance::convert_qualified_base):
* go-exp.y (parse_string_or_char): Add cast to int.
* unittests/enum-flags-selftests.c: New file.
* record-btrace.c (btrace_thread_flag_to_str): Change parameter's
type to btrace_thread_flags from btrace_thread_flag.
(record_btrace_cancel_resume, record_btrace_step_thread): Change
local's type to btrace_thread_flags from btrace_thread_flag. Add
cast in DEBUG call.
gdbsupport/ChangeLog:
* common/enum-flags.h: Include "traits.h".
(DEF_ENUM_FLAGS_TYPE): Declare a function instead of defining a
structure.
(enum_underlying_type): Update comment.
(namespace enum_flags_detail): New. Move struct zero_type here.
(EnumIsUnsigned, EnumIsSigned): New.
(class enum_flags): Make most methods constexpr.
(operator&=, operator|=, operator^=): Take an enum_flags instead
of an enum_type.
(operator enum_type()): Delete.
(operator&, operator|, operator^, operator~): Delete, moved out of
class.
(raw()): New method.
(is_enum_flags_enum_type_t): Declare.
(ENUM_FLAGS_GEN_BINOP, ENUM_FLAGS_GEN_COMPOUND_ASSIGN)
(ENUM_FLAGS_GEN_COMP): New. Use them to reimplement global
operators.
(operator~): Now constexpr and reimplemented.
(operator<<, operator>>): New deleted functions.
* valid-expr.h (CHECK_VALID_EXPR_5, CHECK_VALID_EXPR_6): New.
---
gdb/Makefile.in | 1 +
gdb/btrace.c | 4 +-
gdb/compile/compile-c-types.c | 3 +-
gdb/compile/compile-cplus-symbols.c | 4 +-
gdb/compile/compile-cplus-types.c | 10 +-
gdb/go-exp.y | 2 +-
gdb/record-btrace.c | 10 +-
gdb/unittests/enum-flags-selftests.c | 586 +++++++++++++++++++++++++++
gdbsupport/enum-flags.h | 366 +++++++++++++----
gdbsupport/valid-expr.h | 15 +
10 files changed, 903 insertions(+), 98 deletions(-)
create mode 100644 gdb/unittests/enum-flags-selftests.c
diff --git a/gdb/Makefile.in b/gdb/Makefile.in
index 4808357e651..dbede7a9cfc 100644
--- a/gdb/Makefile.in
+++ b/gdb/Makefile.in
@@ -435,6 +435,7 @@ SELFTESTS_SRCS = \
unittests/command-def-selftests.c \
unittests/common-utils-selftests.c \
unittests/copy_bitwise-selftests.c \
+ unittests/enum-flags-selftests.c \
unittests/environ-selftests.c \
unittests/filtered_iterator-selftests.c \
unittests/format_pieces-selftests.c \
diff --git a/gdb/btrace.c b/gdb/btrace.c
index 2a0c61de766..9022aedd1c8 100644
--- a/gdb/btrace.c
+++ b/gdb/btrace.c
@@ -265,7 +265,7 @@ ftrace_new_function (struct btrace_thread_info *btinfo,
static void
ftrace_update_caller (struct btrace_function *bfun,
struct btrace_function *caller,
- enum btrace_function_flag flags)
+ btrace_function_flags flags)
{
if (bfun->up != 0)
ftrace_debug (bfun, "updating caller");
@@ -283,7 +283,7 @@ static void
ftrace_fixup_caller (struct btrace_thread_info *btinfo,
struct btrace_function *bfun,
struct btrace_function *caller,
- enum btrace_function_flag flags)
+ btrace_function_flags flags)
{
unsigned int prev, next;
diff --git a/gdb/compile/compile-c-types.c b/gdb/compile/compile-c-types.c
index 2b25783bb00..0234db59ea9 100644
--- a/gdb/compile/compile-c-types.c
+++ b/gdb/compile/compile-c-types.c
@@ -254,7 +254,8 @@ convert_qualified (compile_c_instance *context, struct type *type)
if (TYPE_RESTRICT (type))
quals |= GCC_QUALIFIER_RESTRICT;
- return context->plugin ().build_qualified_type (unqual_converted, quals);
+ return context->plugin ().build_qualified_type (unqual_converted,
+ quals.raw ());
}
/* Convert a complex type to its gcc representation. */
diff --git a/gdb/compile/compile-cplus-symbols.c b/gdb/compile/compile-cplus-symbols.c
index 11a2d323458..9840485039a 100644
--- a/gdb/compile/compile-cplus-symbols.c
+++ b/gdb/compile/compile-cplus-symbols.c
@@ -208,7 +208,7 @@ convert_one_symbol (compile_cplus_instance *instance,
/* Define the decl. */
instance->plugin ().build_decl
- ("variable", name.c_str (), kind, sym_type,
+ ("variable", name.c_str (), kind.raw (), sym_type,
symbol_name.get (), addr, filename, line);
/* Pop scope for non-local symbols. */
@@ -323,7 +323,7 @@ convert_symbol_bmsym (compile_cplus_instance *instance,
sym_type = instance->convert_type (type);
instance->plugin ().push_namespace ("");
instance->plugin ().build_decl
- ("minsym", msym->natural_name (), kind, sym_type, nullptr, addr,
+ ("minsym", msym->natural_name (), kind.raw (), sym_type, nullptr, addr,
nullptr, 0);
instance->plugin ().pop_binding_level ("");
}
diff --git a/gdb/compile/compile-cplus-types.c b/gdb/compile/compile-cplus-types.c
index 02df7ab90e6..022cc889794 100644
--- a/gdb/compile/compile-cplus-types.c
+++ b/gdb/compile/compile-cplus-types.c
@@ -668,7 +668,7 @@ compile_cplus_convert_method (compile_cplus_instance *instance,
type and corresponding qualifier flags. */
gcc_type func_type = compile_cplus_convert_func (instance, method_type, true);
gcc_type class_type = instance->convert_type (parent_type);
- gcc_cp_qualifiers_flags quals = (enum gcc_cp_qualifiers) 0;
+ gcc_cp_qualifiers_flags quals = 0;
if (TYPE_CONST (method_type))
quals |= GCC_CP_QUALIFIER_CONST;
@@ -681,7 +681,7 @@ compile_cplus_convert_method (compile_cplus_instance *instance,
gcc_cp_ref_qualifiers_flags rquals = GCC_CP_REF_QUAL_NONE;
return instance->plugin ().build_method_type
- (class_type, func_type, quals, rquals);
+ (class_type, func_type, quals.raw (), rquals.raw ());
}
/* Convert a member or method pointer represented by TYPE. */
@@ -745,7 +745,7 @@ compile_cplus_convert_struct_or_union_methods (compile_cplus_instance *instance,
(sym_kind
| get_method_access_flag (type, i, j)
| GCC_CP_FLAG_VIRTUAL_FUNCTION
- | GCC_CP_FLAG_PURE_VIRTUAL_FUNCTION),
+ | GCC_CP_FLAG_PURE_VIRTUAL_FUNCTION).raw (),
method_type, nullptr, 0, nullptr, 0);
continue;
}
@@ -787,7 +787,7 @@ compile_cplus_convert_struct_or_union_methods (compile_cplus_instance *instance,
instance->plugin ().build_decl
(kind, overloaded_name.get (),
- sym_kind | get_method_access_flag (type, i, j),
+ (sym_kind | get_method_access_flag (type, i, j)).raw (),
method_type, nullptr, address, filename, line);
}
}
@@ -1060,7 +1060,7 @@ compile_cplus_instance::convert_qualified_base (gcc_type base,
gcc_type result = base;
if (quals != 0)
- result = plugin ().build_qualified_type (base, quals);
+ result = plugin ().build_qualified_type (base, quals.raw ());
return result;
}
diff --git a/gdb/go-exp.y b/gdb/go-exp.y
index 17c76ac02ab..ee1db2b5874 100644
--- a/gdb/go-exp.y
+++ b/gdb/go-exp.y
@@ -924,7 +924,7 @@ parse_string_or_char (const char *tokptr, const char **outptr,
}
++tokptr;
- value->type = C_STRING | (quote == '\'' ? C_CHAR : 0); /*FIXME*/
+ value->type = (int) C_STRING | (quote == '\'' ? C_CHAR : 0); /*FIXME*/
value->ptr = (char *) obstack_base (&tempbuf);
value->length = obstack_object_size (&tempbuf);
diff --git a/gdb/record-btrace.c b/gdb/record-btrace.c
index a1a3efc3d68..fd0d13fb258 100644
--- a/gdb/record-btrace.c
+++ b/gdb/record-btrace.c
@@ -1928,7 +1928,7 @@ record_btrace_target::get_tailcall_unwinder ()
/* Return a human-readable string for FLAG. */
static const char *
-btrace_thread_flag_to_str (enum btrace_thread_flag flag)
+btrace_thread_flag_to_str (btrace_thread_flags flag)
{
switch (flag)
{
@@ -2221,7 +2221,7 @@ record_btrace_target::commit_resume ()
static void
record_btrace_cancel_resume (struct thread_info *tp)
{
- enum btrace_thread_flag flags;
+ btrace_thread_flags flags;
flags = tp->btrace.flags & (BTHR_MOVE | BTHR_STOP);
if (flags == 0)
@@ -2229,7 +2229,7 @@ record_btrace_cancel_resume (struct thread_info *tp)
DEBUG ("cancel resume thread %s (%s): %x (%s)",
print_thread_id (tp),
- target_pid_to_str (tp->ptid).c_str (), flags,
+ target_pid_to_str (tp->ptid).c_str (), flags.raw (),
btrace_thread_flag_to_str (flags));
tp->btrace.flags &= ~(BTHR_MOVE | BTHR_STOP);
@@ -2449,7 +2449,7 @@ record_btrace_step_thread (struct thread_info *tp)
{
struct btrace_thread_info *btinfo;
struct target_waitstatus status;
- enum btrace_thread_flag flags;
+ btrace_thread_flags flags;
btinfo = &tp->btrace;
@@ -2457,7 +2457,7 @@ record_btrace_step_thread (struct thread_info *tp)
btinfo->flags &= ~(BTHR_MOVE | BTHR_STOP);
DEBUG ("stepping thread %s (%s): %x (%s)", print_thread_id (tp),
- target_pid_to_str (tp->ptid).c_str (), flags,
+ target_pid_to_str (tp->ptid).c_str (), flags.raw (),
btrace_thread_flag_to_str (flags));
/* We can't step without an execution history. */
diff --git a/gdb/unittests/enum-flags-selftests.c b/gdb/unittests/enum-flags-selftests.c
new file mode 100644
index 00000000000..17ab5c9b094
--- /dev/null
+++ b/gdb/unittests/enum-flags-selftests.c
@@ -0,0 +1,586 @@
+/* Self tests for enum-flags for GDB, the GNU debugger.
+
+ Copyright (C) 2016-2020 Free Software Foundation, Inc.
+
+ This file is part of GDB.
+
+ 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/>. */
+
+#include "defs.h"
+#include "gdbsupport/enum-flags.h"
+#include "gdbsupport/valid-expr.h"
+#include "gdbsupport/selftest.h"
+
+namespace selftests {
+namespace enum_flags_tests {
+
+/* The (real) enum types used in CHECK_VALID. Their names match the
+ template parameter names of the templates defined by CHECK_VALID to
+ make it simpler to use. They could be named differently. */
+
+/* A "real enum". */
+enum RE
+ {
+ RE_FLAG1 = 1 << 1,
+ RE_FLAG2 = 1 << 2,
+ };
+
+/* Another "real enum". */
+enum RE2
+ {
+ RE2_FLAG1 = 1 << 1,
+ RE2_FLAG2 = 1 << 2,
+ };
+
+/* An unsigned "real enum". */
+enum URE : unsigned
+ {
+ URE_FLAG1 = 1 << 1,
+ URE_FLAG2 = 1 << 2,
+ URE_FLAG3 = 0xffffffff,
+ };
+
+/* A non-flags enum. */
+enum NF
+ {
+ NF_FLAG1 = 1 << 1,
+ NF_FLAG2 = 1 << 2,
+ };
+
+/* The corresponding "enum flags" types. */
+DEF_ENUM_FLAGS_TYPE (RE, EF);
+DEF_ENUM_FLAGS_TYPE (RE2, EF2);
+DEF_ENUM_FLAGS_TYPE (URE, UEF);
+
+#if HAVE_IS_TRIVIALLY_COPYABLE
+
+/* So that std::vectors of types that have enum_flags fields can
+ reallocate efficiently memcpy. */
+gdb_static_assert (std::is_trivially_copyable<EF>::value);
+
+#endif
+
+/* A couple globals used as lvalues in the CHECK_VALID expressions
+ below. Their names (and types) match the uppercase type names
+ exposed by CHECK_VALID just to make the expressions easier to
+ follow. */
+static RE re ATTRIBUTE_UNUSED;
+static EF ef ATTRIBUTE_UNUSED;
+
+/* First, compile-time tests that:
+
+ - make sure that incorrect operations with mismatching enum types
+ are caught at compile time.
+
+ - make sure that the same operations but involving the right enum
+ types do compile and that they return the correct type.
+*/
+
+#define CHECK_VALID(VALID, EXPR_TYPE, EXPR) \
+ CHECK_VALID_EXPR_6 (EF, RE, EF2, RE2, UEF, URE, VALID, EXPR_TYPE, EXPR)
+
+typedef std::underlying_type<RE>::type und;
+
+/* Test construction / conversion from/to different types. */
+
+/* RE/EF -> underlying (explicit) */
+CHECK_VALID (true, und, und (RE ()))
+CHECK_VALID (true, und, und (EF ()))
+
+/* RE/EF -> int (explicit) */
+CHECK_VALID (true, int, int (RE ()))
+CHECK_VALID (true, int, int (EF ()))
+
+/* other -> RE */
+
+/* You can construct a raw enum value from an int explicitly to punch
+ a hole in the type system if need to. */
+CHECK_VALID (true, RE, RE (1))
+CHECK_VALID (true, RE, RE (RE2 ()))
+CHECK_VALID (false, void, RE (EF2 ()))
+CHECK_VALID (true, RE, RE (RE ()))
+CHECK_VALID (false, void, RE (EF ()))
+
+/* other -> EF. */
+
+/* As expected, enum-flags is a stronger type than the backing raw
+ enum. Unlike with raw enums, you can't construct an enum flags
+ from an integer nor from an unrelated enum type explicitly. Add an
+ intermediate conversion via the raw enum if you really need it. */
+CHECK_VALID (false, void, EF (1))
+CHECK_VALID (false, void, EF (1u))
+CHECK_VALID (false, void, EF (RE2 ()))
+CHECK_VALID (false, void, EF (EF2 ()))
+CHECK_VALID (true, EF, EF (RE ()))
+CHECK_VALID (true, EF, EF (EF ()))
+
+/* Test operators. */
+
+/* operator OP (raw_enum, int) */
+
+CHECK_VALID (false, void, RE () | 1)
+CHECK_VALID (false, void, RE () & 1)
+CHECK_VALID (false, void, RE () ^ 1)
+
+/* operator OP (int, raw_enum) */
+
+CHECK_VALID (false, void, 1 | RE ())
+CHECK_VALID (false, void, 1 & RE ())
+CHECK_VALID (false, void, 1 ^ RE ())
+
+/* operator OP (enum_flags, int) */
+
+CHECK_VALID (false, void, EF () | 1)
+CHECK_VALID (false, void, EF () & 1)
+CHECK_VALID (false, void, EF () ^ 1)
+
+/* operator OP (int, enum_flags) */
+
+CHECK_VALID (false, void, 1 | EF ())
+CHECK_VALID (false, void, 1 & EF ())
+CHECK_VALID (false, void, 1 ^ EF ())
+
+/* operator OP (raw_enum, raw_enum) */
+
+CHECK_VALID (false, void, RE () | RE2 ())
+CHECK_VALID (false, void, RE () & RE2 ())
+CHECK_VALID (false, void, RE () ^ RE2 ())
+CHECK_VALID (true, RE, RE () | RE ())
+CHECK_VALID (true, RE, RE () & RE ())
+CHECK_VALID (true, RE, RE () ^ RE ())
+
+/* operator OP (enum_flags, raw_enum) */
+
+CHECK_VALID (false, void, EF () | RE2 ())
+CHECK_VALID (false, void, EF () & RE2 ())
+CHECK_VALID (false, void, EF () ^ RE2 ())
+CHECK_VALID (true, EF, EF () | RE ())
+CHECK_VALID (true, EF, EF () & RE ())
+CHECK_VALID (true, EF, EF () ^ RE ())
+
+/* operator OP= (raw_enum, raw_enum), rvalue ref on the lhs. */
+
+CHECK_VALID (false, void, RE () |= RE2 ())
+CHECK_VALID (false, void, RE () &= RE2 ())
+CHECK_VALID (false, void, RE () ^= RE2 ())
+CHECK_VALID (true, RE&, RE () |= RE ())
+CHECK_VALID (true, RE&, RE () &= RE ())
+CHECK_VALID (true, RE&, RE () ^= RE ())
+
+/* operator OP= (raw_enum, raw_enum), lvalue ref on the lhs. */
+
+CHECK_VALID (false, void, re |= RE2 ())
+CHECK_VALID (false, void, re &= RE2 ())
+CHECK_VALID (false, void, re ^= RE2 ())
+CHECK_VALID (true, RE&, re |= RE ())
+CHECK_VALID (true, RE&, re &= RE ())
+CHECK_VALID (true, RE&, re ^= RE ())
+
+/* operator OP= (enum_flags, raw_enum), rvalue ref on the lhs. */
+
+CHECK_VALID (false, void, EF () |= RE2 ())
+CHECK_VALID (false, void, EF () &= RE2 ())
+CHECK_VALID (false, void, EF () ^= RE2 ())
+CHECK_VALID (true, EF&, EF () |= RE ())
+CHECK_VALID (true, EF&, EF () &= RE ())
+CHECK_VALID (true, EF&, EF () ^= RE ())
+
+/* operator OP= (enum_flags, raw_enum), lvalue ref on the lhs. */
+
+CHECK_VALID (false, void, ef |= RE2 ())
+CHECK_VALID (false, void, ef &= RE2 ())
+CHECK_VALID (false, void, ef ^= RE2 ())
+CHECK_VALID (true, EF&, ef |= EF ())
+CHECK_VALID (true, EF&, ef &= EF ())
+CHECK_VALID (true, EF&, ef ^= EF ())
+
+/* operator OP= (enum_flags, enum_flags), rvalue ref on the lhs. */
+
+CHECK_VALID (false, void, EF () |= EF2 ())
+CHECK_VALID (false, void, EF () &= EF2 ())
+CHECK_VALID (false, void, EF () ^= EF2 ())
+CHECK_VALID (true, EF&, EF () |= EF ())
+CHECK_VALID (true, EF&, EF () &= EF ())
+CHECK_VALID (true, EF&, EF () ^= EF ())
+
+/* operator OP= (enum_flags, enum_flags), lvalue ref on the lhs. */
+
+CHECK_VALID (false, void, ef |= EF2 ())
+CHECK_VALID (false, void, ef &= EF2 ())
+CHECK_VALID (false, void, ef ^= EF2 ())
+CHECK_VALID (true, EF&, ef |= EF ())
+CHECK_VALID (true, EF&, ef &= EF ())
+CHECK_VALID (true, EF&, ef ^= EF ())
+
+/* operator~ (raw_enum) */
+
+CHECK_VALID (false, void, ~RE ())
+CHECK_VALID (true, URE, ~URE ())
+
+/* operator~ (enum_flags) */
+
+CHECK_VALID (false, void, ~EF ())
+CHECK_VALID (true, UEF, ~UEF ())
+
+/* Check ternary operator. This exercises implicit conversions. */
+
+CHECK_VALID (true, EF, true ? EF () : RE ())
+CHECK_VALID (true, EF, true ? RE () : EF ())
+
+/* These are valid, but it's not a big deal since you won't be able to
+ assign the resulting integer to an enum or an enum_flags without a
+ cast.
+
+ The latter two tests are disabled on older GCCs because they
+ incorrectly fail with gcc 4.8 and 4.9 at least. Running the test
+ outside a SFINAE context shows:
+
+ invalid user-defined conversion from ‘EF’ to ‘RE2’
+
+ They've been confirmed to compile/pass with gcc 5.3, gcc 7.1 and
+ clang 3.7. */
+
+CHECK_VALID (true, int, true ? EF () : EF2 ())
+CHECK_VALID (true, int, true ? EF2 () : EF ())
+#if GCC_VERSION >= 5003 || defined __clang__
+CHECK_VALID (true, int, true ? EF () : RE2 ())
+CHECK_VALID (true, int, true ? RE2 () : EF ())
+#endif
+
+/* Same, but with an unsigned enum. */
+
+typedef unsigned int uns;
+
+CHECK_VALID (true, uns, true ? EF () : UEF ())
+CHECK_VALID (true, uns, true ? UEF () : EF ())
+#if GCC_VERSION >= 5003 || defined __clang__
+CHECK_VALID (true, uns, true ? EF () : URE ())
+CHECK_VALID (true, uns, true ? URE () : EF ())
+#endif
+
+/* Unfortunately this can't work due to the way C++ computes the
+ return type of the ternary conditional operator. int isn't
+ implicitly convertible to the raw enum type, so the type of the
+ expression is int. And then int is not implicitly convertible to
+ enum_flags.
+
+ GCC 4.8 fails to compile this test with:
+ error: operands to ?: have different types ‘enum_flags<RE>’ and ‘int’
+ Confirmed to work with gcc 4.9, 5.3 and clang 3.7.
+*/
+#if GCC_VERSION >= 4009 || defined __clang__
+CHECK_VALID (false, void, true ? EF () : 0)
+CHECK_VALID (false, void, true ? 0 : EF ())
+#endif
+
+/* Check that the ++/--/<</>>/<<=/>>= operators are deleted. */
+
+CHECK_VALID (false, void, RE ()++)
+CHECK_VALID (false, void, ++RE ())
+CHECK_VALID (false, void, --RE ())
+CHECK_VALID (false, void, RE ()--)
+
+CHECK_VALID (false, void, RE () << 1)
+CHECK_VALID (false, void, RE () >> 1)
+CHECK_VALID (false, void, EF () << 1)
+CHECK_VALID (false, void, EF () >> 1)
+
+CHECK_VALID (false, void, RE () <<= 1)
+CHECK_VALID (false, void, RE () >>= 1)
+CHECK_VALID (false, void, EF () <<= 1)
+CHECK_VALID (false, void, EF () >>= 1)
+
+/* Test comparison operators. */
+
+CHECK_VALID (false, void, EF () == EF2 ())
+CHECK_VALID (false, void, EF () == RE2 ())
+CHECK_VALID (false, void, RE () == EF2 ())
+
+CHECK_VALID (true, bool, EF (RE (1)) == EF (RE (1)))
+CHECK_VALID (true, bool, EF (RE (1)) == RE (1))
+CHECK_VALID (true, bool, RE (1) == EF (RE (1)))
+
+CHECK_VALID (false, void, EF () != EF2 ())
+CHECK_VALID (false, void, EF () != RE2 ())
+CHECK_VALID (false, void, RE () != EF2 ())
+
+/* On clang, disable -Wenum-compare due to "error: comparison of two
+ values with different enumeration types [-Werror,-Wenum-compare]".
+ clang doesn't suppress -Wenum-compare in SFINAE contexts. Not a
+ big deal since misuses like these in GDB will be caught by -Werror
+ anyway. This check is here mainly for completeness. */
+#if defined __clang__
+# pragma GCC diagnostic push
+# pragma GCC diagnostic ignored "-Wenum-compare"
+#endif
+CHECK_VALID (true, bool, RE () == RE2 ())
+CHECK_VALID (true, bool, RE () != RE2 ())
+#if defined __clang__
+# pragma GCC diagnostic pop
+#endif
+
+CHECK_VALID (true, bool, EF (RE (1)) != EF (RE (2)))
+CHECK_VALID (true, bool, EF (RE (1)) != RE (2))
+CHECK_VALID (true, bool, RE (1) != EF (RE (2)))
+
+CHECK_VALID (true, bool, EF () == 0)
+
+/* Check we didn't disable/delete comparison between non-flags enums
+ and unrelated types by mistake. */
+CHECK_VALID (true, bool, NF (1) == NF (1))
+CHECK_VALID (true, bool, NF (1) == int (1))
+CHECK_VALID (true, bool, NF (1) == char (1))
+
+/* -------------------------------------------------------------------- */
+
+/* Follows misc tests that exercise the API. Some are compile time,
+ when possible, others are run time. */
+
+enum test_flag
+ {
+ FLAG1 = 1 << 1,
+ FLAG2 = 1 << 2,
+ FLAG3 = 1 << 3,
+ };
+
+enum test_uflag : unsigned
+ {
+ UFLAG1 = 1 << 1,
+ UFLAG2 = 1 << 2,
+ UFLAG3 = 1 << 3,
+ };
+
+DEF_ENUM_FLAGS_TYPE (test_flag, test_flags);
+DEF_ENUM_FLAGS_TYPE (test_uflag, test_uflags);
+
+static void
+self_test ()
+{
+ /* Check that default construction works. */
+ {
+ constexpr test_flags f;
+
+ gdb_static_assert (f == 0);
+ }
+
+ /* Check that assignment from zero works. */
+ {
+ test_flags f (FLAG1);
+
+ SELF_CHECK (f == FLAG1);
+
+ f = 0;
+
+ SELF_CHECK (f == 0);
+ }
+
+ /* Check that construction from zero works. */
+ {
+ constexpr test_flags zero1 = 0;
+ constexpr test_flags zero2 (0);
+ constexpr test_flags zero3 {0};
+ constexpr test_flags zero4 = {0};
+
+ gdb_static_assert (zero1 == 0);
+ gdb_static_assert (zero2 == 0);
+ gdb_static_assert (zero3 == 0);
+ gdb_static_assert (zero4 == 0);
+ }
+
+ /* Check construction from enum value. */
+ {
+ gdb_static_assert (test_flags (FLAG1) == FLAG1);
+ gdb_static_assert (test_flags (FLAG2) != FLAG1);
+ }
+
+ /* Check copy/assignment. */
+ {
+ constexpr test_flags src = FLAG1;
+
+ constexpr test_flags f1 = src;
+ constexpr test_flags f2 (src);
+ constexpr test_flags f3 {src};
+ constexpr test_flags f4 = {src};
+
+ gdb_static_assert (f1 == FLAG1);
+ gdb_static_assert (f2 == FLAG1);
+ gdb_static_assert (f3 == FLAG1);
+ gdb_static_assert (f4 == FLAG1);
+ }
+
+ /* Check moving. */
+ {
+ test_flags src = FLAG1;
+ test_flags dst = 0;
+
+ dst = std::move (src);
+ SELF_CHECK (dst == FLAG1);
+ }
+
+ /* Check construction from an 'or' of multiple bits. For this to
+ work, operator| must be overridden to return an enum type. The
+ builtin version would return int instead and then the conversion
+ to test_flags would fail. */
+ {
+ constexpr test_flags f = FLAG1 | FLAG2;
+ gdb_static_assert (f == (FLAG1 | FLAG2));
+ }
+
+ /* Similarly, check that "FLAG1 | FLAG2" on the rhs of an assignment
+ operator works. */
+ {
+ test_flags f = 0;
+ f |= FLAG1 | FLAG2;
+ SELF_CHECK (f == (FLAG1 | FLAG2));
+
+ f &= FLAG1 | FLAG2;
+ SELF_CHECK (f == (FLAG1 | FLAG2));
+
+ f ^= FLAG1 | FLAG2;
+ SELF_CHECK (f == 0);
+ }
+
+ /* Check explicit conversion to int works. */
+ {
+ constexpr int some_bits (FLAG1 | FLAG2);
+
+ /* And comparison with int works too. */
+ gdb_static_assert (some_bits == (FLAG1 | FLAG2));
+ gdb_static_assert (some_bits == test_flags (FLAG1 | FLAG2));
+ }
+
+ /* Check operator| and operator|=. Particularly interesting is
+ making sure that putting the enum value on the lhs side of the
+ expression works (FLAG | f). */
+ {
+ test_flags f = FLAG1;
+ f |= FLAG2;
+ SELF_CHECK (f == (FLAG1 | FLAG2));
+ }
+ {
+ test_flags f = FLAG1;
+ f = f | FLAG2;
+ SELF_CHECK (f == (FLAG1 | FLAG2));
+ }
+ {
+ test_flags f = FLAG1;
+ f = FLAG2 | f;
+ SELF_CHECK (f == (FLAG1 | FLAG2));
+ }
+
+ /* Check the &/&= operators. */
+ {
+ test_flags f = FLAG1 & FLAG2;
+ SELF_CHECK (f == 0);
+
+ f = FLAG1 | FLAG2;
+ f &= FLAG2;
+ SELF_CHECK (f == FLAG2);
+
+ f = FLAG1 | FLAG2;
+ f = f & FLAG2;
+ SELF_CHECK (f == FLAG2);
+
+ f = FLAG1 | FLAG2;
+ f = FLAG2 & f;
+ SELF_CHECK (f == FLAG2);
+ }
+
+ /* Check the ^/^= operators. */
+ {
+ constexpr test_flags f = FLAG1 ^ FLAG2;
+ gdb_static_assert (f == (FLAG1 ^ FLAG2));
+ }
+
+ {
+ test_flags f = FLAG1 ^ FLAG2;
+ f ^= FLAG3;
+ SELF_CHECK (f == (FLAG1 | FLAG2 | FLAG3));
+ f = f ^ FLAG3;
+ SELF_CHECK (f == (FLAG1 | FLAG2));
+ f = FLAG3 ^ f;
+ SELF_CHECK (f == (FLAG1 | FLAG2 | FLAG3));
+ }
+
+ /* Check operator~. Note this only compiles with unsigned
+ flags. */
+ {
+ constexpr test_uflags f1 = ~UFLAG1;
+ constexpr test_uflags f2 = ~f1;
+ gdb_static_assert (f2 == UFLAG1);
+ }
+
+ /* Check the ternary operator. */
+
+ {
+ /* raw enum, raw enum */
+ constexpr test_flags f1 = true ? FLAG1 : FLAG2;
+ gdb_static_assert (f1 == FLAG1);
+ constexpr test_flags f2 = false ? FLAG1 : FLAG2;
+ gdb_static_assert (f2 == FLAG2);
+ }
+
+ {
+ /* enum flags, raw enum */
+ constexpr test_flags src = FLAG1;
+ constexpr test_flags f1 = true ? src : FLAG2;
+ gdb_static_assert (f1 == FLAG1);
+ constexpr test_flags f2 = false ? src : FLAG2;
+ gdb_static_assert (f2 == FLAG2);
+ }
+
+ {
+ /* enum flags, enum flags */
+ constexpr test_flags src1 = FLAG1;
+ constexpr test_flags src2 = FLAG2;
+ constexpr test_flags f1 = true ? src1 : src2;
+ gdb_static_assert (f1 == src1);
+ constexpr test_flags f2 = false ? src1 : src2;
+ gdb_static_assert (f2 == src2);
+ }
+
+ /* Check that we can use flags in switch expressions (requires
+ unambiguous conversion to integer). Also check that we can use
+ operator| in switch cases, where only constants are allowed.
+ This should work because operator| is constexpr. */
+ {
+ test_flags f = FLAG1 | FLAG2;
+ bool ok = false;
+
+ switch (f)
+ {
+ case FLAG1:
+ break;
+ case FLAG2:
+ break;
+ case FLAG1 | FLAG2:
+ ok = true;
+ break;
+ }
+
+ SELF_CHECK (ok);
+ }
+}
+
+} /* namespace enum_flags_tests */
+} /* namespace selftests */
+
+void _initialize_enum_flags_selftests ();
+
+void
+_initialize_enum_flags_selftests ()
+{
+ selftests::register_test ("enum-flags",
+ selftests::enum_flags_tests::self_test);
+}
diff --git a/gdbsupport/enum-flags.h b/gdbsupport/enum-flags.h
index 825ff4faf2c..b3e317ecb97 100644
--- a/gdbsupport/enum-flags.h
+++ b/gdbsupport/enum-flags.h
@@ -18,6 +18,8 @@
#ifndef COMMON_ENUM_FLAGS_H
#define COMMON_ENUM_FLAGS_H
+#include "traits.h"
+
/* Type-safe wrapper for enum flags. enum flags are enums where the
values are bits that are meant to be ORed together.
@@ -51,23 +53,31 @@
#ifdef __cplusplus
-/* Traits type used to prevent the global operator overloads from
- instantiating for non-flag enums. */
-template<typename T> struct enum_flags_type {};
-
-/* Use this to mark an enum as flags enum. It defines FLAGS as
+/* Use this to mark an enum as flags enum. It defines FLAGS_TYPE as
enum_flags wrapper class for ENUM, and enables the global operator
overloads for ENUM. */
#define DEF_ENUM_FLAGS_TYPE(enum_type, flags_type) \
typedef enum_flags<enum_type> flags_type; \
- template<> \
- struct enum_flags_type<enum_type> \
- { \
- typedef enum_flags<enum_type> type; \
- }
+ void is_enum_flags_enum_type (enum_type *)
+
+/* To enable the global enum_flags operators for enum, declare an
+ "is_enum_flags_enum_type" overload that has exactly one parameter,
+ of type a pointer to that enum class. E.g.,:
+
+ void is_enum_flags_enum_type (enum some_flag *);
+
+ The function does not need to be defined, only declared.
+ DEF_ENUM_FLAGS_TYPE declares this.
+
+ A function declaration is preferred over a traits type, because the
+ former allows calling the DEF_ENUM_FLAGS_TYPE macro inside a
+ namespace to define the corresponding enum flags type in that
+ namespace. The compiler finds the corresponding
+ is_enum_flags_enum_type function via ADL. */
-/* Until we can rely on std::underlying type being universally
- available (C++11), roll our own for enums. */
+/* Note that std::underlying_type<enum_type> is not what we want here,
+ since that returns unsigned int even when the enum decays to signed
+ int. */
template<int size, bool sign> class integer_for_size { typedef void type; };
template<> struct integer_for_size<1, 0> { typedef uint8_t type; };
template<> struct integer_for_size<2, 0> { typedef uint16_t type; };
@@ -86,128 +96,320 @@ struct enum_underlying_type
type;
};
-template <typename E>
-class enum_flags
+namespace enum_flags_detail
{
-public:
- typedef E enum_type;
- typedef typename enum_underlying_type<enum_type>::type underlying_type;
-private:
- /* Private type used to support initializing flag types with zero:
+/* Private type used to support initializing flag types with zero:
- foo_flags f = 0;
+ foo_flags f = 0;
- but not other integers:
+ but not other integers:
- foo_flags f = 1;
+ foo_flags f = 1;
- The way this works is that we define an implicit constructor that
- takes a pointer to this private type. Since nothing can
- instantiate an object of this type, the only possible pointer to
- pass to the constructor is the NULL pointer, or, zero. */
- struct zero_type;
+ The way this works is that we define an implicit constructor that
+ takes a pointer to this private type. Since nothing can
+ instantiate an object of this type, the only possible pointer to
+ pass to the constructor is the NULL pointer, or, zero. */
+struct zero_type;
- underlying_type
- underlying_value () const
- {
- return m_enum_value;
- }
+/* gdb::Requires trait helpers. */
+template <typename enum_type>
+using EnumIsUnsigned
+ = std::is_unsigned<typename enum_underlying_type<enum_type>::type>;
+template <typename enum_type>
+using EnumIsSigned
+ = std::is_signed<typename enum_underlying_type<enum_type>::type>;
+
+}
+
+template <typename E>
+class enum_flags
+{
+public:
+ typedef E enum_type;
+ typedef typename enum_underlying_type<enum_type>::type underlying_type;
public:
/* Allow default construction. */
- enum_flags ()
+ constexpr enum_flags ()
: m_enum_value ((enum_type) 0)
{}
+ /* The default move/copy ctor/assignment do the right thing. */
+
/* If you get an error saying these two overloads are ambiguous,
then you tried to mix values of different enum types. */
- enum_flags (enum_type e)
+ constexpr enum_flags (enum_type e)
: m_enum_value (e)
{}
- enum_flags (struct enum_flags::zero_type *zero)
+ constexpr enum_flags (enum_flags_detail::zero_type *zero)
: m_enum_value ((enum_type) 0)
{}
- enum_flags &operator&= (enum_type e)
+ enum_flags &operator&= (enum_flags e)
{
- m_enum_value = (enum_type) (underlying_value () & e);
+ m_enum_value = (enum_type) (m_enum_value & e.m_enum_value);
return *this;
}
- enum_flags &operator|= (enum_type e)
+ enum_flags &operator|= (enum_flags e)
{
- m_enum_value = (enum_type) (underlying_value () | e);
+ m_enum_value = (enum_type) (m_enum_value | e.m_enum_value);
return *this;
}
- enum_flags &operator^= (enum_type e)
+ enum_flags &operator^= (enum_flags e)
{
- m_enum_value = (enum_type) (underlying_value () ^ e);
+ m_enum_value = (enum_type) (m_enum_value ^ e.m_enum_value);
return *this;
}
- operator enum_type () const
+ /* Like raw enums, allow conversion to the underlying type. */
+ constexpr operator underlying_type () const
{
return m_enum_value;
}
- enum_flags operator& (enum_type e) const
- {
- return (enum_type) (underlying_value () & e);
- }
- enum_flags operator| (enum_type e) const
- {
- return (enum_type) (underlying_value () | e);
- }
- enum_flags operator^ (enum_type e) const
- {
- return (enum_type) (underlying_value () ^ e);
- }
- enum_flags operator~ () const
+ /* Get the underlying value as a raw enum. */
+ constexpr enum_type raw () const
{
- // We only the underlying type to be unsigned when actually using
- // operator~ -- if it were not unsigned, undefined behavior could
- // result. However, asserting this in the class itself would
- // require too many unnecessary changes to otherwise ok enum
- // types.
- gdb_static_assert (std::is_unsigned<underlying_type>::value);
- return (enum_type) ~underlying_value ();
+ return m_enum_value;
}
+ /* Binary operations involving some unrelated type (which would be a
+ bug) are implemented as non-members, and deleted. */
+
private:
/* Stored as enum_type because GDB knows to print the bit flags
neatly if the enum values look like bit flags. */
enum_type m_enum_value;
};
+template <typename E>
+using is_enum_flags_enum_type_t
+ = decltype (is_enum_flags_enum_type (std::declval<E *> ()));
+
/* Global operator overloads. */
-template <typename enum_type>
-typename enum_flags_type<enum_type>::type
-operator& (enum_type e1, enum_type e2)
+/* Generate binary operators. */
+
+#define ENUM_FLAGS_GEN_BINOP(OPERATOR_OP, OP) \
+ \
+ /* Raw enum on both LHS/RHS. Returns raw enum type. */ \
+ template <typename enum_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_type \
+ OPERATOR_OP (enum_type e1, enum_type e2) \
+ { \
+ using underlying = typename enum_flags<enum_type>::underlying_type; \
+ return (enum_type) (underlying (e1) OP underlying (e2)); \
+ } \
+ \
+ /* enum_flags on the LHS. */ \
+ template <typename enum_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_flags<enum_type> \
+ OPERATOR_OP (enum_flags<enum_type> e1, enum_type e2) \
+ { return e1.raw () OP e2; } \
+ \
+ /* enum_flags on the RHS. */ \
+ template <typename enum_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_flags<enum_type> \
+ OPERATOR_OP (enum_type e1, enum_flags<enum_type> e2) \
+ { return e1 OP e2.raw (); } \
+ \
+ /* enum_flags on both LHS/RHS. */ \
+ template <typename enum_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_flags<enum_type> \
+ OPERATOR_OP (enum_flags<enum_type> e1, enum_flags<enum_type> e2) \
+ { return e1.raw () OP e2.raw (); } \
+ \
+ /* Delete cases involving unrelated types. */ \
+ \
+ template <typename enum_type, typename unrelated_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_flags<enum_type> \
+ OPERATOR_OP (enum_type e1, unrelated_type e2) = delete; \
+ \
+ template <typename enum_type, typename unrelated_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_flags<enum_type> \
+ OPERATOR_OP (unrelated_type e1, enum_type e2) = delete; \
+ \
+ template <typename enum_type, typename unrelated_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_flags<enum_type> \
+ OPERATOR_OP (enum_flags<enum_type> e1, unrelated_type e2) = delete; \
+ \
+ template <typename enum_type, typename unrelated_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_flags<enum_type> \
+ OPERATOR_OP (unrelated_type e1, enum_flags<enum_type> e2) = delete;
+
+/* Generate non-member compound assignment operators. Only the raw
+ enum versions are defined here. The enum_flags versions are
+ defined as member functions, simply because it's less code that
+ way.
+
+ Note we delete operators that would allow e.g.,
+
+ "enum_type | 1" or "enum_type1 | enum_type2"
+
+ because that would allow a mistake like :
+ enum flags1 { F1_FLAGS1 = 1 };
+ enum flags2 { F2_FLAGS2 = 2 };
+ enum flags1 val;
+ switch (val) {
+ case F1_FLAGS1 | F2_FLAGS2:
+ ...
+
+ If you really need to 'or' enumerators of different flag types,
+ cast to integer first.
+*/
+#define ENUM_FLAGS_GEN_COMPOUND_ASSIGN(OPERATOR_OP, OP) \
+ /* lval reference version. */ \
+ template <typename enum_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_type & \
+ OPERATOR_OP (enum_type &e1, enum_type e2) \
+ { return e1 = e1 OP e2; } \
+ \
+ /* rval reference version. */ \
+ template <typename enum_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_type & \
+ OPERATOR_OP (enum_type &&e1, enum_type e2) \
+ { return e1 = e1 OP e2; } \
+ \
+ /* Delete compound assignment from unrelated types. */ \
+ \
+ template <typename enum_type, typename other_enum_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_type & \
+ OPERATOR_OP (enum_type &e1, other_enum_type e2) = delete; \
+ \
+ template <typename enum_type, typename other_enum_type, \
+ typename = is_enum_flags_enum_type_t<enum_type>> \
+ constexpr enum_type & \
+ OPERATOR_OP (enum_type &&e1, other_enum_type e2) = delete;
+
+ENUM_FLAGS_GEN_BINOP (operator|, |)
+ENUM_FLAGS_GEN_BINOP (operator&, &)
+ENUM_FLAGS_GEN_BINOP (operator^, ^)
+
+ENUM_FLAGS_GEN_COMPOUND_ASSIGN (operator|=, |)
+ENUM_FLAGS_GEN_COMPOUND_ASSIGN (operator&=, &)
+ENUM_FLAGS_GEN_COMPOUND_ASSIGN (operator^=, ^)
+
+/* Allow comparison with enum_flags, raw enum, and integers, only.
+ The latter case allows "== 0". As side effect, it allows comparing
+ with integer variables too, but that's not a common mistake to
+ make. It's important to disable comparison with unrelated types to
+ prevent accidentally comparing with unrelated enum values, which
+ are convertible to integer, and thus coupled with enum_flags
+ convertion to underlying type too, would trigger the built-in 'bool
+ operator==(unsigned, int)' operator. */
+
+#define ENUM_FLAGS_GEN_COMP(OPERATOR_OP, OP) \
+ \
+ /* enum_flags OP enum_flags */ \
+ \
+ template <typename enum_type> \
+ constexpr bool \
+ OPERATOR_OP (enum_flags<enum_type> lhs, enum_flags<enum_type> rhs) \
+ { return lhs.raw () OP rhs.raw (); } \
+ \
+ /* enum_flags OP other */ \
+ \
+ template <typename enum_type> \
+ constexpr bool \
+ OPERATOR_OP (enum_flags<enum_type> lhs, enum_type rhs) \
+ { return lhs.raw () OP rhs; } \
+ \
+ template <typename enum_type> \
+ constexpr bool \
+ OPERATOR_OP (enum_flags<enum_type> lhs, int rhs) \
+ { return lhs.raw () OP rhs; } \
+ \
+ template <typename enum_type, typename U> \
+ constexpr bool \
+ OPERATOR_OP (enum_flags<enum_type> lhs, U rhs) = delete; \
+ \
+ /* other OP enum_flags */ \
+ \
+ template <typename enum_type> \
+ constexpr bool \
+ OPERATOR_OP (enum_type lhs, enum_flags<enum_type> rhs) \
+ { return lhs OP rhs.raw (); } \
+ \
+ template <typename enum_type> \
+ constexpr bool \
+ OPERATOR_OP (int lhs, enum_flags<enum_type> rhs) \
+ { return lhs OP rhs.raw (); } \
+ \
+ template <typename enum_type, typename U> \
+ constexpr bool \
+ OPERATOR_OP (U lhs, enum_flags<enum_type> rhs) = delete;
+
+ENUM_FLAGS_GEN_COMP (operator==, ==)
+ENUM_FLAGS_GEN_COMP (operator!=, !=)
+
+/* Unary operators for the raw flags enum. */
+
+/* We require underlying type to be unsigned when using operator~ --
+ if it were not unsigned, undefined behavior could result. However,
+ asserting this in the class itself would require too many
+ unnecessary changes to usages of otherwise OK enum types. */
+template <typename enum_type,
+ typename = is_enum_flags_enum_type_t<enum_type>,
+ typename
+ = gdb::Requires<enum_flags_detail::EnumIsUnsigned<enum_type>>>
+constexpr enum_type
+operator~ (enum_type e)
{
- return enum_flags<enum_type> (e1) & e2;
+ using underlying = typename enum_flags<enum_type>::underlying_type;
+ return (enum_type) ~underlying (e);
}
-template <typename enum_type>
-typename enum_flags_type<enum_type>::type
-operator| (enum_type e1, enum_type e2)
+template <typename enum_type,
+ typename = is_enum_flags_enum_type_t<enum_type>,
+ typename = gdb::Requires<enum_flags_detail::EnumIsSigned<enum_type>>>
+constexpr void operator~ (enum_type e) = delete;
+
+template <typename enum_type,
+ typename = is_enum_flags_enum_type_t<enum_type>,
+ typename
+ = gdb::Requires<enum_flags_detail::EnumIsUnsigned<enum_type>>>
+constexpr enum_flags<enum_type>
+operator~ (enum_flags<enum_type> e)
{
- return enum_flags<enum_type> (e1) | e2;
+ using underlying = typename enum_flags<enum_type>::underlying_type;
+ return (enum_type) ~underlying (e);
}
-template <typename enum_type>
-typename enum_flags_type<enum_type>::type
-operator^ (enum_type e1, enum_type e2)
-{
- return enum_flags<enum_type> (e1) ^ e2;
-}
+template <typename enum_type,
+ typename = is_enum_flags_enum_type_t<enum_type>,
+ typename = gdb::Requires<enum_flags_detail::EnumIsSigned<enum_type>>>
+constexpr void operator~ (enum_flags<enum_type> e) = delete;
-template <typename enum_type>
-typename enum_flags_type<enum_type>::type
-operator~ (enum_type e)
-{
- return ~enum_flags<enum_type> (e);
-}
+/* Delete operator<< and operator>>. */
+
+template <typename enum_type, typename any_type,
+ typename = is_enum_flags_enum_type_t<enum_type>>
+void operator<< (const enum_type &, const any_type &) = delete;
+
+template <typename enum_type, typename any_type,
+ typename = is_enum_flags_enum_type_t<enum_type>>
+void operator<< (const enum_flags<enum_type> &, const any_type &) = delete;
+
+template <typename enum_type, typename any_type,
+ typename = is_enum_flags_enum_type_t<enum_type>>
+void operator>> (const enum_type &, const any_type &) = delete;
+
+template <typename enum_type, typename any_type,
+ typename = is_enum_flags_enum_type_t<enum_type>>
+void operator>> (const enum_flags<enum_type> &, const any_type &) = delete;
#else /* __cplusplus */
diff --git a/gdbsupport/valid-expr.h b/gdbsupport/valid-expr.h
index a22fa61134f..459de179266 100644
--- a/gdbsupport/valid-expr.h
+++ b/gdbsupport/valid-expr.h
@@ -91,4 +91,19 @@
ESC_PARENS (T1, T2, T3, T4), \
VALID, EXPR_TYPE, EXPR)
+#define CHECK_VALID_EXPR_5(T1, T2, T3, T4, T5, VALID, EXPR_TYPE, EXPR) \
+ CHECK_VALID_EXPR_INT (ESC_PARENS (typename T1, typename T2, \
+ typename T3, typename T4, \
+ typename T5), \
+ ESC_PARENS (T1, T2, T3, T4, T5), \
+ VALID, EXPR_TYPE, EXPR)
+
+#define CHECK_VALID_EXPR_6(T1, T2, T3, T4, T5, T6, \
+ VALID, EXPR_TYPE, EXPR) \
+ CHECK_VALID_EXPR_INT (ESC_PARENS (typename T1, typename T2, \
+ typename T3, typename T4, \
+ typename T5, typename T6), \
+ ESC_PARENS (T1, T2, T3, T4, T5, T6), \
+ VALID, EXPR_TYPE, EXPR)
+
#endif /* COMMON_VALID_EXPR_H */
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 04/10] gdb: additional changes to make use of type_instance_flags more
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
` (2 preceding siblings ...)
2020-08-26 14:49 ` [PATCHv2 03/10] Rewrite enum_flags, add unit tests, fix problems Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 05/10] gdb/fortran: Clean up array/string expression evaluation Andrew Burgess
` (6 subsequent siblings)
10 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
Further updates to make use of type_instance_flags.
gdb/ChangeLog:
* avr-tdep.c (avr_address_class_type_flags): Update return type.
(avr_address_class_type_flags_to_name): Update argument types.
(avr_address_class_name_to_type_flags): Update return type and
argument types.
* ft32-tdep.c (ft32_address_class_type_flags): Update return type.
(ft32_address_class_type_flags_to_name): Update argument types.
(ft32_address_class_name_to_type_flags): Update return type and
argument types.
* gdbarch.c: Regenerate.
* gdbarch.h: Regenerate.
* gdbarch.sh (address_class_type_flags_to_name): Update argument
types.
* s390-tdep.c (s390_address_class_type_flags): Update return type.
(s390_address_class_type_flags_to_name): Update argument types.
(s390_address_class_name_to_type_flags): Update return type and
argument types.
---
gdb/ChangeLog | 19 +++++++++++++++++++
gdb/avr-tdep.c | 13 +++++++------
gdb/ft32-tdep.c | 13 +++++++------
gdb/gdbarch.c | 2 +-
gdb/gdbarch.h | 4 ++--
gdb/gdbarch.sh | 2 +-
gdb/s390-tdep.c | 13 +++++++------
7 files changed, 44 insertions(+), 22 deletions(-)
diff --git a/gdb/avr-tdep.c b/gdb/avr-tdep.c
index 74ab531711e..0148f4e4db2 100644
--- a/gdb/avr-tdep.c
+++ b/gdb/avr-tdep.c
@@ -1372,7 +1372,7 @@ avr_dwarf_reg_to_regnum (struct gdbarch *gdbarch, int reg)
This method maps DW_AT_address_class attributes to a
type_instance_flag_value. */
-static int
+static type_instance_flags
avr_address_class_type_flags (int byte_size, int dwarf2_addr_class)
{
/* The value 1 of the DW_AT_address_class attribute corresponds to the
@@ -1389,7 +1389,8 @@ avr_address_class_type_flags (int byte_size, int dwarf2_addr_class)
Convert a type_instance_flag_value to an address space qualifier. */
static const char*
-avr_address_class_type_flags_to_name (struct gdbarch *gdbarch, int type_flags)
+avr_address_class_type_flags_to_name (struct gdbarch *gdbarch,
+ type_instance_flags type_flags)
{
if (type_flags & AVR_TYPE_INSTANCE_FLAG_ADDRESS_CLASS_FLASH)
return "flash";
@@ -1401,18 +1402,18 @@ avr_address_class_type_flags_to_name (struct gdbarch *gdbarch, int type_flags)
Convert an address space qualifier to a type_instance_flag_value. */
-static int
+static bool
avr_address_class_name_to_type_flags (struct gdbarch *gdbarch,
const char* name,
- int *type_flags_ptr)
+ type_instance_flags *type_flags_ptr)
{
if (strcmp (name, "flash") == 0)
{
*type_flags_ptr = AVR_TYPE_INSTANCE_FLAG_ADDRESS_CLASS_FLASH;
- return 1;
+ return true;
}
else
- return 0;
+ return false;
}
/* Initialize the gdbarch structure for the AVR's. */
diff --git a/gdb/ft32-tdep.c b/gdb/ft32-tdep.c
index 99ef69de770..8ce16c06505 100644
--- a/gdb/ft32-tdep.c
+++ b/gdb/ft32-tdep.c
@@ -341,7 +341,7 @@ ft32_pointer_to_address (struct gdbarch *gdbarch,
This method maps DW_AT_address_class attributes to a
type_instance_flag_value. */
-static int
+static type_instance_flags
ft32_address_class_type_flags (int byte_size, int dwarf2_addr_class)
{
/* The value 1 of the DW_AT_address_class attribute corresponds to the
@@ -357,7 +357,8 @@ ft32_address_class_type_flags (int byte_size, int dwarf2_addr_class)
Convert a type_instance_flag_value to an address space qualifier. */
static const char*
-ft32_address_class_type_flags_to_name (struct gdbarch *gdbarch, int type_flags)
+ft32_address_class_type_flags_to_name (struct gdbarch *gdbarch,
+ type_instance_flags type_flags)
{
if (type_flags & TYPE_INSTANCE_FLAG_ADDRESS_CLASS_1)
return "flash";
@@ -369,18 +370,18 @@ ft32_address_class_type_flags_to_name (struct gdbarch *gdbarch, int type_flags)
Convert an address space qualifier to a type_instance_flag_value. */
-static int
+static bool
ft32_address_class_name_to_type_flags (struct gdbarch *gdbarch,
const char* name,
- int *type_flags_ptr)
+ type_instance_flags *type_flags_ptr)
{
if (strcmp (name, "flash") == 0)
{
*type_flags_ptr = TYPE_INSTANCE_FLAG_ADDRESS_CLASS_1;
- return 1;
+ return true;
}
else
- return 0;
+ return false;
}
/* Given a return value in `regbuf' with a type `valtype',
diff --git a/gdb/gdbarch.c b/gdb/gdbarch.c
index 2be959ecfc9..a3a67020078 100644
--- a/gdb/gdbarch.c
+++ b/gdb/gdbarch.c
@@ -3526,7 +3526,7 @@ gdbarch_address_class_type_flags_to_name_p (struct gdbarch *gdbarch)
}
const char *
-gdbarch_address_class_type_flags_to_name (struct gdbarch *gdbarch, int type_flags)
+gdbarch_address_class_type_flags_to_name (struct gdbarch *gdbarch, type_instance_flags type_flags)
{
gdb_assert (gdbarch != NULL);
gdb_assert (gdbarch->address_class_type_flags_to_name != NULL);
diff --git a/gdb/gdbarch.h b/gdb/gdbarch.h
index 8a4a384fda9..5ac4f5495c4 100644
--- a/gdb/gdbarch.h
+++ b/gdb/gdbarch.h
@@ -854,8 +854,8 @@ extern void set_gdbarch_address_class_type_flags (struct gdbarch *gdbarch, gdbar
extern int gdbarch_address_class_type_flags_to_name_p (struct gdbarch *gdbarch);
-typedef const char * (gdbarch_address_class_type_flags_to_name_ftype) (struct gdbarch *gdbarch, int type_flags);
-extern const char * gdbarch_address_class_type_flags_to_name (struct gdbarch *gdbarch, int type_flags);
+typedef const char * (gdbarch_address_class_type_flags_to_name_ftype) (struct gdbarch *gdbarch, type_instance_flags type_flags);
+extern const char * gdbarch_address_class_type_flags_to_name (struct gdbarch *gdbarch, type_instance_flags type_flags);
extern void set_gdbarch_address_class_type_flags_to_name (struct gdbarch *gdbarch, gdbarch_address_class_type_flags_to_name_ftype *address_class_type_flags_to_name);
/* Execute vendor-specific DWARF Call Frame Instruction. OP is the instruction.
diff --git a/gdb/gdbarch.sh b/gdb/gdbarch.sh
index 7e9204119bd..a64afb5a3d2 100755
--- a/gdb/gdbarch.sh
+++ b/gdb/gdbarch.sh
@@ -690,7 +690,7 @@ v;int;cannot_step_breakpoint;;;0;0;;0
# non-steppable watchpoints.
v;int;have_nonsteppable_watchpoint;;;0;0;;0
F;type_instance_flags;address_class_type_flags;int byte_size, int dwarf2_addr_class;byte_size, dwarf2_addr_class
-M;const char *;address_class_type_flags_to_name;int type_flags;type_flags
+M;const char *;address_class_type_flags_to_name;type_instance_flags type_flags;type_flags
# Execute vendor-specific DWARF Call Frame Instruction. OP is the instruction.
# FS are passed from the generic execute_cfa_program function.
m;bool;execute_dwarf_cfa_vendor_op;gdb_byte op, struct dwarf2_frame_state *fs;op, fs;;default_execute_dwarf_cfa_vendor_op;;0
diff --git a/gdb/s390-tdep.c b/gdb/s390-tdep.c
index 65cb23705d2..49a507f7c2d 100644
--- a/gdb/s390-tdep.c
+++ b/gdb/s390-tdep.c
@@ -1583,7 +1583,7 @@ s390_addr_bits_remove (struct gdbarch *gdbarch, CORE_ADDR addr)
/* Implement addr_class_type_flags gdbarch method.
Only used for ABI_LINUX_ZSERIES. */
-static int
+static type_instance_flags
s390_address_class_type_flags (int byte_size, int dwarf2_addr_class)
{
if (byte_size == 4)
@@ -1596,7 +1596,8 @@ s390_address_class_type_flags (int byte_size, int dwarf2_addr_class)
Only used for ABI_LINUX_ZSERIES. */
static const char *
-s390_address_class_type_flags_to_name (struct gdbarch *gdbarch, int type_flags)
+s390_address_class_type_flags_to_name (struct gdbarch *gdbarch,
+ type_instance_flags type_flags)
{
if (type_flags & TYPE_INSTANCE_FLAG_ADDRESS_CLASS_1)
return "mode32";
@@ -1607,18 +1608,18 @@ s390_address_class_type_flags_to_name (struct gdbarch *gdbarch, int type_flags)
/* Implement addr_class_name_to_type_flags gdbarch method.
Only used for ABI_LINUX_ZSERIES. */
-static int
+static bool
s390_address_class_name_to_type_flags (struct gdbarch *gdbarch,
const char *name,
- int *type_flags_ptr)
+ type_instance_flags *type_flags_ptr)
{
if (strcmp (name, "mode32") == 0)
{
*type_flags_ptr = TYPE_INSTANCE_FLAG_ADDRESS_CLASS_1;
- return 1;
+ return true;
}
else
- return 0;
+ return false;
}
/* Inferior function calls. */
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 05/10] gdb/fortran: Clean up array/string expression evaluation
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
` (3 preceding siblings ...)
2020-08-26 14:49 ` [PATCHv2 04/10] gdb: additional changes to make use of type_instance_flags more Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-09-19 8:53 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 06/10] gdb/fortran: Move Fortran expression handling into f-lang.c Andrew Burgess
` (5 subsequent siblings)
10 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
In preparation for adding Fortan array stride expression support, this
is the first phase of some clean up to the expression evaluation for
Fortran arrays and strings.
The current code is split into two blocks, linked, weirdly, with a
goto. After this commit all the code is moved to its own function,
and arrays and strings are now handled using the same code; this will
be useful later when I want to add array stride support where strings
will want to be treated just like arrays.
For now the new function is added as a static within eval.c, even
though the function is Fortran only. A following commit will remove
some of the Fortran specific code from eval.c into one of the Fortran
specific files, including this new function.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* eval.c (fortran_value_subarray): New function, content is taken
from...
(evaluate_subexp_standard): ...here, in two places. Now arrays
and strings both call the new function.
(calc_f77_array_dims): Add header comment, handle strings.
---
gdb/ChangeLog | 8 +++
gdb/eval.c | 136 +++++++++++++++++++++++++-------------------------
2 files changed, 75 insertions(+), 69 deletions(-)
diff --git a/gdb/eval.c b/gdb/eval.c
index cd300ddfef6..660edbe34af 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -1260,6 +1260,67 @@ is_integral_or_integral_reference (struct type *type)
&& is_integral_type (TYPE_TARGET_TYPE (type)));
}
+/* Called from evaluate_subexp_standard to perform array indexing, and
+ sub-range extraction, for Fortran. As well as arrays this function
+ also handles strings as they can be treated like arrays of characters.
+ ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are
+ as for evaluate_subexp_standard, and NARGS is the number of arguments
+ in this access (e.g. 'array (1,2,3)' would be NARGS 3). */
+
+static struct value *
+fortran_value_subarray (struct value *array, struct expression *exp,
+ int *pos, int nargs, enum noside noside)
+{
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ return value_f90_subarray (array, exp, pos, noside);
+
+ if (noside == EVAL_SKIP)
+ {
+ skip_undetermined_arglist (nargs, exp, pos, noside);
+ /* Return the dummy value with the correct type. */
+ return array;
+ }
+
+ LONGEST subscript_array[MAX_FORTRAN_DIMS];
+ int ndimensions = 1;
+ struct type *type = check_typedef (value_type (array));
+
+ if (nargs > MAX_FORTRAN_DIMS)
+ error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+
+ ndimensions = calc_f77_array_dims (type);
+
+ if (nargs != ndimensions)
+ error (_("Wrong number of subscripts"));
+
+ gdb_assert (nargs > 0);
+
+ /* Now that we know we have a legal array subscript expression let us
+ actually find out where this element exists in the array. */
+
+ /* Take array indices left to right. */
+ for (int i = 0; i < nargs; i++)
+ {
+ /* Evaluate each subscript; it must be a legal integer in F77. */
+ value *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 (int 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;
+}
+
struct value *
evaluate_subexp_standard (struct type *expect_type,
struct expression *exp, int *pos,
@@ -1954,33 +2015,8 @@ evaluate_subexp_standard (struct type *expect_type,
switch (code)
{
case TYPE_CODE_ARRAY:
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (arg1, exp, pos, noside);
- else
- {
- if (noside == EVAL_SKIP)
- {
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return arg1;
- }
- goto multi_f77_subscript;
- }
-
case TYPE_CODE_STRING:
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (arg1, exp, pos, noside);
- else
- {
- if (noside == EVAL_SKIP)
- {
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return arg1;
- }
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- return value_subscript (arg1, value_as_long (arg2));
- }
+ return fortran_value_subarray (arg1, exp, pos, nargs, noside);
case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
@@ -2400,49 +2436,6 @@ evaluate_subexp_standard (struct type *expect_type,
}
return (arg1);
- multi_f77_subscript:
- {
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1, i;
- struct value *array = arg1;
-
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
-
- ndimensions = calc_f77_array_dims (type);
-
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
-
- gdb_assert (nargs > 0);
-
- /* Now that we know we have a legal array subscript expression
- let us actually find out where this element exists in the array. */
-
- /* Take array indices left to right. */
- for (i = 0; i < nargs; i++)
- {
- /* Evaluate each subscript; it must be a legal integer in F77. */
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
-
- /* Fill in the subscript array. */
-
- subscript_array[i] = value_as_long (arg2);
- }
-
- /* Internal type of array is arranged right to left. */
- for (i = nargs; i > 0; i--)
- {
- struct type *array_type = check_typedef (value_type (array));
- LONGEST index = subscript_array[i - 1];
-
- array = value_subscripted_rvalue (array, index,
- f77_get_lowerbound (array_type));
- }
-
- return array;
- }
-
case BINOP_LOGICAL_AND:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
@@ -3356,12 +3349,17 @@ parse_and_eval_type (char *p, int length)
return expr->elts[1].type;
}
+/* Return the number of dimensions for a Fortran array or string. */
+
int
calc_f77_array_dims (struct type *array_type)
{
int ndimen = 1;
struct type *tmp_type;
+ if ((array_type->code () == TYPE_CODE_STRING))
+ return 1;
+
if ((array_type->code () != TYPE_CODE_ARRAY))
error (_("Can't get dimensions for a non-array type"));
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 06/10] gdb/fortran: Move Fortran expression handling into f-lang.c
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
` (4 preceding siblings ...)
2020-08-26 14:49 ` [PATCHv2 05/10] gdb/fortran: Clean up array/string expression evaluation Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-09-19 8:53 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 07/10] gdb/fortran: Change whitespace when printing arrays Andrew Burgess
` (4 subsequent siblings)
10 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
The Fortran specific OP_F77_UNDETERMINED_ARGLIST is currently handled
in the generic expression handling code. As I start to add array
stride support in here the amount of Fortran only code that is forced
into the generic expression evaluation file will grow.
Now seems like a good time to move this Fortran specific operation
into the Fortran specific files.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* eval.c: Remove 'f-lang.h' include.
(value_f90_subarray): Moved to f-lang.c.
(eval_call): Renamed to...
(evaluate_subexp_do_call): ...this, is no longer static, header
comment moved into header file.
(evaluate_funcall): Update call to eval_call.
(skip_undetermined_arglist): Moved to f-lang.c.
(fortran_value_subarray): Likewise.
(evaluate_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to evaluate_subexp_f.
(calc_f77_array_dims): Moved to f-lang.c
* expprint.c (print_subexp_funcall): New function.
(print_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to print_subexp_f, OP_FUNCALL uses new function.
(dump_subexp_body_funcall): New function.
(dump_subexp_body_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to dump_subexp_f, OP_FUNCALL uses new function.
* expression.h (evaluate_subexp_do_call): Declare.
* f-lang.c (value_f90_subarray): Moved from eval.c.
(skip_undetermined_arglist): Likewise.
(calc_f77_array_dims): Likewise.
(fortran_value_subarray): Likewise.
(evaluate_subexp_f): Add OP_F77_UNDETERMINED_ARGLIST support.
(operator_length_f): Likewise.
(print_subexp_f): Likewise.
(dump_subexp_body_f): Likewise.
* fortran-operator.def (OP_F77_UNDETERMINED_ARGLIST): Move
declaration of this operation to here.
* parse.c (operator_length_standard): OP_F77_UNDETERMINED_ARGLIST
support moved to operator_length_f.
* parser-defs.h (dump_subexp_body_funcall): Declare.
(print_subexp_funcall): Declare.
* std-operator.def (OP_F77_UNDETERMINED_ARGLIST): Moved to
fortran-operator.def.
---
gdb/ChangeLog | 37 +++++++
gdb/eval.c | 223 ++-------------------------------------
gdb/expprint.c | 61 ++++++-----
gdb/expression.h | 12 +++
gdb/f-lang.c | 221 ++++++++++++++++++++++++++++++++++++++
gdb/fortran-operator.def | 8 ++
gdb/parse.c | 1 -
gdb/parser-defs.h | 16 +++
gdb/std-operator.def | 8 --
9 files changed, 339 insertions(+), 248 deletions(-)
diff --git a/gdb/eval.c b/gdb/eval.c
index 660edbe34af..3ccc4148e48 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -26,7 +26,6 @@
#include "frame.h"
#include "gdbthread.h"
#include "language.h" /* For CAST_IS_CONVERSION. */
-#include "f-lang.h" /* For array bound stuff. */
#include "cp-abi.h"
#include "infcall.h"
#include "objc-lang.h"
@@ -371,32 +370,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 (value_type (array)->index_type ());
- 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 = range->bounds ()->low.const_val ();
- 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 = range->bounds ()->high.const_val ();
- 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
@@ -749,17 +722,13 @@ eval_skip_value (expression *exp)
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
}
-/* Evaluate a function call. The function to be called is in
- ARGVEC[0] and the arguments passed to the function are in
- ARGVEC[1..NARGS]. FUNCTION_NAME is the name of the function, if
- known. DEFAULT_RETURN_TYPE is used as the function's return type
- if the return type is unknown. */
+/* See expression.h. */
-static value *
-eval_call (expression *exp, enum noside noside,
- int nargs, value **argvec,
- const char *function_name,
- type *default_return_type)
+value *
+evaluate_subexp_do_call (expression *exp, enum noside noside,
+ int nargs, value **argvec,
+ const char *function_name,
+ type *default_return_type)
{
if (argvec[0] == NULL)
error (_("Cannot evaluate function -- may be inlined"));
@@ -1230,20 +1199,8 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
/* Nothing to be done; argvec already correctly set up. */
}
- return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
-}
-
-/* Helper for skipping all the arguments in an undetermined argument list.
- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
- case of evaluate_subexp_standard as multiple, but not all, code paths
- require a generic skip. */
-
-static void
-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
- enum noside noside)
-{
- for (int i = 0; i < nargs; ++i)
- evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ return evaluate_subexp_do_call (exp, noside, nargs, argvec,
+ var_func_name, expect_type);
}
/* Return true if type is integral or reference to integral */
@@ -1260,67 +1217,6 @@ is_integral_or_integral_reference (struct type *type)
&& is_integral_type (TYPE_TARGET_TYPE (type)));
}
-/* Called from evaluate_subexp_standard to perform array indexing, and
- sub-range extraction, for Fortran. As well as arrays this function
- also handles strings as they can be treated like arrays of characters.
- ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are
- as for evaluate_subexp_standard, and NARGS is the number of arguments
- in this access (e.g. 'array (1,2,3)' would be NARGS 3). */
-
-static struct value *
-fortran_value_subarray (struct value *array, struct expression *exp,
- int *pos, int nargs, enum noside noside)
-{
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (array, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
- {
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return array;
- }
-
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1;
- struct type *type = check_typedef (value_type (array));
-
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
-
- ndimensions = calc_f77_array_dims (type);
-
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
-
- gdb_assert (nargs > 0);
-
- /* Now that we know we have a legal array subscript expression let us
- actually find out where this element exists in the array. */
-
- /* Take array indices left to right. */
- for (int i = 0; i < nargs; i++)
- {
- /* Evaluate each subscript; it must be a legal integer in F77. */
- value *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 (int 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;
-}
-
struct value *
evaluate_subexp_standard (struct type *expect_type,
struct expression *exp, int *pos,
@@ -1335,7 +1231,6 @@ evaluate_subexp_standard (struct type *expect_type,
struct type *type;
int nargs;
struct value **argvec;
- int code;
int ix;
long mem_offset;
struct type **arg_types;
@@ -1977,84 +1872,6 @@ evaluate_subexp_standard (struct type *expect_type,
case OP_FUNCALL:
return evaluate_funcall (expect_type, exp, pos, noside);
- case OP_F77_UNDETERMINED_ARGLIST:
-
- /* Remember that in F77, functions, substring ops and
- array subscript operations cannot be disambiguated
- at parse time. We have made all array subscript operations,
- substring operations as well as function calls come here
- and we now have to discover what the heck this thing actually was.
- If it is a function, we process just as if we got an OP_FUNCALL. */
-
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
- (*pos) += 2;
-
- /* First determine the type code we are dealing with. */
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- type = check_typedef (value_type (arg1));
- code = type->code ();
-
- if (code == TYPE_CODE_PTR)
- {
- /* Fortran always passes variable to subroutines as pointer.
- So we need to look into its target type to see if it is
- array, string or function. If it is, we need to switch
- to the target value the original one points to. */
- struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
-
- if (target_type->code () == TYPE_CODE_ARRAY
- || target_type->code () == TYPE_CODE_STRING
- || target_type->code () == TYPE_CODE_FUNC)
- {
- arg1 = value_ind (arg1);
- type = check_typedef (value_type (arg1));
- code = type->code ();
- }
- }
-
- switch (code)
- {
- case TYPE_CODE_ARRAY:
- case TYPE_CODE_STRING:
- return fortran_value_subarray (arg1, exp, pos, nargs, noside);
-
- case TYPE_CODE_PTR:
- case TYPE_CODE_FUNC:
- case TYPE_CODE_INTERNAL_FUNCTION:
- /* It's a function call. */
- /* Allocate arg vector, including space for the function to be
- called in argvec[0] and a terminating NULL. */
- argvec = (struct value **)
- alloca (sizeof (struct value *) * (nargs + 2));
- argvec[0] = arg1;
- tem = 1;
- for (; tem <= nargs; tem++)
- {
- argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
- /* Arguments in Fortran are passed by address. Coerce the
- arguments here rather than in value_arg_coerce as otherwise
- the call to malloc to place the non-lvalue parameters in
- target memory is hit by this Fortran specific logic. This
- results in malloc being called with a pointer to an integer
- followed by an attempt to malloc the arguments to malloc in
- target memory. Infinite recursion ensues. */
- if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
- {
- bool is_artificial
- = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
- argvec[tem] = fortran_argument_convert (argvec[tem],
- is_artificial);
- }
- }
- argvec[tem] = 0; /* signal end of arglist */
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
- return eval_call (exp, noside, nargs, argvec, NULL, expect_type);
-
- default:
- error (_("Cannot perform substring on this type"));
- }
-
case OP_COMPLEX:
/* We have a complex number, There should be 2 floating
point numbers that compose it. */
@@ -3348,27 +3165,3 @@ parse_and_eval_type (char *p, int length)
error (_("Internal error in eval_type."));
return expr->elts[1].type;
}
-
-/* Return the number of dimensions for a Fortran array or string. */
-
-int
-calc_f77_array_dims (struct type *array_type)
-{
- int ndimen = 1;
- struct type *tmp_type;
-
- if ((array_type->code () == TYPE_CODE_STRING))
- return 1;
-
- if ((array_type->code () != 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 (tmp_type->code () == TYPE_CODE_ARRAY)
- ++ndimen;
- }
- return ndimen;
-}
diff --git a/gdb/expprint.c b/gdb/expprint.c
index 5427a56f6ae..350f291b75e 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -53,6 +53,25 @@ print_subexp (struct expression *exp, int *pos,
exp->language_defn->la_exp_desc->print_subexp (exp, pos, stream, prec);
}
+/* See parser-defs.h. */
+
+void
+print_subexp_funcall (struct expression *exp, int *pos,
+ struct ui_file *stream)
+{
+ (*pos) += 2;
+ unsigned nargs = longest_to_int (exp->elts[*pos].longconst);
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fputs_filtered (" (", stream);
+ for (unsigned tem = 0; tem < nargs; tem++)
+ {
+ if (tem != 0)
+ fputs_filtered (", ", stream);
+ print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
+ }
+ fputs_filtered (")", stream);
+}
+
/* Standard implementation of print_subexp for use in language_defn
vectors. */
void
@@ -187,18 +206,7 @@ print_subexp_standard (struct expression *exp, int *pos,
return;
case OP_FUNCALL:
- case OP_F77_UNDETERMINED_ARGLIST:
- (*pos) += 2;
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered (" (", stream);
- for (tem = 0; tem < nargs; tem++)
- {
- if (tem != 0)
- fputs_filtered (", ", stream);
- print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
- }
- fputs_filtered (")", stream);
+ print_subexp_funcall (exp, pos, stream);
return;
case OP_NAME:
@@ -796,6 +804,22 @@ dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
return exp->language_defn->la_exp_desc->dump_subexp_body (exp, stream, elt);
}
+/* See parser-defs.h. */
+
+int
+dump_subexp_body_funcall (struct expression *exp,
+ struct ui_file *stream, int elt)
+{
+ int nargs = longest_to_int (exp->elts[elt].longconst);
+ fprintf_filtered (stream, "Number of args: %d", nargs);
+ elt += 2;
+
+ for (int i = 1; i <= nargs + 1; i++)
+ elt = dump_subexp (exp, stream, elt);
+
+ return elt;
+}
+
/* Default value for subexp_body in exp_descriptor vector. */
int
@@ -931,18 +955,7 @@ dump_subexp_body_standard (struct expression *exp,
elt += 2;
break;
case OP_FUNCALL:
- case OP_F77_UNDETERMINED_ARGLIST:
- {
- int i, nargs;
-
- nargs = longest_to_int (exp->elts[elt].longconst);
-
- fprintf_filtered (stream, "Number of args: %d", nargs);
- elt += 2;
-
- for (i = 1; i <= nargs + 1; i++)
- elt = dump_subexp (exp, stream, elt);
- }
+ elt = dump_subexp_body_funcall (exp, stream, elt);
break;
case OP_ARRAY:
{
diff --git a/gdb/expression.h b/gdb/expression.h
index f1128c44248..5af10f05db1 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -155,6 +155,18 @@ enum noside
extern struct value *evaluate_subexp_standard
(struct type *, struct expression *, int *, enum noside);
+/* Evaluate a function call. The function to be called is in ARGVEC[0] and
+ the arguments passed to the function are in ARGVEC[1..NARGS].
+ FUNCTION_NAME is the name of the function, if known.
+ DEFAULT_RETURN_TYPE is used as the function's return type if the return
+ type is unknown. */
+
+extern struct value *evaluate_subexp_do_call (expression *exp,
+ enum noside noside,
+ int nargs, value **argvec,
+ const char *function_name,
+ type *default_return_type);
+
/* From expprint.c */
extern void print_expression (struct expression *, struct ui_file *);
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 58b41d11d11..6210522c182 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -114,6 +114,134 @@ enum f_primitive_types {
nr_f_primitive_types
};
+/* Called from fortran_value_subarray to take a slice of an array or a
+ string. ARRAY is the array or string to be accessed. EXP, POS, and
+ NOSIDE are as for evaluate_subexp_standard. Return a value that is a
+ slice of the array. */
+
+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 (value_type (array)->index_type ());
+ 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 = range->bounds ()->low.const_val ();
+ 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 = range->bounds ()->high.const_val ();
+ else
+ high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+
+ return value_slice (array, low_bound, high_bound - low_bound + 1);
+}
+
+/* Helper for skipping all the arguments in an undetermined argument list.
+ This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
+ case of evaluate_subexp_standard as multiple, but not all, code paths
+ require a generic skip. */
+
+static void
+skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
+ enum noside noside)
+{
+ for (int i = 0; i < nargs; ++i)
+ evaluate_subexp (NULL_TYPE, exp, pos, noside);
+}
+
+/* Return the number of dimensions for a Fortran array or string. */
+
+int
+calc_f77_array_dims (struct type *array_type)
+{
+ int ndimen = 1;
+ struct type *tmp_type;
+
+ if ((array_type->code () == TYPE_CODE_STRING))
+ return 1;
+
+ if ((array_type->code () != 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 (tmp_type->code () == TYPE_CODE_ARRAY)
+ ++ndimen;
+ }
+ return ndimen;
+}
+
+/* Called from evaluate_subexp_standard to perform array indexing, and
+ sub-range extraction, for Fortran. As well as arrays this function
+ also handles strings as they can be treated like arrays of characters.
+ ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are
+ as for evaluate_subexp_standard, and NARGS is the number of arguments
+ in this access (e.g. 'array (1,2,3)' would be NARGS 3). */
+
+static struct value *
+fortran_value_subarray (struct value *array, struct expression *exp,
+ int *pos, int nargs, enum noside noside)
+{
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ return value_f90_subarray (array, exp, pos, noside);
+
+ if (noside == EVAL_SKIP)
+ {
+ skip_undetermined_arglist (nargs, exp, pos, noside);
+ /* Return the dummy value with the correct type. */
+ return array;
+ }
+
+ LONGEST subscript_array[MAX_FORTRAN_DIMS];
+ int ndimensions = 1;
+ struct type *type = check_typedef (value_type (array));
+
+ if (nargs > MAX_FORTRAN_DIMS)
+ error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+
+ ndimensions = calc_f77_array_dims (type);
+
+ if (nargs != ndimensions)
+ error (_("Wrong number of subscripts"));
+
+ gdb_assert (nargs > 0);
+
+ /* Now that we know we have a legal array subscript expression let us
+ actually find out where this element exists in the array. */
+
+ /* Take array indices left to right. */
+ for (int i = 0; i < nargs; i++)
+ {
+ /* Evaluate each subscript; it must be a legal integer in F77. */
+ value *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 (int 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;
+}
+
/* Special expression evaluation cases for Fortran. */
static struct value *
@@ -285,6 +413,87 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
TYPE_LENGTH (type));
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
TYPE_LENGTH (TYPE_TARGET_TYPE (type)));
+
+
+ case OP_F77_UNDETERMINED_ARGLIST:
+ /* Remember that in F77, functions, substring ops and array subscript
+ operations cannot be disambiguated at parse time. We have made
+ all array subscript operations, substring operations as well as
+ function calls come here and we now have to discover what the heck
+ this thing actually was. If it is a function, we process just as
+ if we got an OP_FUNCALL. */
+ int nargs = longest_to_int (exp->elts[pc + 1].longconst);
+ (*pos) += 2;
+
+ /* First determine the type code we are dealing with. */
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ type = check_typedef (value_type (arg1));
+ enum type_code code = type->code ();
+
+ if (code == TYPE_CODE_PTR)
+ {
+ /* Fortran always passes variable to subroutines as pointer.
+ So we need to look into its target type to see if it is
+ array, string or function. If it is, we need to switch
+ to the target value the original one points to. */
+ struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
+
+ if (target_type->code () == TYPE_CODE_ARRAY
+ || target_type->code () == TYPE_CODE_STRING
+ || target_type->code () == TYPE_CODE_FUNC)
+ {
+ arg1 = value_ind (arg1);
+ type = check_typedef (value_type (arg1));
+ code = type->code ();
+ }
+ }
+
+ switch (code)
+ {
+ case TYPE_CODE_ARRAY:
+ case TYPE_CODE_STRING:
+ return fortran_value_subarray (arg1, exp, pos, nargs, noside);
+
+ case TYPE_CODE_PTR:
+ case TYPE_CODE_FUNC:
+ case TYPE_CODE_INTERNAL_FUNCTION:
+ {
+ /* It's a function call. Allocate arg vector, including
+ space for the function to be called in argvec[0] and a
+ termination NULL. */
+ struct value **argvec = (struct value **)
+ alloca (sizeof (struct value *) * (nargs + 2));
+ argvec[0] = arg1;
+ int tem = 1;
+ for (; tem <= nargs; tem++)
+ {
+ argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
+ /* Arguments in Fortran are passed by address. Coerce the
+ arguments here rather than in value_arg_coerce as
+ otherwise the call to malloc to place the non-lvalue
+ parameters in target memory is hit by this Fortran
+ specific logic. This results in malloc being called
+ with a pointer to an integer followed by an attempt to
+ malloc the arguments to malloc in target memory.
+ Infinite recursion ensues. */
+ if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
+ {
+ bool is_artificial
+ = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
+ argvec[tem] = fortran_argument_convert (argvec[tem],
+ is_artificial);
+ }
+ }
+ argvec[tem] = 0; /* signal end of arglist */
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ return evaluate_subexp_do_call (exp, noside, nargs, argvec, NULL,
+ expect_type);
+ }
+
+ default:
+ error (_("Cannot perform substring on this type"));
+ }
}
/* Should be unreachable. */
@@ -318,6 +527,11 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp,
oplen = 1;
args = 2;
break;
+
+ case OP_F77_UNDETERMINED_ARGLIST:
+ oplen = 3;
+ args = 1 + longest_to_int (exp->elts[pc - 2].longconst);
+ break;
}
*oplenp = oplen;
@@ -390,6 +604,10 @@ print_subexp_f (struct expression *exp, int *pos,
case BINOP_FORTRAN_MODULO:
print_binop_subexp_f (exp, pos, stream, prec, "MODULO");
return;
+
+ case OP_F77_UNDETERMINED_ARGLIST:
+ print_subexp_funcall (exp, pos, stream);
+ return;
}
}
@@ -432,6 +650,9 @@ dump_subexp_body_f (struct expression *exp,
case BINOP_FORTRAN_MODULO:
operator_length_f (exp, (elt + 1), &oplen, &nargs);
break;
+
+ case OP_F77_UNDETERMINED_ARGLIST:
+ return dump_subexp_body_funcall (exp, stream, elt);
}
elt += oplen;
diff --git a/gdb/fortran-operator.def b/gdb/fortran-operator.def
index fd4051ebe59..bfdbc401711 100644
--- a/gdb/fortran-operator.def
+++ b/gdb/fortran-operator.def
@@ -17,6 +17,14 @@
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
+/* This is EXACTLY like OP_FUNCALL but is semantically different.
+ In F77, array subscript expressions, substring expressions and
+ function calls are all exactly the same syntactically. They
+ may only be disambiguated at runtime. Thus this operator,
+ which indicates that we have found something of the form
+ <name> ( <stuff> ). */
+OP (OP_F77_UNDETERMINED_ARGLIST)
+
/* Single operand builtins. */
OP (UNOP_FORTRAN_KIND)
OP (UNOP_FORTRAN_FLOOR)
diff --git a/gdb/parse.c b/gdb/parse.c
index 2fb474e27f1..435f87a06e4 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -817,7 +817,6 @@ operator_length_standard (const struct expression *expr, int endpos,
break;
case OP_FUNCALL:
- case OP_F77_UNDETERMINED_ARGLIST:
oplen = 3;
args = 1 + longest_to_int (expr->elts[endpos - 2].longconst);
break;
diff --git a/gdb/parser-defs.h b/gdb/parser-defs.h
index a9b8a12959b..bc6fc2f9ba3 100644
--- a/gdb/parser-defs.h
+++ b/gdb/parser-defs.h
@@ -338,6 +338,13 @@ extern int dump_subexp (struct expression *, struct ui_file *, int);
extern int dump_subexp_body_standard (struct expression *,
struct ui_file *, int);
+/* Dump (to STREAM) a function call like expression at position ELT in the
+ expression array EXP. Return a new value for ELT just after the
+ function call expression. */
+
+extern int dump_subexp_body_funcall (struct expression *exp,
+ struct ui_file *stream, int elt);
+
extern void operator_length (const struct expression *, int, int *, int *);
extern void operator_length_standard (const struct expression *, int, int *,
@@ -440,6 +447,15 @@ extern void print_subexp (struct expression *, int *, struct ui_file *,
extern void print_subexp_standard (struct expression *, int *,
struct ui_file *, enum precedence);
+/* Print a function call like expression to STREAM. This is called as a
+ helper function by which point the expression node identifying this as a
+ function call has already been stripped off and POS should point to the
+ number of function call arguments. EXP is the object containing the
+ list of expression elements. */
+
+extern void print_subexp_funcall (struct expression *exp, int *pos,
+ struct ui_file *stream);
+
/* Function used to avoid direct calls to fprintf
in the code generated by the bison parser. */
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index e969bdccaed..6f90875f477 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -168,14 +168,6 @@ OP (OP_FUNCALL)
pointer. This is an Objective C message. */
OP (OP_OBJC_MSGCALL)
-/* This is EXACTLY like OP_FUNCALL but is semantically different.
- In F77, array subscript expressions, substring expressions and
- function calls are all exactly the same syntactically. They
- may only be disambiguated at runtime. Thus this operator,
- which indicates that we have found something of the form
- <name> ( <stuff> ). */
-OP (OP_F77_UNDETERMINED_ARGLIST)
-
/* OP_COMPLEX takes a type in the following element, followed by another
OP_COMPLEX, making three exp_elements. It is followed by two double
args, and converts them into a complex number of the given type. */
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 07/10] gdb/fortran: Change whitespace when printing arrays
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
` (5 preceding siblings ...)
2020-08-26 14:49 ` [PATCHv2 06/10] gdb/fortran: Move Fortran expression handling into f-lang.c Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-09-19 8:54 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 08/10] gdb: Convert enum range_type to a bit field enum Andrew Burgess
` (3 subsequent siblings)
10 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
This commit makes the whitespace usage when printing Fortran arrays
more consistent, and more inline with how we print C arrays.
Currently a 2 dimensional Fotran array is printed like this, I find
the marked whitespace unpleasant:
(( 1, 2, 3) ( 4, 5, 6) )
^ ^ ^
After this commit the same array is printed like this:
((1, 2, 3) (4, 5, 6))
Which seems more inline with how we print C arrays, in the case of C
arrays we don't add extra whitespace before the first element.
gdb/ChangeLog:
* f-valprint.c (f77_print_array_1): Adjust printing of whitespace
for arrays.
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices.exp: Update expected results.
* gdb.fortran/class-allocatable-array.exp: Likewise.
* gdb.fortran/multi-dim.exp: Likewise.
* gdb.fortran/vla-type.exp: Likewise.
* gdb.mi/mi-vla-fortran.exp: Likewise.
---
gdb/ChangeLog | 5 +++++
gdb/f-valprint.c | 7 +++++--
gdb/testsuite/ChangeLog | 8 ++++++++
gdb/testsuite/gdb.fortran/array-slices.exp | 16 ++++++++--------
.../gdb.fortran/class-allocatable-array.exp | 2 +-
gdb/testsuite/gdb.fortran/multi-dim.exp | 2 +-
gdb/testsuite/gdb.fortran/vla-type.exp | 6 +++---
gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 2 +-
8 files changed, 32 insertions(+), 16 deletions(-)
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index fabdf458616..3973984542c 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -137,14 +137,17 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
(TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
+ offs, addr + offs);
- fprintf_filtered (stream, "( ");
+ fprintf_filtered (stream, "(");
f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
value_contents_for_printing (subarray),
value_embedded_offset (subarray),
value_address (subarray),
stream, recurse, subarray, options, elts);
offs += byte_stride;
- fprintf_filtered (stream, ") ");
+ fprintf_filtered (stream, ")");
+
+ if (i < upperbound)
+ fprintf_filtered (stream, " ");
}
if (*elts >= options->print_max && i < upperbound)
fprintf_filtered (stream, "...");
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index 4ca1db90f7f..8587c51e990 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -38,14 +38,14 @@ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
set array_contents \
[list \
- " = \\(\\( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\( 11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\( 21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\( 31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\( 41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\( 51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\( 61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\( 71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\( 81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\( 91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\) \\)" \
- " = \\(\\( 1, 2, 3, 4, 5\\) \\( 11, 12, 13, 14, 15\\) \\( 21, 22, 23, 24, 25\\) \\( 31, 32, 33, 34, 35\\) \\( 41, 42, 43, 44, 45\\) \\)" \
- " = \\(\\( 1, 3, 5, 7, 9\\) \\( 21, 23, 25, 27, 29\\) \\( 41, 43, 45, 47, 49\\) \\( 61, 63, 65, 67, 69\\) \\( 81, 83, 85, 87, 89\\) \\)" \
- " = \\(\\( 1, 4, 7, 10\\) \\( 21, 24, 27, 30\\) \\( 41, 44, 47, 50\\) \\( 61, 64, 67, 70\\) \\( 81, 84, 87, 90\\) \\)" \
- " = \\(\\( 1, 5, 9\\) \\( 31, 35, 39\\) \\( 61, 65, 69\\) \\( 91, 95, 99\\) \\)" \
- " = \\(\\( -26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\( -19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\( -12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\( -5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\( 2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\( 9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\( 16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\( 23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\( 30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\( 37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\) \\)" \
- " = \\(\\( -26, -25, -24, -23, -22, -21\\) \\( -19, -18, -17, -16, -15, -14\\) \\( -12, -11, -10, -9, -8, -7\\) \\)" \
- " = \\(\\( -26, -24, -22, -20, -18\\) \\( -5, -3, -1, 1, 3\\) \\( 16, 18, 20, 22, 24\\) \\( 37, 39, 41, 43, 45\\) \\)" ]
+ " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
+ " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
+ " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
+ " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
+ " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
+ " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
+ " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
+ " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
set message_strings \
[list \
diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
index 9475ba3b393..cdee73ff5cb 100644
--- a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
+++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
@@ -40,4 +40,4 @@ gdb_continue_to_breakpoint "Break Here"
# cetainly going to fail.
gdb_test "print this" " = \\( _data = \[^\r\n\]+, _vptr = \[^\r\n\]+\\)"
gdb_test "print this%_data" " = \\(PTR TO -> \\( Type test_type \\)\\) \[^\r\n\]+"
-gdb_test "print this%_data%b" " = \\(\\( 1, 2, 3\\) \\( 4, 5, 6\\) \\)"
+gdb_test "print this%_data%b" " = \\(\\(1, 2, 3\\) \\(4, 5, 6\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/multi-dim.exp b/gdb/testsuite/gdb.fortran/multi-dim.exp
index ef6c6da8bd5..8cb419a0a7e 100644
--- a/gdb/testsuite/gdb.fortran/multi-dim.exp
+++ b/gdb/testsuite/gdb.fortran/multi-dim.exp
@@ -57,7 +57,7 @@ gdb_test "print foo(3,3,4)" \
"print an invalid array index (3,3,4)"
gdb_test "print foo" \
- { = \(\( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 20\) \) \)} \
+ { = \(\(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 20\)\)\)} \
"print full contents of the array"
gdb_breakpoint [gdb_get_line_number "break-variable"]
diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
index e2b8d71b4cb..dbf85bb13d9 100755
--- a/gdb/testsuite/gdb.fortran/vla-type.exp
+++ b/gdb/testsuite/gdb.fortran/vla-type.exp
@@ -66,9 +66,9 @@ gdb_test "ptype twov" \
"\\s+$int, allocatable :: ivla1\\\(5,12,99\\\)" \
"\\s+$int, allocatable :: ivla2\\\(9,12\\\)" \
"End Type two" ]
-gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\
- \\\( 1, 1, 321, 1, 1\\\)\
- \\\( 1, 1, 1, 1, 1\\\) .*"
+gdb_test "print twov" " = \\\( ivla1 = \\\(\\\(\\\(1, 1, 1, 1, 1\\\)\
+ \\\(1, 1, 321, 1, 1\\\)\
+ \\\(1, 1, 1, 1, 1\\\) .*"
# Check type with attribute at beginn of type
gdb_breakpoint [gdb_get_line_number "threev-filled"]
diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
index 05e71e57ddd..e862725f48d 100644
--- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
@@ -180,7 +180,7 @@ mi_run_cmd
mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
{ "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
mi_gdb_test "590-data-evaluate-expression pvla2" \
- "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \
+ "590\\^done,value=\"\\(\\(2, 2, 2, 2, 2\\) \\(2, 2, 2, 2, 2\\)\\)\"" \
"evaluate associated vla"
mi_create_varobj_checked pvla2_associated pvla2 \
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 08/10] gdb: Convert enum range_type to a bit field enum
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
` (6 preceding siblings ...)
2020-08-26 14:49 ` [PATCHv2 07/10] gdb/fortran: Change whitespace when printing arrays Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 09/10] gdb/testsuite: Add missing expected results Andrew Burgess
` (2 subsequent siblings)
10 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
The expression range_type enum represents the following ideas:
- Lower bound is set to default,
- Upper bound is set to default,
- Upper bound is exclusive.
There are currently 6 entries in the enum to represent the combination
of all those ideas.
In a future commit I'd like to add stride information to the range,
this could in theory appear with any of the existing enum entries, so
this would take us to 12 enum entries.
This feels like its getting a little out of hand, so in this commit I
switch the range_type enum over to being a flags style enum. There's
one entry to represent no flags being set, then 3 flags to represent
the 3 ideas above. Adding stride information will require adding only
one more enum flag.
I've then gone through and updated the code to handle this change.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* expprint.c (print_subexp_standard): Update to reflect changes to
enum range_type.
(dump_subexp_body_standard): Likewise.
* expression.h (enum range_type): Convert to a bit field enum.
* f-exp.y (subrange): Update to reflect changes to enum
range_type.
* f-lang.c (value_f90_subarray): Likewise.
* parse.c (operator_length_standard): Likewise.
* rust-exp.y (rust_parser::convert_ast_to_expression): Likewise.
* rust-lang.c (rust_range): Likewise.
(rust_compute_range): Likewise.
(rust_subscript): Likewise.
---
gdb/ChangeLog | 15 +++++++++++++++
gdb/expprint.c | 49 ++++++++++++++----------------------------------
gdb/expression.h | 24 ++++++++++++------------
gdb/f-exp.y | 14 +++++++++-----
gdb/f-lang.c | 4 ++--
gdb/parse.c | 22 +++++++---------------
gdb/rust-exp.y | 21 +++++++++++++--------
gdb/rust-lang.c | 25 +++++++++++-------------
8 files changed, 83 insertions(+), 91 deletions(-)
diff --git a/gdb/expprint.c b/gdb/expprint.c
index 350f291b75e..1d8aedb1fbd 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -584,17 +584,13 @@ print_subexp_standard (struct expression *exp, int *pos,
longest_to_int (exp->elts[pc + 1].longconst);
*pos += 2;
- if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE
- || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)
+ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
fputs_filtered ("EXCLUSIVE_", stream);
fputs_filtered ("RANGE(", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
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 & RANGE_HIGH_BOUND_DEFAULT))
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
@@ -1114,36 +1110,19 @@ dump_subexp_body_standard (struct expression *exp,
longest_to_int (exp->elts[elt].longconst);
elt += 2;
- switch (range_type)
- {
- case BOTH_BOUND_DEFAULT:
- fputs_filtered ("Range '..'", stream);
- break;
- case LOW_BOUND_DEFAULT:
- fputs_filtered ("Range '..EXP'", stream);
- break;
- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- fputs_filtered ("ExclusiveRange '..EXP'", stream);
- break;
- case HIGH_BOUND_DEFAULT:
- fputs_filtered ("Range 'EXP..'", stream);
- break;
- case NONE_BOUND_DEFAULT:
- fputs_filtered ("Range 'EXP..EXP'", stream);
- break;
- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
- break;
- default:
- fputs_filtered ("Invalid Range!", stream);
- break;
- }
+ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
+ fputs_filtered ("Exclusive", stream);
+ fputs_filtered ("Range '", stream);
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ fputs_filtered ("EXP", stream);
+ fputs_filtered ("..", stream);
+ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ fputs_filtered ("EXP", stream);
+ fputs_filtered ("'", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
- if (range_type == LOW_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 5af10f05db1..9dc598984e0 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -187,20 +187,20 @@ extern void dump_prefix_expression (struct expression *, struct ui_file *);
enum range_type
{
- /* Neither the low nor the high bound was given -- so this refers to
- the entire available range. */
- BOTH_BOUND_DEFAULT,
+ /* This is a standard range. Both the lower and upper bounds are
+ defined, and the bounds are inclusive. */
+ RANGE_STANDARD = 0,
+
/* The low bound was not given and the high bound is inclusive. */
- LOW_BOUND_DEFAULT,
+ RANGE_LOW_BOUND_DEFAULT = 1 << 0,
+
/* The high bound was not given and the low bound in inclusive. */
- HIGH_BOUND_DEFAULT,
- /* Both bounds were given and both are inclusive. */
- NONE_BOUND_DEFAULT,
- /* The low bound was not given and the high bound is exclusive. */
- NONE_BOUND_DEFAULT_EXCLUSIVE,
- /* Both bounds were given. The low bound is inclusive and the high
- bound is exclusive. */
- LOW_BOUND_DEFAULT_EXCLUSIVE,
+ RANGE_HIGH_BOUND_DEFAULT = 1 << 1,
+
+ /* The high bound of this range is exclusive. */
+ RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
};
+DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
+
#endif /* !defined (EXPRESSION_H) */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 0fa18dd1860..79b6462b5aa 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -287,26 +287,30 @@ 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, RANGE_STANDARD);
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,
+ RANGE_HIGH_BOUND_DEFAULT);
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,
+ RANGE_LOW_BOUND_DEFAULT);
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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HIGH_BOUND_DEFAULT));
write_exp_elt_opcode (pstate, OP_RANGE); }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 6210522c182..9de71084b11 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -131,12 +131,12 @@ value_f90_subarray (struct value *array,
*pos += 3;
- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ if (range_type & RANGE_LOW_BOUND_DEFAULT)
low_bound = range->bounds ()->low.const_val ();
else
low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ if (range_type & RANGE_HIGH_BOUND_DEFAULT)
high_bound = range->bounds ()->high.const_val ();
else
high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
diff --git a/gdb/parse.c b/gdb/parse.c
index 435f87a06e4..e7509168c77 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -921,21 +921,13 @@ operator_length_standard (const struct expression *expr, int endpos,
range_type = (enum range_type)
longest_to_int (expr->elts[endpos - 2].longconst);
- switch (range_type)
- {
- case LOW_BOUND_DEFAULT:
- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- case HIGH_BOUND_DEFAULT:
- args = 1;
- break;
- case BOTH_BOUND_DEFAULT:
- args = 0;
- break;
- case NONE_BOUND_DEFAULT:
- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- args = 2;
- break;
- }
+ /* Assume the range has 2 arguments (low bound and high bound), then
+ reduce the argument count if any bounds are set to default. */
+ args = 2;
+ if (range_type & RANGE_LOW_BOUND_DEFAULT)
+ --args;
+ if (range_type & RANGE_HIGH_BOUND_DEFAULT)
+ --args;
break;
diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
index 4e7878f67e1..0c29824c61b 100644
--- a/gdb/rust-exp.y
+++ b/gdb/rust-exp.y
@@ -2492,24 +2492,29 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
case OP_RANGE:
{
- enum range_type kind = BOTH_BOUND_DEFAULT;
+ enum range_type kind = (RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_LOW_BOUND_DEFAULT);
if (operation->left.op != NULL)
{
convert_ast_to_expression (operation->left.op, top);
- kind = HIGH_BOUND_DEFAULT;
+ kind = RANGE_HIGH_BOUND_DEFAULT;
}
if (operation->right.op != NULL)
{
convert_ast_to_expression (operation->right.op, top);
- if (kind == BOTH_BOUND_DEFAULT)
- kind = (operation->inclusive
- ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE);
+ if (kind == (RANGE_HIGH_BOUND_DEFAULT | RANGE_LOW_BOUND_DEFAULT))
+ {
+ kind = RANGE_LOW_BOUND_DEFAULT;
+ if (!operation->inclusive)
+ kind |= RANGE_HIGH_BOUND_EXCLUSIVE;
+ }
else
{
- gdb_assert (kind == HIGH_BOUND_DEFAULT);
- kind = (operation->inclusive
- ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE);
+ gdb_assert (kind == RANGE_HIGH_BOUND_DEFAULT);
+ kind = RANGE_STANDARD;
+ if (!operation->inclusive)
+ kind |= RANGE_HIGH_BOUND_EXCLUSIVE;
}
}
else
diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
index ddd4b57d294..491297d27a6 100644
--- a/gdb/rust-lang.c
+++ b/gdb/rust-lang.c
@@ -1082,13 +1082,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
*pos += 3;
- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT
- || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(kind & RANGE_LOW_BOUND_DEFAULT))
low = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE
- || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(kind & RANGE_HIGH_BOUND_DEFAULT))
high = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT);
+ bool inclusive = !(kind & RANGE_HIGH_BOUND_EXCLUSIVE);
if (noside == EVAL_SKIP)
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
@@ -1171,13 +1169,13 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
static void
rust_compute_range (struct type *type, struct value *range,
LONGEST *low, LONGEST *high,
- enum range_type *kind)
+ range_types *kind)
{
int i;
*low = 0;
*high = 0;
- *kind = BOTH_BOUND_DEFAULT;
+ *kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
if (type->num_fields () == 0)
return;
@@ -1185,15 +1183,15 @@ 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 = RANGE_HIGH_BOUND_DEFAULT;
*low = value_as_long (value_field (range, 0));
++i;
}
if (type->num_fields () > i
&& strcmp (TYPE_FIELD_NAME (type, i), "end") == 0)
{
- *kind = (*kind == BOTH_BOUND_DEFAULT
- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
+ *kind = (*kind == (RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT)
+ ? RANGE_LOW_BOUND_DEFAULT : RANGE_STANDARD);
*high = value_as_long (value_field (range, i));
if (rust_inclusive_range_type_p (type))
@@ -1211,7 +1209,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;
+ range_types kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
LONGEST high = 0;
int want_slice = 0;
@@ -1308,8 +1306,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
else
error (_("Cannot subscript non-array type"));
- if (want_slice
- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT))
+ if (want_slice && (kind & RANGE_LOW_BOUND_DEFAULT))
low = low_bound;
if (low < 0)
error (_("Index less than zero"));
@@ -1327,7 +1324,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 & RANGE_HIGH_BOUND_DEFAULT)
high = high_bound;
if (high < 0)
error (_("High index less than zero"));
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 09/10] gdb/testsuite: Add missing expected results
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
` (7 preceding siblings ...)
2020-08-26 14:49 ` [PATCHv2 08/10] gdb: Convert enum range_type to a bit field enum Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-09-18 9:53 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 10/10] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-09-19 9:47 ` [PATCHv3 0/2] Fortran Array Slicing and Striding Support Andrew Burgess
10 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
The tests in this script are driven from two lists of expected
results, one of the lists is missing some data so DejaGNU ends up
matching against the empty string (which passes).
This commit adds the missing expected results into the script.
I could rewrite this test to make things more robust, however, a later
commit is going to completely rewrite this test script, I'm simply
adding this here so that _before_ the rewrite the test is complete,
then if anyone ever digs into the history of this test script things
will make sense (I hope).
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices.exp: Add missing message data.
---
gdb/testsuite/ChangeLog | 4 ++++
gdb/testsuite/gdb.fortran/array-slices.exp | 5 ++++-
2 files changed, 8 insertions(+), 1 deletion(-)
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index 8587c51e990..31f95a3668d 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -53,7 +53,10 @@ set message_strings \
" = 'array \\(1:5,1:5\\)'" \
" = 'array \\(1:10:2,1:10:2\\)'" \
" = 'array \\(1:10:3,1:10:2\\)'" \
- " = 'array \\(1:10:5,1:10:3\\)'" ]
+ " = 'array \\(1:10:5,1:10:3\\)'" \
+ " = 'other'" \
+ " = 'other \\(-5:0, -2:0\\)'" \
+ " = 'other \\(-5:4:2, -2:7:3\\)'" ]
set i 0
foreach result $array_contents msg $message_strings {
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv2 10/10] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
` (8 preceding siblings ...)
2020-08-26 14:49 ` [PATCHv2 09/10] gdb/testsuite: Add missing expected results Andrew Burgess
@ 2020-08-26 14:49 ` Andrew Burgess
2020-08-26 17:02 ` Eli Zaretskii
2020-09-19 9:47 ` [PATCHv3 0/2] Fortran Array Slicing and Striding Support Andrew Burgess
10 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-08-26 14:49 UTC (permalink / raw)
To: gdb-patches
This commit brings array slice support to GDB.
WARNING: This patch contains a rather big hack which is limited to
Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More
details on this below.
This patch rewrites two areas of GDB's Fortran support, the code to
extract an array slice, and the code to print an array.
After this commit a user can, from the GDB prompt, ask for a slice of
a Fortran array and should get the correct result back. Slices can
(optionally) have the lower bound, upper bound, and a stride
specified. Slices can also have a negative stride.
Fortran has the concept of repacking array slices. Within a compiled
Fortran program if a user passes a non-contiguous array slice to a
function then the compiler may have to repack the slice, this involves
copying the elements of the slice to a new area of memory before the
call, and copying the elements back to the original array after the
call. Whether repacking occurs will depend on which version of
Fortran is being used, and what type of function is being called.
This commit adds support for both packed, and unpacked array slicing,
with the default being unpacked.
With an unpacked array slice, when the user asks for a slice of an
array GDB creates a new type that accurately describes where the
elements of the slice can be found within the original array, a
value of this type is then returned to the user. The address of an
element within the slice will be equal to the address of an element
within the original array.
A user can choose to selected packed array slices instead using:
(gdb) set fortran repack-array-slices on|off
(gdb) show fortran repack-array-slices
With packed array slices GDB creates a new type that reflects how the
elements of the slice would look if they were laid out in contiguous
memory, allocates a value of this type, and then fetches the elements
from the original array and places then into the contents buffer of
the new value.
One benefit of using packed slices over unapacked slices is the memory
usage, taking a small slice of N elements from a large array will
require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked
array will also include all of the "padding" between the
non-contiguous elements. There are new tests added that highlight
this difference.
There is also a new debugging flag added with this commit that
introduces these commands:
(gdb) set debug fortran-array-slicing on|off
(gdb) show debug fortran-array-slicing
This prints information about how the array slices are being built.
As both the repacking, and the array printing requires GDB to walk
through a multi-dimensional Fortran array visiting each element, this
commit adds the file f-array-walk.h, which introduces some
infrastructure to support this process. This means the array printing
code in f-valprint.c is significantly reduced.
The only slight issue with this commit is the "rather big hack" that I
mentioned above. This hack allows us to handle one specific case,
array slices with negative strides. This is something that I don't
believe the current GDB value contents model will allow us to
"correctly" handle, and rather than rewrite the value contents code
right now, I'm hoping to slip this hack in as a work around.
The problem is that as I see it the current value contents model
assumes that an object base address will be the lowest address within
that object, and that the contents of the object start at this base
address and occupy the TYPE_LENGTH bytes after that.
We do have the embedded_offset, which is used for C++ sub-classes,
such that an object can start at some offset from the content buffer,
however, the assumption that the object then occupies the next
TYPE_LENGTH bytes is still true within GDB.
The problem is that Fortran arrays with a negative stride don't follow
this pattern. In this case the base address of the object points to
the element with the highest address, the contents of the array then
start at some offset _before_ the base address, and proceed for one
element _past_ the base address.
This is further complicated because arrays with negative strides like
this are always dynamic types, the program being debugged has passed a
slice with a negative stride to a function, and it is only when we
actually try to look at the slice within the function that the dynamic
type is resolved, and the negative type is seen. When dealing with
dynamic types like this the address is actually stored on the _type_,
not the value, this dynamic address then overrides the value's address
in the value_address function.
I currently don't see any way to handle this address configuration
with GDB's current dynamic type and value system, which is why I've
added this hack:
When we resolve a dynamic Fortran array type, if the stride is
negative, then we adjust the base address to point to the lowest
address required by the array. The printing and slicing code is aware
of this adjustment and will correctly slice and print Fortran arrays.
Where this hack will show through to the user is if they ask for the
address of an array in their program with a negative array stride, the
address they get from GDB will not match the address that would be
computed within the Fortran program.
gdb/ChangeLog:
* Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
* NEWS: Mention new options.
* expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE.
* expression.h (enum range_type): Add RANGE_HAS_STRIDE.
* f-array-walker.h: New file.
* f-exp.y (arglist): Allow for a series of subranges.
(subrange): Add cases for subranges with strides.
* f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
(repack_array_slices): New static global.
(show_repack_array_slices): New function.
(fortran_array_slicing_debug): New static global.
(show_fortran_array_slicing_debug): New function.
(value_f90_subarray): Delete.
(skip_undetermined_arglist): Delete.
(class fortran_array_repacker_base_impl): New class.
(class fortran_lazy_array_repacker_impl): New class.
(class fortran_array_repacker_impl): New class.
(fortran_value_subarray): Complete rewrite.
(set_fortran_list): New static global.
(show_fortran_list): Likewise.
(_initialize_f_language): Register new commands.
(fortran_adjust_dynamic_array_base_address_hack): New function.
* f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
Declare.
* f-valprint.c: Include 'f-array-walker.h'.
(class fortran_array_printer_impl): New class.
(f77_print_array_1): Delete.
(f77_print_array): Delete.
(fortran_print_array): New.
(f_value_print_inner): Update to call fortran_print_array.
* gdbtypes.c: Include 'f-lang.h'.
(resolve_dynamic_type_internal): Call
fortran_adjust_dynamic_array_base_address_hack.
* parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE.
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices-bad.exp: New file.
* gdb.fortran/array-slices-bad.f90: New file.
* gdb.fortran/array-slices-sub-slices.exp: New file.
* gdb.fortran/array-slices-sub-slices.f90: New file.
* gdb.fortran/array-slices.exp: Rewrite tests.
* gdb.fortran/array-slices.f90: Rewrite tests.
* gdb.fortran/vla-sizeof.exp: Correct expected results.
gdb/doc/ChangeLog:
* gdb.texinfo (Debugging Output): Document 'set/show debug
fotran-array-slicing'.
(Special Fortran Commands): Document 'set/show fortran
repack-array-slices'.
---
gdb/ChangeLog | 37 +
gdb/Makefile.in | 1 +
gdb/NEWS | 13 +
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 30 +
gdb/expprint.c | 4 +
gdb/expression.h | 3 +
gdb/f-array-walker.h | 255 +++++++
gdb/f-exp.y | 38 +
gdb/f-lang.c | 704 ++++++++++++++++--
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 190 ++---
gdb/gdbtypes.c | 12 +-
gdb/parse.c | 2 +
gdb/testsuite/ChangeLog | 10 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 ++
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 267 ++++++-
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
22 files changed, 2048 insertions(+), 230 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
diff --git a/gdb/Makefile.in b/gdb/Makefile.in
index dbede7a9cfc..5bd8751cf1e 100644
--- a/gdb/Makefile.in
+++ b/gdb/Makefile.in
@@ -1269,6 +1269,7 @@ HFILES_NO_SRCDIR = \
expression.h \
extension.h \
extension-priv.h \
+ f-array-walker.h \
f-lang.h \
fbsd-nat.h \
fbsd-tdep.h \
diff --git a/gdb/NEWS b/gdb/NEWS
index 45bd23526d6..03d841fbbc2 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -109,6 +109,19 @@ maintenance print core-file-backed-mappings
Prints file-backed mappings loaded from a core file's note section.
Output is expected to be similar to that of "info proc mappings".
+set debug fortran-array-slicing on|off
+show debug fortran-array-slicing
+ Print debugging when taking slices of Fortran arrays.
+
+set fortran repack-array-slices on|off
+show fortran repack-array-slices
+ When taking slices from Fortran arrays and strings, if the slice is
+ non-contiguous within the original value then, when this option is
+ on, the new value will be repacked into a single contiguous value.
+ When this option is off then the value returned will consist of a
+ descriptor that describes the slice within the memory of the
+ original parent value.
+
* Changed commands
alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...]
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index 77c5d895053..23f66d4e259 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -16919,6 +16919,29 @@
block whose name is @var{common-name}. With no argument, the names of
all @code{COMMON} blocks visible at the current program location are
printed.
+@cindex arrays slices (Fortran)
+@kindex set fortran repack-array-slices
+@kindex show fortran repack-array-slices
+@item set fortran repack-array-slices [on|off]
+@item show fortran repack-array-slices
+When taking a slice from an array a Fortran compiler can choose to
+either produce an array descriptor that describes the slice in place,
+or it may repack the slice, copying the elements of the slice into a
+new region of memory.
+
+When this setting is on then @value{GDBN} will also repack array
+slices in some situations. When this setting is off then @value{GDBN}
+will create array descriptors for slices that reference the original
+data in place.
+
+@value{GDBN} will never repack an array slice if the data for the
+slice is contiguous within the original array.
+
+@value{GDBN} will always repack string slices if the data for the
+slice is non-contiguous within the original string as @value{GDBN}
+does not support printing non-contiguous strings.
+
+The default for this setting is @code{off}.
@end table
@node Pascal
@@ -26486,6 +26509,13 @@
Turns on or off debugging messages from the FreeBSD native target.
@item show debug fbsd-nat
Show the current state of FreeBSD native target debugging messages.
+@item set debug fortran-array-slicing
+@cindex fortran array slicing debugging info
+Turns on or off display of @value{GDBN} Fortran array slicing
+debugging info. The default is off.
+@item show debug fortran-array-slicing
+Displays the current state of displaying @value{GDBN} Fortran array
+slicing debugging info.
@item set debug frame
@cindex frame debugging info
Turns on or off display of @value{GDBN} frame debugging info. The
diff --git a/gdb/expprint.c b/gdb/expprint.c
index 1d8aedb1fbd..5162eb33996 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -1118,12 +1118,16 @@ dump_subexp_body_standard (struct expression *exp,
fputs_filtered ("..", stream);
if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
fputs_filtered ("EXP", stream);
+ if (range_type & RANGE_HAS_STRIDE)
+ fputs_filtered (":EXP", stream);
fputs_filtered ("'", stream);
if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
+ if (range_type & RANGE_HAS_STRIDE)
+ elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 9dc598984e0..4d712a7735c 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -199,6 +199,9 @@ enum range_type
/* The high bound of this range is exclusive. */
RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
+
+ /* The range has a stride. */
+ RANGE_HAS_STRIDE = 1 << 3,
};
DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h
new file mode 100644
index 00000000000..395c26e5350
--- /dev/null
+++ b/gdb/f-array-walker.h
@@ -0,0 +1,255 @@
+/* Copyright (C) 2020 Free Software Foundation, Inc.
+
+ This file is part of GDB.
+
+ 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/>. */
+
+/* Support classes to wrap up the process of iterating over a
+ multi-dimensional Fortran array. */
+
+#ifndef F_ARRAY_WALKER_H
+#define F_ARRAY_WALKER_H
+
+#include "defs.h"
+#include "gdbtypes.h"
+#include "f-lang.h"
+
+/* Class for calculating the byte offset for elements within a single
+ dimension of a Fortran array. */
+class fortran_array_offset_calculator
+{
+public:
+ /* Create a new offset calculator for TYPE, which is either an array or a
+ string. */
+ fortran_array_offset_calculator (struct type *type)
+ {
+ /* Validate the type. */
+ type = check_typedef (type);
+ if (type->code () != TYPE_CODE_ARRAY
+ && (type->code () != TYPE_CODE_STRING))
+ error (_("can only compute offsets for arrays and strings"));
+
+ /* Get the range, and extract the bounds. */
+ struct type *range_type = type->index_type ();
+ if (get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound) < 0)
+ error ("unable to read array bounds");
+
+ /* Figure out the stride for this array. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ m_stride = type->index_type ()->bounds ()->bit_stride ();
+ if (m_stride == 0)
+ m_stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ m_stride /= (unit_size * 8);
+ }
+ };
+
+ /* Get the byte offset for element INDEX within the type we are working
+ on. There is no bounds checking done on INDEX. If the stride is
+ negative then we still assume that the base address (for the array
+ object) points to the element with the lowest memory address, we then
+ calculate an offset assuming that index 0 will be the element at the
+ highest address, index 1 the next highest, and so on. This is not
+ quite how Fortran works in reality; in reality the base address of
+ the object would point at the element with the highest address, and
+ we would index backwards from there in the "normal" way, however,
+ GDB's current value contents model doesn't support having the base
+ address be near to the end of the value contents, so we currently
+ adjust the base address of Fortran arrays with negative strides so
+ their base address points at the lowest memory address. This code
+ here is part of working around this weirdness. */
+ LONGEST index_offset (LONGEST index)
+ {
+ LONGEST offset;
+ if (m_stride < 0)
+ offset = std::abs (m_stride) * (m_upperbound - index);
+ else
+ offset = std::abs (m_stride) * (index - m_lowerbound);
+ return offset;
+ }
+
+private:
+
+ /* The stride for the type we are working with. */
+ LONGEST m_stride;
+
+ /* The upper bound for the type we are working with. */
+ LONGEST m_upperbound;
+
+ /* The lower bound for the type we are working with. */
+ LONGEST m_lowerbound;
+};
+
+/* A base class used by fortran_array_walker. */
+class fortran_array_walker_base_impl
+{
+public:
+ /* Constructor. */
+ explicit fortran_array_walker_base_impl ()
+ { /* Nothing. */ }
+
+ /* Called when iterating between the lower and upper bounds of each
+ dimension of the array. Return true if GDB should continue iterating,
+ otherwise, return false.
+
+ SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
+ be taken into consideration when deciding what to return. If
+ SHOULD_CONTINUE is false then this function must also return false,
+ the function is still called though in case extra work needs to be
+ done as part of the stopping process. */
+ bool continue_walking (bool should_continue)
+ { return should_continue; }
+
+ /* Called when GDB starts iterating over a dimension of the array. This
+ function will be called once for each of the bounds in this dimension.
+ DIM is the current dimension number, NDIM is the total number of
+ dimensions, and FIRST_P is true for the first bound of this
+ dimension, and false in all other cases. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ { /* Nothing. */ }
+
+ /* Called when GDB finishes iterating over a dimension of the array.
+ This function will be called once for each of the bounds in this
+ dimension. DIM is the current dimension number, NDIM is the total
+ number of dimensions, and LAST_P is true for the last bound of this
+ dimension, and false in all other cases. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ { /* Nothing. */ }
+
+ /* Called when processing the inner most dimension of the array, for
+ every element in the array. PARENT_VALUE is the value from which
+ elements are being extracted, ELT_TYPE is the type of the element
+ being extracted, and ELT_OFF is the offset of the element from the
+ start of PARENT_VALUE. */
+ void process_element (struct value *parent_value, struct type *elt_type,
+ LONGEST elt_off)
+ { /* Nothing. */ }
+};
+
+/* A class to wrap up the process of iterating over a multi-dimensional
+ Fortran array. IMPL is used to specialise what happens as we walk over
+ the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
+ methods than can be used to customise the array walk. */
+template<typename Impl>
+class fortran_array_walker
+{
+ /* Ensure that Impl is derived from the required base class. This just
+ ensures that all of the required API methods are available and have a
+ sensible default implementation. */
+ gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
+
+public:
+ /* Create a new array walker. TYPE is the type of the array being walked
+ over, and ADDRESS is the base address for the object of TYPE in
+ memory. All other arguments are forwarded to the constructor of the
+ template parameter class IMPL. */
+ template <typename ...Args>
+ fortran_array_walker (struct type *type, CORE_ADDR address,
+ Args... args)
+ : m_type (type),
+ m_address (address),
+ m_impl (type, address, args...)
+ {
+ m_ndimensions = calc_f77_array_dims (m_type);
+ }
+
+ /* Walk the array. */
+ void
+ walk ()
+ {
+ walk_1 (1, m_type, 0);
+ }
+
+private:
+ /* The core of the array walking algorithm. NSS is the current
+ dimension number being processed, TYPE is the type of this dimension,
+ and OFFSET is the offset (in bytes) for the start of this dimension. */
+ void
+ walk_1 (int nss, struct type *type, int offset)
+ {
+ /* Extract the range, and get lower and upper bounds. */
+ struct type *range_type = check_typedef (type)->index_type ();
+ LONGEST lowerbound, upperbound;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* CALC is used to calculate the offsets for each element in this
+ dimension. */
+ fortran_array_offset_calculator calc (type);
+
+ if (nss != m_ndimensions)
+ {
+ /* For dimensions other than the inner most, walk each element and
+ recurse while peeling off one more dimension of the array. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ m_impl.start_dimension (nss, m_ndimensions, (i == lowerbound));
+
+ /* Use the index and the stride to work out a new offset. */
+ LONGEST new_offset = offset + calc.index_offset (i);
+
+ /* Now print the lower dimension. */
+ struct type *subarray_type
+ = TYPE_TARGET_TYPE (check_typedef (type));
+ walk_1 (nss + 1, subarray_type, new_offset);
+
+ m_impl.finish_dimension (nss, m_ndimensions, (i == upperbound));
+ }
+ }
+ else
+ {
+ /* For the inner most dimension of the array, process each element
+ within this dimension. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ m_impl.start_dimension (nss, m_ndimensions, (i == lowerbound));
+
+ LONGEST elt_off = offset + calc.index_offset (i);
+
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ if (is_dynamic_type (elt_type))
+ {
+ CORE_ADDR e_address = m_address + elt_off;
+ elt_type = resolve_dynamic_type (elt_type, {}, e_address);
+ }
+
+ m_impl.process_element (elt_type, elt_off);
+
+ m_impl.finish_dimension (nss, m_ndimensions, (i == upperbound));
+ }
+ }
+ }
+
+ /* The array type being processed. */
+ struct type *m_type;
+
+ /* The address in target memory for the object of M_TYPE being
+ processed. This is required in order to resolve dynamic types. */
+ CORE_ADDR m_address;
+
+ /* An instance of the template specialisation class. */
+ Impl m_impl;
+
+ /* The total number of dimensions in M_TYPE. */
+ int m_ndimensions;
+};
+
+#endif /* F_ARRAY_WALKER_H */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 79b6462b5aa..c7d20547feb 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -284,6 +284,10 @@ arglist : arglist ',' exp %prec ABOVE_COMMA
{ pstate->arglist_len++; }
;
+arglist : arglist ',' subrange %prec ABOVE_COMMA
+ { pstate->arglist_len++; }
+ ;
+
/* There are four sorts of subrange types in F90. */
subrange: exp ':' exp %prec ABOVE_COMMA
@@ -314,6 +318,40 @@ subrange: ':' %prec ABOVE_COMMA
write_exp_elt_opcode (pstate, OP_RANGE); }
;
+/* And each of the four subrange types can also have a stride. */
+subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (pstate, OP_RANGE);
+ write_exp_elt_longcst (pstate,
+ (RANGE_STANDARD
+ | RANGE_HAS_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,
+ (RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_HAS_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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HAS_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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_HAS_STRIDE));
+ write_exp_elt_opcode (pstate, OP_RANGE); }
+ ;
+
complexnum: exp ',' exp
{ }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 9de71084b11..3c7fabe0498 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -36,9 +36,36 @@
#include "c-lang.h"
#include "target-float.h"
#include "gdbarch.h"
+#include "gdbcmd.h"
+#include "f-array-walker.h"
#include <math.h>
+/* Whether GDB should repack array slices created by the user. */
+static bool repack_array_slices = false;
+
+/* Implement 'show fortran repack-array-slices'. */
+static void
+show_repack_array_slices (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c, const char *value)
+{
+ fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"),
+ value);
+}
+
+/* Debugging of Fortran's array slicing. */
+static bool fortran_array_slicing_debug = false;
+
+/* Implement 'show debug fortran-array-slicing'. */
+static void
+show_fortran_array_slicing_debug (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c,
+ const char *value)
+{
+ fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"),
+ value);
+}
+
/* Local functions */
/* Return the encoding that should be used for the character type
@@ -114,49 +141,6 @@ enum f_primitive_types {
nr_f_primitive_types
};
-/* Called from fortran_value_subarray to take a slice of an array or a
- string. ARRAY is the array or string to be accessed. EXP, POS, and
- NOSIDE are as for evaluate_subexp_standard. Return a value that is a
- slice of the array. */
-
-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 (value_type (array)->index_type ());
- enum range_type range_type
- = (enum range_type) longest_to_int (exp->elts[pc].longconst);
-
- *pos += 3;
-
- if (range_type & RANGE_LOW_BOUND_DEFAULT)
- low_bound = range->bounds ()->low.const_val ();
- else
- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
-
- if (range_type & RANGE_HIGH_BOUND_DEFAULT)
- high_bound = range->bounds ()->high.const_val ();
- else
- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
-
- return value_slice (array, low_bound, high_bound - low_bound + 1);
-}
-
-/* Helper for skipping all the arguments in an undetermined argument list.
- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
- case of evaluate_subexp_standard as multiple, but not all, code paths
- require a generic skip. */
-
-static void
-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
- enum noside noside)
-{
- for (int i = 0; i < nargs; ++i)
- evaluate_subexp (NULL_TYPE, exp, pos, noside);
-}
-
/* Return the number of dimensions for a Fortran array or string. */
int
@@ -181,6 +165,145 @@ calc_f77_array_dims (struct type *array_type)
return ndimen;
}
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This is a base class for two alternative repacking mechanisms,
+ one for when repacking from a lazy value, and one for repacking from a
+ non-lazy (already loaded) value. */
+class fortran_array_repacker_base_impl
+ : public fortran_array_walker_base_impl
+{
+public:
+ /* Constructor, DEST is the value we are repacking into. */
+ fortran_array_repacker_base_impl (struct value *dest)
+ : m_dest (dest),
+ m_dest_offset (0)
+ { /* Nothing. */ }
+
+ /* When we start processing the inner most dimension, this is where we
+ will be creating values for each element as we load them and then copy
+ them into the M_DEST value. Set a value mark so we can free these
+ temporary values. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ {
+ if (dim == ndim && first_p)
+ {
+ gdb_assert (m_mark == nullptr);
+ m_mark = value_mark ();
+ }
+ }
+
+ /* When we finish processing the inner most dimension free all temporary
+ value that were created. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ {
+ if (dim == ndim && last_p)
+ {
+ gdb_assert (m_mark != nullptr);
+ value_free_to_mark (m_mark);
+ m_mark = nullptr;
+ }
+ }
+
+protected:
+ /* Copy the contents of array element ELT into M_DEST at the next
+ available offset. */
+ void copy_element_to_dest (struct value *elt)
+ {
+ value_contents_copy (m_dest, m_dest_offset, elt, 0,
+ TYPE_LENGTH (value_type (elt)));
+ m_dest_offset += TYPE_LENGTH (value_type (elt));
+ }
+
+ /* The value being written to. */
+ struct value *m_dest;
+
+ /* The byte offset in M_DEST at which the next element should be
+ written. */
+ LONGEST m_dest_offset;
+
+ /* Set with a call to VALUE_MARK, and then reset after calling
+ VALUE_FREE_TO_MARK. */
+ struct value *m_mark = nullptr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ lazy array value, as such it does not require the parent array value to
+ be loaded into GDB's memory; the parent value could be huge, while the
+ slice could be tiny. */
+class fortran_lazy_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type of the slice being loaded from the
+ parent value, so this type will correctly reflect the strides required
+ to find all of the elements from the parent value. ADDRESS is the
+ address in target memory of value matching TYPE, and DEST is the value
+ we are repacking into. */
+ explicit fortran_lazy_array_repacker_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_addr (address)
+ { /* Nothing. */ }
+
+ /* Create a lazy value in target memory representing a single element,
+ then load the element into GDB's memory and copy the contents into the
+ destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off));
+ }
+
+private:
+ /* The address in target memory where the parent value starts. */
+ CORE_ADDR m_addr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ previously loaded (non-lazy) array value, as such it fetches the
+ element values from the contents of the parent value. */
+class fortran_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type for the array slice within the parent
+ value, as such it has stride values as required to find the elements
+ within the original parent value. ADDRESS is the address in target
+ memory of the value matching TYPE. BASE_OFFSET is the offset from
+ the start of VAL's content buffer to the start of the object of TYPE,
+ VAL is the parent object from which we are loading the value, and
+ DEST is the value into which we are repacking. */
+ explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address,
+ LONGEST base_offset,
+ struct value *val, struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_base_offset (base_offset),
+ m_val (val)
+ {
+ gdb_assert (!value_lazy (val));
+ }
+
+ /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF)
+ from the content buffer of M_VAL then copy this extracted value into
+ the repacked destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ struct value *elt
+ = value_from_component (m_val, elt_type, (elt_off + m_base_offset));
+ copy_element_to_dest (elt);
+ }
+
+private:
+ /* The offset into the content buffer of M_VAL to the start of the slice
+ being extracted. */
+ LONGEST m_base_offset;
+
+ /* The parent value from which we are extracting a slice. */
+ struct value *m_val;
+};
+
/* Called from evaluate_subexp_standard to perform array indexing, and
sub-range extraction, for Fortran. As well as arrays this function
also handles strings as they can be treated like arrays of characters.
@@ -192,51 +315,394 @@ static struct value *
fortran_value_subarray (struct value *array, struct expression *exp,
int *pos, int nargs, enum noside noside)
{
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (array, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
+ type *original_array_type = check_typedef (value_type (array));
+ bool is_string_p = original_array_type->code () == TYPE_CODE_STRING;
+
+ /* Perform checks for ARRAY not being available. The somewhat overly
+ complex logic here is just to keep backward compatibility with the
+ errors that we used to get before FORTRAN_VALUE_SUBARRAY was
+ rewritten. Maybe a future task would streamline the error messages we
+ get here, and update all the expected test results. */
+ if (exp->elts[*pos].opcode != OP_RANGE)
{
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return array;
+ if (type_not_associated (original_array_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (original_array_type))
+ error (_("no such vector element (vector not allocated)"));
+ }
+ else
+ {
+ if (type_not_associated (original_array_type))
+ error (_("array not associated"));
+ else if (type_not_allocated (original_array_type))
+ error (_("array not allocated"));
}
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1;
- struct type *type = check_typedef (value_type (array));
+ /* First check that the number of dimensions in the type we are slicing
+ matches the number of arguments we were passed. */
+ int ndimensions = calc_f77_array_dims (original_array_type);
+ if (nargs != ndimensions)
+ error (_("Wrong number of subscripts"));
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+ /* This will be initialised below with the type of the elements held in
+ ARRAY. */
+ struct type *inner_element_type;
+
+ /* Extract the types of each array dimension from the original array
+ type. We need these available so we can fill in the default upper and
+ lower bounds if the user requested slice doesn't provide that
+ information. Additionally unpacking the dimensions like this gives us
+ the inner element type. */
+ std::vector<struct type *> dim_types;
+ {
+ dim_types.reserve (ndimensions);
+ struct type *type = original_array_type;
+ for (int i = 0; i < ndimensions; ++i)
+ {
+ dim_types.push_back (type);
+ type = TYPE_TARGET_TYPE (type);
+ }
+ /* TYPE is now the inner element type of the array, we start the new
+ array slice off as this type, then as we process the requested slice
+ (from the user) we wrap new types around this to build up the final
+ slice type. */
+ inner_element_type = type;
+ }
- ndimensions = calc_f77_array_dims (type);
+ /* As we analyse the new slice type we need to understand if the data
+ being referenced is contiguous. Do decide this we must track the size
+ of an element at each dimension of the new slice array. Initially the
+ elements of the inner most dimension of the array are the same inner
+ most elements as the original ARRAY. */
+ LONGEST slice_element_size = TYPE_LENGTH (inner_element_type);
+
+ /* Start off assuming all data is contiguous, this will be set to false
+ if access to any dimension results in non-contiguous data. */
+ bool is_all_contiguous = true;
+
+ /* The TOTAL_OFFSET is the distance in bytes from the start of the
+ original ARRAY to the start of the new slice. This is calculated as
+ we process the information from the user. */
+ LONGEST total_offset = 0;
+
+ /* A structure representing information about each dimension of the
+ resulting slice. */
+ struct slice_dim
+ {
+ /* Constructor. */
+ slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx)
+ : low (l),
+ high (h),
+ stride (s),
+ index (idx)
+ { /* Nothing. */ }
+
+ /* The low bound for this dimension of the slice. */
+ LONGEST low;
+
+ /* The high bound for this dimension of the slice. */
+ LONGEST high;
+
+ /* The byte stride for this dimension of the slice. */
+ LONGEST stride;
+
+ struct type *index;
+ };
+
+ /* The dimensions of the resulting slice. */
+ std::vector<slice_dim> slice_dims;
+
+ /* Process the incoming arguments. These arguments are in the reverse
+ order to the array dimensions, that is the first argument refers to
+ the last array dimension. */
+ if (fortran_array_slicing_debug)
+ debug_printf ("Processing array access:\n");
+ for (int i = 0; i < nargs; ++i)
+ {
+ /* For each dimension of the array the user will have either provided
+ a ranged access with optional lower bound, upper bound, and
+ stride, or the user will have supplied a single index. */
+ struct type *dim_type = dim_types[ndimensions - (i + 1)];
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ {
+ int pc = (*pos) + 1;
+ enum range_type range_type = (enum range_type) exp->elts[pc].longconst;
+ *pos += 3;
+
+ LONGEST low, high, stride;
+ low = high = stride = 0;
+
+ if ((range_type & RANGE_LOW_BOUND_DEFAULT) == 0)
+ low = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ else
+ low = f77_get_lowerbound (dim_type);
+ if ((range_type & RANGE_HIGH_BOUND_DEFAULT) == 0)
+ high = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ else
+ high = f77_get_upperbound (dim_type);
+ if ((range_type & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
+ stride = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ else
+ stride = 1;
+
+ if (stride == 0)
+ error (_("stride must not be 0"));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride ();
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type) * 8;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Range access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Bit stride: %ld\n", sd);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd / 8);
+ debug_printf ("| | |-> Type size: %ld\n",
+ TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| |-> Accessing:\n");
+ debug_printf ("| | |-> Low bound: %ld\n",
+ low);
+ debug_printf ("| | |-> High bound: %ld\n",
+ high);
+ debug_printf ("| | '-> Element stride: %ld\n",
+ stride);
+ }
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
+ /* Check the user hasn't asked for something invalid. */
+ if (high > ub || low < lb)
+ error (_("array subscript out of bounds"));
+
+ /* Calculate what this dimension of the new slice array will look
+ like. OFFSET is the byte offset from the start of the
+ previous (more outer) dimension to the start of this
+ dimension. E_COUNT is the number of elements in this
+ dimension. REMAINDER is the number of elements remaining
+ between the last included element and the upper bound. For
+ example an access '1:6:2' will include elements 1, 3, 5 and
+ have a remainder of 1 (element #6). */
+ LONGEST lowest = std::min (low, high);
+ LONGEST offset = (sd / 8) * (lowest - lb);
+ LONGEST e_count = std::abs (high - low) + 1;
+ e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride);
+ LONGEST new_low = 1;
+ LONGEST new_high = new_low + e_count - 1;
+ LONGEST new_stride = (sd * stride) / 8;
+ LONGEST last_elem = low + ((e_count - 1) * stride);
+ LONGEST remainder = high - last_elem;
+ if (low > high)
+ {
+ offset += std::abs (remainder) * TYPE_LENGTH (target_type);
+ if (stride > 0)
+ error (_("incorrect stride and boundary combination"));
+ }
+ else if (stride < 0)
+ error (_("incorrect stride and boundary combination"));
+
+ /* Is the data within this dimension contiguous? It is if the
+ newly computed stride is the same size as a single element of
+ this dimension. */
+ bool is_dim_contiguous = (new_stride == slice_element_size);
+ is_all_contiguous &= is_dim_contiguous;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("| '-> Results:\n");
+ debug_printf ("| |-> Offset = %ld\n", offset);
+ debug_printf ("| |-> Elements = %ld\n", e_count);
+ debug_printf ("| |-> Low bound = %ld\n", new_low);
+ debug_printf ("| |-> High bound = %ld\n", new_high);
+ debug_printf ("| |-> Byte stride = %ld\n", new_stride);
+ debug_printf ("| |-> Last element = %ld\n", last_elem);
+ debug_printf ("| |-> Remainder = %ld\n", remainder);
+ debug_printf ("| '-> Contiguous = %s\n",
+ (is_dim_contiguous ? "Yes" : "No"));
+ }
+
+ /* Figure out how big (in bytes) an element of this dimension of
+ the new array slice will be. */
+ slice_element_size = std::abs (new_stride * e_count);
+
+ slice_dims.emplace_back (new_low, new_high, new_stride,
+ index_type);
+
+ /* Update the total offset. */
+ total_offset += offset;
+ }
+ else
+ {
+ /* There is a single index for this dimension. */
+ LONGEST index
+ = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride () / 8;
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type);
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Index access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd);
+ debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| '-> Accessing:\n");
+ debug_printf ("| '-> Index: %ld\n", index);
+ }
- gdb_assert (nargs > 0);
+ /* If the array has actual content then check the index is in
+ bounds. An array without content (an unbound array) doesn't
+ have a known upper bound, so don't error check in that
+ situation. */
+ if (index < lb
+ || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED
+ && index > ub)
+ || (VALUE_LVAL (array) != lval_memory
+ && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED))
+ {
+ if (type_not_associated (dim_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (dim_type))
+ error (_("no such vector element (vector not allocated)"));
+ else
+ error (_("no such vector element"));
+ }
- /* Now that we know we have a legal array subscript expression let us
- actually find out where this element exists in the array. */
+ /* Calculate using the type stride, not the target type size. */
+ LONGEST offset = sd * (index - lb);
+ total_offset += offset;
+ }
+ }
- /* Take array indices left to right. */
- for (int i = 0; i < nargs; i++)
+ if (noside == EVAL_SKIP)
+ return array;
+
+ /* Build a type that represents the new array slice in the target memory
+ of the original ARRAY, this type makes use of strides to correctly
+ find only those elements that are part of the new slice. */
+ struct type *array_slice_type = inner_element_type;
+ for (const auto &d : slice_dims)
{
- /* Evaluate each subscript; it must be a legal integer in F77. */
- value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (d.stride);
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ array_slice_type
+ = create_array_type (nullptr, array_slice_type, new_range);
+ }
- /* Fill in the subscript array. */
- subscript_array[i] = value_as_long (arg2);
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("'-> Final result:\n");
+ debug_printf (" |-> Type: %s\n",
+ type_to_string (array_slice_type).c_str ());
+ debug_printf (" |-> Total offset: %ld\n", total_offset);
+ debug_printf (" |-> Base address: %s\n",
+ core_addr_to_string (value_address (array)));
+ debug_printf (" '-> Contiguous = %s\n",
+ (is_all_contiguous ? "Yes" : "No"));
}
- /* Internal type of array is arranged right to left. */
- for (int i = nargs; i > 0; i--)
+ /* Should we repack this array slice? */
+ if (!is_all_contiguous && (repack_array_slices || is_string_p))
{
- struct type *array_type = check_typedef (value_type (array));
- LONGEST index = subscript_array[i - 1];
+ /* Build a type for the repacked slice. */
+ struct type *repacked_array_type = inner_element_type;
+ for (const auto &d : slice_dims)
+ {
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (TYPE_LENGTH (repacked_array_type));
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ repacked_array_type
+ = create_array_type (nullptr, repacked_array_type, new_range);
+ }
- array = value_subscripted_rvalue (array, index,
- f77_get_lowerbound (array_type));
+ /* Now copy the elements from the original ARRAY into the packed
+ array value DEST. */
+ struct value *dest = allocate_value (repacked_array_type);
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ {
+ fortran_array_walker<fortran_lazy_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset, dest);
+ p.walk ();
+ }
+ else
+ {
+ fortran_array_walker<fortran_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset,
+ total_offset, array, dest);
+ p.walk ();
+ }
+ array = dest;
+ }
+ else
+ {
+ if (VALUE_LVAL (array) == lval_memory)
+ {
+ /* If the value we're taking a slice from is not yet loaded, or
+ the requested slice is outside the values content range then
+ just create a new lazy value pointing at the memory where the
+ contents we're looking for exist. */
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ array = value_at_lazy (array_slice_type,
+ value_address (array) + total_offset);
+ else
+ array = value_from_contents_and_address (array_slice_type,
+ (value_contents (array)
+ + total_offset),
+ (value_address (array)
+ + total_offset));
+ }
+ else if (!value_lazy (array))
+ {
+ const void *valaddr = value_contents (array) + total_offset;
+ array = allocate_value (array_slice_type);
+ memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type));
+ }
+ else
+ error (_("cannot subscript arrays that are not in memory"));
}
return array;
@@ -1023,11 +1489,50 @@ builtin_f_type (struct gdbarch *gdbarch)
return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
}
+/* Command-list for the "set/show fortran" prefix command. */
+static struct cmd_list_element *set_fortran_list;
+static struct cmd_list_element *show_fortran_list;
+
void _initialize_f_language ();
void
_initialize_f_language ()
{
f_type_data = gdbarch_data_register_post_init (build_fortran_types);
+
+ add_basic_prefix_cmd ("fortran", no_class,
+ _("Prefix command for changing Fortran-specific settings."),
+ &set_fortran_list, "set fortran ", 0, &setlist);
+
+ add_show_prefix_cmd ("fortran", no_class,
+ _("Generic command for showing Fortran-specific settings."),
+ &show_fortran_list, "show fortran ", 0, &showlist);
+
+ add_setshow_boolean_cmd ("repack-array-slices", class_vars,
+ &repack_array_slices, _("\
+Enable or disable repacking of non-contiguous array slices."), _("\
+Show whether non-contiguous array slices are repacked."), _("\
+When the user requests a slice of a Fortran array then we can either return\n\
+a descriptor that describes the array in place (using the original array data\n\
+in its existing location) or the original data can be repacked (copied) to a\n\
+new location.\n\
+\n\
+When the content of the array slice is contiguous within the original array\n\
+then the result will never be repacked, but when the data for the new array\n\
+is non-contiguous within the original array repacking will only be performed\n\
+when this setting is on."),
+ NULL,
+ show_repack_array_slices,
+ &set_fortran_list, &show_fortran_list);
+
+ /* Debug Fortran's array slicing logic. */
+ add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance,
+ &fortran_array_slicing_debug, _("\
+Set debugging of Fortran array slicing."), _("\
+Show debugging of Fortran array slicing."), _("\
+When on, debugging of Fortran array slicing is enabled."),
+ NULL,
+ show_fortran_array_slicing_debug,
+ &setdebuglist, &showdebuglist);
}
/* See f-lang.h. */
@@ -1066,3 +1571,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type)
return value_type (arg);
return type;
}
+
+/* See f-lang.h. */
+
+CORE_ADDR
+fortran_adjust_dynamic_array_base_address_hack (struct type *type,
+ CORE_ADDR address)
+{
+ gdb_assert (type->code () == TYPE_CODE_ARRAY);
+
+ int ndimensions = calc_f77_array_dims (type);
+ LONGEST total_offset = 0;
+
+ /* Walk through each of the dimensions of this array type and figure out
+ if any of the dimensions are "backwards", that is the base address
+ for this dimension points to the element at the highest memory
+ address and the stride is negative. */
+ struct type *tmp_type = type;
+ for (int i = 0 ; i < ndimensions; ++i)
+ {
+ /* Grab the range for this dimension and extract the lower and upper
+ bounds. */
+ tmp_type = check_typedef (tmp_type);
+ struct type *range_type = tmp_type->index_type ();
+ LONGEST lowerbound, upperbound, stride;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* Figure out the stride for this dimension. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
+ stride = tmp_type->index_type ()->bounds ()->bit_stride ();
+ if (stride == 0)
+ stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ stride /= (unit_size * 8);
+ }
+
+ /* If this dimension is "backward" then figure out the offset
+ adjustment required to point to the element at the lowest memory
+ address, and add this to the total offset. */
+ LONGEST offset = 0;
+ if (stride < 0 && lowerbound < upperbound)
+ offset = (upperbound - lowerbound) * stride;
+ total_offset += offset;
+ tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ }
+
+ /* Adjust the address of this object and return it. */
+ address += total_offset;
+ return address;
+}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 4710b14aa62..dee63158ff4 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -64,7 +64,6 @@ extern void f77_get_dynamic_array_length (struct type *);
extern int calc_f77_array_dims (struct type *);
-
/* Fortran (F77) types */
struct builtin_f_type
@@ -122,4 +121,22 @@ extern struct value *fortran_argument_convert (struct value *value,
extern struct type *fortran_preserve_arg_pointer (struct value *arg,
struct type *type);
+/* Fortran arrays can have a negative stride. When this happens it is
+ often the case that the base address for an object is not the lowest
+ address occupied by that object. For example, an array slice (10:1:-1)
+ will be encoded with lower bound 1, upper bound 10, a stride of
+ -ELEMENT_SIZE, and have a base address pointer that points at the
+ element with the highest address in memory.
+
+ This really doesn't play well with our current model of value contents,
+ but could easily require a significant update in order to be supported
+ "correctly".
+
+ For now, we manually force the base address to be the lowest addressed
+ element here. Yes, this will break some things, but it fixes other
+ things. The hope is that it fixes more than it breaks. */
+
+extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
+ (struct type *type, CORE_ADDR address);
+
#endif /* F_LANG_H */
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 3973984542c..e7b1d672d09 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -35,6 +35,7 @@
#include "dictionary.h"
#include "cli/cli-style.h"
#include "gdbarch.h"
+#include "f-array-walker.h"
static void f77_get_dynamic_length_of_aggregate (struct type *);
@@ -100,100 +101,110 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
* TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
}
-/* Actual function which prints out F77 arrays, Valaddr == address in
- the superior. Address == the address in the inferior. */
+/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array
+ walking template. This specialisation prints Fortran arrays. */
-static void
-f77_print_array_1 (int nss, int ndimensions, struct type *type,
- const gdb_byte *valaddr,
- int embedded_offset, CORE_ADDR address,
- struct ui_file *stream, int recurse,
- const struct value *val,
- const struct value_print_options *options,
- int *elts)
+class fortran_array_printer_impl : public fortran_array_walker_base_impl
{
- struct type *range_type = check_typedef (type)->index_type ();
- CORE_ADDR addr = address + embedded_offset;
- LONGEST lowerbound, upperbound;
- LONGEST i;
-
- get_discrete_bounds (range_type, &lowerbound, &upperbound);
-
- if (nss != ndimensions)
- {
- struct gdbarch *gdbarch = get_type_arch (type);
- size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type));
- int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
- size_t byte_stride = type->bit_stride () / (unit_size * 8);
- if (byte_stride == 0)
- byte_stride = dim_size;
- size_t offs = 0;
-
- for (i = lowerbound;
- (i < upperbound + 1 && (*elts) < options->print_max);
- i++)
- {
- struct value *subarray = value_from_contents_and_address
- (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
- + offs, addr + offs);
-
- fprintf_filtered (stream, "(");
- f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
- value_contents_for_printing (subarray),
- value_embedded_offset (subarray),
- value_address (subarray),
- stream, recurse, subarray, options, elts);
- offs += byte_stride;
- fprintf_filtered (stream, ")");
-
- if (i < upperbound)
- fprintf_filtered (stream, " ");
- }
- if (*elts >= options->print_max && i < upperbound)
- fprintf_filtered (stream, "...");
- }
- else
- {
- for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
- i++, (*elts)++)
- {
- struct value *elt = value_subscript ((struct value *)val, i);
-
- common_val_print (elt, stream, recurse, options, current_language);
-
- if (i != upperbound)
- fprintf_filtered (stream, ", ");
-
- if ((*elts == options->print_max - 1)
- && (i != upperbound))
- fprintf_filtered (stream, "...");
- }
- }
-}
+public:
+ /* Constructor. TYPE is the array type being printed, ADDRESS is the
+ address in target memory for the object of TYPE being printed. VAL is
+ the GDB value (of TYPE) being printed. STREAM is where to print to,
+ RECOURSE is passed through (and prevents infinite recursion), and
+ OPTIONS are the printing control options. */
+ explicit fortran_array_printer_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *val,
+ struct ui_file *stream,
+ int recurse,
+ const struct value_print_options *options)
+ : m_elts (0),
+ m_val (val),
+ m_stream (stream),
+ m_recurse (recurse),
+ m_options (options)
+ { /* Nothing. */ }
+
+ /* Called while iterating over the array bounds. When SHOULD_CONTINUE is
+ false then we must return false, as we have reached the end of the
+ array bounds for this dimension. However, we also return false if we
+ have printed too many elements (after printing '...'). In all other
+ cases, return true. */
+ bool continue_walking (bool should_continue)
+ {
+ bool cont = should_continue && (m_elts < m_options->print_max);
+ if (!cont && should_continue)
+ fprintf_filtered (m_stream, "...");
+ return cont;
+ }
+
+ /* Called when we start iterating over a dimension. If it's not the
+ inner most dimension then print an opening '(' character. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ {
+ if (dim != ndim)
+ fprintf_filtered (m_stream, "(");
+ }
+
+ /* Called when we finish processing a batch of items within a dimension
+ of the array. Depending on whether this is the inner most dimension
+ or not we print different things, but this is all about adding
+ separators between elements, and dimensions of the array. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ {
+ if (dim != ndim)
+ {
+ fprintf_filtered (m_stream, ")");
+ if (!last_p)
+ fprintf_filtered (m_stream, " ");
+ }
+ else
+ {
+ if (!last_p)
+ fprintf_filtered (m_stream, ", ");
+ }
+ }
+
+ /* Called to process an element of ELT_TYPE at offset ELT_OFF from the
+ start of the parent object. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ /* Extract the element value from the parent value. */
+ struct value *e_val
+ = value_from_component (m_val, elt_type, elt_off);
+ common_val_print (e_val, m_stream, m_recurse, m_options, current_language);
+ ++m_elts;
+ }
+
+private:
+ /* The number of elements printed so far. */
+ int m_elts;
+
+ /* The value from which we are printing elements. */
+ struct value *m_val;
+
+ /* The stream we should print too. */
+ struct ui_file *m_stream;
+
+ /* The recursion counter, passed through when we print each element. */
+ int m_recurse;
+
+ /* The print control options. Gives us the maximum number of elements to
+ print, and is passed through to each element that we print. */
+ const struct value_print_options *m_options = nullptr;
+};
-/* This function gets called to print an F77 array, we set up some
- stuff and then immediately call f77_print_array_1(). */
+/* This function gets called to print a Fortran array. */
static void
-f77_print_array (struct type *type, const gdb_byte *valaddr,
- int embedded_offset,
- CORE_ADDR address, struct ui_file *stream,
- int recurse,
- const struct value *val,
- const struct value_print_options *options)
+fortran_print_array (struct type *type, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ const struct value *val,
+ const struct value_print_options *options)
{
- int ndimensions;
- int elts = 0;
-
- ndimensions = calc_f77_array_dims (type);
-
- if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
- error (_("\
-Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
- ndimensions, MAX_FORTRAN_DIMS);
-
- f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
- address, stream, recurse, val, options, &elts);
+ fortran_array_walker<fortran_array_printer_impl> p
+ (type, address, (struct value *) val, stream, recurse, options);
+ p.walk ();
}
\f
@@ -238,8 +249,7 @@ f_value_print_inner (struct value *val, struct ui_file *stream, int recurse,
if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR)
{
fprintf_filtered (stream, "(");
- f77_print_array (type, valaddr, 0,
- address, stream, recurse, val, options);
+ fortran_print_array (type, address, stream, recurse, val, options);
fprintf_filtered (stream, ")");
}
else
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 64e44bfe23d..2ba03a86c51 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -39,6 +39,7 @@
#include "dwarf2/loc.h"
#include "gdbcore.h"
#include "floatformat.h"
+#include "f-lang.h"
#include <algorithm>
/* Initialize BADNESS constants. */
@@ -2619,7 +2620,16 @@ resolve_dynamic_type_internal (struct type *type,
prop = TYPE_DATA_LOCATION (resolved_type);
if (prop != NULL
&& dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
- prop->set_const_val (value);
+ {
+ /* Start of Fortran hack. See comment in f-lang.h for what is going
+ on here.*/
+ if (current_language->la_language == language_fortran
+ && resolved_type->code () == TYPE_CODE_ARRAY)
+ value = fortran_adjust_dynamic_array_base_address_hack (resolved_type,
+ value);
+ /* End of Fortran hack. */
+ prop->set_const_val (value);
+ }
return resolved_type;
}
diff --git a/gdb/parse.c b/gdb/parse.c
index e7509168c77..85cef9ba616 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -924,6 +924,8 @@ operator_length_standard (const struct expression *expr, int endpos,
/* Assume the range has 2 arguments (low bound and high bound), then
reduce the argument count if any bounds are set to default. */
args = 2;
+ if (range_type & RANGE_HAS_STRIDE)
+ ++args;
if (range_type & RANGE_LOW_BOUND_DEFAULT)
--args;
if (range_type & RANGE_HIGH_BOUND_DEFAULT)
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
new file mode 100644
index 00000000000..2583cdecc94
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
@@ -0,0 +1,69 @@
+# Copyright 2020 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/> .
+
+# Test invalid element and slice array accesses.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "First Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Second Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+gdb_continue_to_breakpoint "First Breakpoint"
+
+# Access not yet allocated array.
+gdb_test "print other" " = <not allocated>"
+gdb_test "print other(0:4,2:3)" "array not allocated"
+gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)"
+
+# Access not yet associated pointer.
+gdb_test "print pointer2d" " = <not associated>"
+gdb_test "print pointer2d(1:2,1:2)" "array not associated"
+gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)"
+
+gdb_continue_to_breakpoint "Second Breakpoint"
+
+# Accessing just outside the arrays.
+foreach name {array pointer2d other} {
+ gdb_test "print $name (0:,:)" "array subscript out of bounds"
+ gdb_test "print $name (:11,:)" "array subscript out of bounds"
+ gdb_test "print $name (:,0:)" "array subscript out of bounds"
+ gdb_test "print $name (:,:11)" "array subscript out of bounds"
+
+ gdb_test "print $name (0,:)" "no such vector element"
+ gdb_test "print $name (11,:)" "no such vector element"
+ gdb_test "print $name (:,0)" "no such vector element"
+ gdb_test "print $name (:,11)" "no such vector element"
+}
+
+# Stride in the wrong direction.
+gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination"
+gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
new file mode 100644
index 00000000000..0f3d45ab8cd
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
@@ -0,0 +1,42 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Declare variables used in this test.
+ integer, dimension (1:10,1:10) :: array
+ integer, allocatable :: other (:, :)
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(1:10,1:10), target :: tarray
+
+ print *, "" ! First Breakpoint.
+
+ ! Allocate or associate any variables as needed.
+ allocate (other (1:10, 1:10))
+ pointer2d => tarray
+ array = 0
+
+ print *, "" ! Second Breakpoint.
+
+ ! All done. Deallocate.
+ deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
new file mode 100644
index 00000000000..05b4802c678
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
@@ -0,0 +1,111 @@
+# Copyright 2020 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/> .
+
+# Create a slice of an array, then take a slice of that slice.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Stop Here"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We're going to print some reasonably large arrays.
+gdb_test_no_output "set print elements unlimited"
+
+gdb_continue_to_breakpoint "Stop Here"
+
+# Print a slice, capture the convenience variable name created.
+set cmd "print array (1:10:2, 1:10:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ }
+}
+
+# Now check that we can correctly extract all the elements from this
+# slice.
+for { set j 1 } { $j < 6 } { incr j } {
+ for { set i 1 } { $i < 6 } { incr i } {
+ set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1]
+ gdb_test "print ${varname} ($i,$j)" " = $val"
+ }
+}
+
+# Now take a slice of the slice.
+gdb_test "print ${varname} (3:5, 3:5)" \
+ " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)"
+
+# Now take a different slice of a slice.
+set cmd "print ${varname} (1:5:2, 1:5:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Now take a slice from the slice, of a slice!
+set cmd "print ${varname} (1:3:2, 1:3:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# And again!
+set cmd "print ${varname} (1:2:2, 1:2:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Test taking a slice with stride of a string. This isn't actually
+# supported within gfortran (at least), but naturally drops out of how
+# GDB models arrays and strings in a similar way, so we may as well
+# test that this is still working.
+gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'"
+gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'"
+gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'"
+
+# Now test the memory requirements of taking a slice from an array.
+# The idea is that we shouldn't require more memory to extract a slice
+# than the size of the slice.
+#
+# This will only work if array repacking is turned on, otherwise GDB
+# will create the slice by generating a new type that sits over the
+# existing value in memory.
+gdb_test_no_output "set fortran repack-array-slices on"
+set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"]
+set slice_size [expr $element_size * 4]
+gdb_test_no_output "set max-value-size $slice_size"
+gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)"
+gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)"
+gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
new file mode 100644
index 00000000000..c3530f567d4
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
@@ -0,0 +1,96 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+ integer, dimension (1:10,1:11) :: array
+ character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz"
+
+ call fill_array_2d (array)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Stop Here
+
+ print *, array
+ print *, str
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index 31f95a3668d..ff00fae886f 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -18,6 +18,21 @@
# the subroutine. This should exercise GDB's ability to handle
# different strides for the different dimensions.
+# Testing GDB's ability to print array (and string) slices, including
+# slices that make use of array strides.
+#
+# In the Fortran code various arrays of different ranks are filled
+# with data, and slices are passed to a series of show functions.
+#
+# In this test script we break in each of the show functions, print
+# the array slice that was passed in, and then move up the stack to
+# the parent frame and check GDB can manually extract the same slice.
+#
+# This test also checks that the size of the array slice passed to the
+# function (so as extracted and described by the compiler and the
+# debug information) matches the size of the slice manually extracted
+# by GDB.
+
if {[skip_fortran_tests]} { return -1 }
standard_testfile ".f90"
@@ -28,44 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
return -1
}
-if ![fortran_runto_main] {
- untested "could not run to main"
- return -1
+# Takes the name of an array slice as used in the test source, and extracts
+# the base array name. For example: 'array (1,2)' becomes 'array'.
+proc array_slice_to_var { slice_str } {
+ regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname
+ return $varname
}
-gdb_breakpoint "show"
-gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
-
-set array_contents \
- [list \
- " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
- " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
- " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
- " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
- " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
- " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
-
-set message_strings \
- [list \
- " = 'array'" \
- " = 'array \\(1:5,1:5\\)'" \
- " = 'array \\(1:10:2,1:10:2\\)'" \
- " = 'array \\(1:10:3,1:10:2\\)'" \
- " = 'array \\(1:10:5,1:10:3\\)'" \
- " = 'other'" \
- " = 'other \\(-5:0, -2:0\\)'" \
- " = 'other \\(-5:4:2, -2:7:3\\)'" ]
-
-set i 0
-foreach result $array_contents msg $message_strings {
- incr i
- with_test_prefix "test $i" {
- gdb_continue_to_breakpoint "show"
- gdb_test "p array" $result
- gdb_test "p message" "$msg"
+proc run_test { repack } {
+ global binfile gdb_prompt
+
+ clean_restart ${binfile}
+
+ if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
}
+
+ gdb_test_no_output "set fortran repack-array-slices $repack"
+
+ # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+ gdb_breakpoint [gdb_get_line_number "Display Element"]
+ gdb_breakpoint [gdb_get_line_number "Display String"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"]
+ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+ # We're going to print some reasonably large arrays.
+ gdb_test_no_output "set print elements unlimited"
+
+ set found_final_breakpoint false
+
+ # We place a limit on the number of tests that can be run, just in
+ # case something goes wrong, and GDB gets stuck in an loop here.
+ set test_count 0
+ while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ set found_final_breakpoint false
+ set expected_result ""
+ set func_name ""
+ gdb_test_multiple "continue" "continue" {
+ -re ".*GDB = (\[^\r\n\]+)\r\n" {
+ set expected_result $expect_out(1,string)
+ exp_continue
+ }
+ -re "! Display Element" {
+ set func_name "show_elem"
+ exp_continue
+ }
+ -re "! Display String" {
+ set func_name "show_str"
+ exp_continue
+ }
+ -re "! Display Array Slice (.)D" {
+ set func_name "show_$expect_out(1,string)d"
+ exp_continue
+ }
+ -re "! Final Breakpoint" {
+ set found_final_breakpoint true
+ exp_continue
+ }
+ -re "$gdb_prompt $" {
+ # We're done.
+ }
+ }
+
+ if ($found_final_breakpoint) {
+ break
+ }
+
+ # We want to take a look at the line in the previous frame that
+ # called the current function. I couldn't find a better way of
+ # doing this than 'up', which will print the line, then 'down'
+ # again.
+ #
+ # I don't want to fill the log with passes for these up/down
+ # commands, so we don't report any. If something goes wrong then we
+ # should get a fail from gdb_test_multiple.
+ set array_slice_name ""
+ set unique_id ""
+ array unset replacement_vars
+ array set replacement_vars {}
+ gdb_test_multiple "up" "up" {
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ }
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ set unique_id $expect_out(2,string)
+ }
+ }
+ if {$unique_id != ""} {
+ set str ""
+ foreach v [split $unique_id ,] {
+ set val [get_integer_valueof "${v}" "??"\
+ "get variable '$v' for '$array_slice_name'"]
+ set replacement_vars($v) $val
+ if {$str != ""} {
+ set str "Str,"
+ }
+ set str "$str$v=$val"
+ }
+ set unique_id " $str"
+ }
+ gdb_test_multiple "down" "down" {
+ -re "\r\n$gdb_prompt $" {
+ # Don't issue a pass here.
+ }
+ }
+
+ # Check we have all the information we need to successfully run one
+ # of these tests.
+ if { $expected_result == "" } {
+ perror "failed to extract expected results"
+ return 0
+ }
+ if { $array_slice_name == "" } {
+ perror "failed to extract array slice name"
+ return 0
+ }
+
+ # Check GDB can correctly print the array slice that was passed into
+ # the current frame.
+ set pattern [string_to_regexp " = $expected_result"]
+ gdb_test "p array" "$pattern" \
+ "check value of '$array_slice_name'$unique_id"
+
+ # Get the size of the slice.
+ set size_in_show \
+ [get_integer_valueof "sizeof (array)" "show_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in show"]
+ set addr_in_show \
+ [get_hexadecimal_valueof "&array" "show_unknown" \
+ "get address '$array_slice_name'$unique_id in show"]
+
+ # Now move into the previous frame, and see if GDB can extract the
+ # array slice from the original parent object. Again, use of
+ # gdb_test_multiple to avoid filling the logs with unnecessary
+ # passes.
+ gdb_test_multiple "up" "up" {
+ -re "\r\n$gdb_prompt $" {
+ # Do nothing.
+ }
+ }
+
+ # Print the array slice, this will force GDB to manually extract the
+ # slice from the parent array.
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted"
+
+ # Get the size of the slice in the calling frame.
+ set size_in_parent \
+ [get_integer_valueof "sizeof ($array_slice_name)" \
+ "parent_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in parent"]
+
+ # Figure out the start and end addresses of the full array in the
+ # parent frame.
+ set full_var_name [array_slice_to_var $array_slice_name]
+ set start_addr [get_hexadecimal_valueof "&${full_var_name}" \
+ "start unknown"]
+ set end_addr [get_hexadecimal_valueof \
+ "(&${full_var_name}) + sizeof (${full_var_name})" \
+ "end unknown"]
+
+ # The Fortran compiler can choose to either send a descriptor that
+ # describes the array slice to the subroutine, or it can repack the
+ # slice into an array section and send that.
+ #
+ # We find the address range of the original array in the parent,
+ # and the address of the slice in the show function, if the
+ # address of the slice (from show) is in the range of the original
+ # array then repacking has not occurred, otherwise, the slice is
+ # outside of the parent, and repacking must have occurred.
+ #
+ # The goal here is to compare the sizes of the slice in show with
+ # the size of the slice extracted by GDB. So we can only compare
+ # sizes when GDB's repacking setting matches the repacking
+ # behaviour we got from the compiler.
+ if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \
+ == ($repack == "on") } {
+ gdb_assert {$size_in_show == $size_in_parent} \
+ "check sizes match"
+ } elseif { $repack == "off" } {
+ # GDB's repacking is off (so slices are left unpacked), but
+ # the compiler did pack this one. As a result we can't
+ # compare the sizes between the compiler's slice and GDB's
+ # slice.
+ verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared"
+ } else {
+ # Like the above, but the reverse, GDB's repacking is on, but
+ # the compiler didn't repack this slice.
+ verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared"
+ }
+
+ # If the array name we just tested included variable names, then
+ # test again with all the variables expanded.
+ if {$unique_id != ""} {
+ foreach v [array names replacement_vars] {
+ set val $replacement_vars($v)
+ set array_slice_name \
+ [regsub "\\y${v}\\y" $array_slice_name $val]
+ }
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded"
+ }
+ }
+ }
+
+ # Ensure we reached the final breakpoint. If more tests have been added
+ # to the test script, and this starts failing, then the safety 'while'
+ # loop above might need to be increased.
+ gdb_assert {$found_final_breakpoint} "ran all tests"
}
-gdb_continue_to_breakpoint "continue to Final Breakpoint"
+foreach_with_prefix repack { on off } {
+ run_test $repack
+}
diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
index a66fa6ba784..6d75a385699 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.f90
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -13,58 +13,368 @@
! 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 show (message, array)
- character (len=*) :: message
+subroutine show_elem (array)
+ integer :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = "
+ write(*, fmt="(I0)", advance="no") array
+ write(*, fmt="(A)", advance="yes") ""
+
+ print *, "" ! Display Element
+end subroutine show_elem
+
+subroutine show_str (array)
+ character (len=*) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+ write (*, fmt="(A)", advance="no") "GDB = '"
+ write (*, fmt="(A)", advance="no") array
+ write (*, fmt="(A)", advance="yes") "'"
+
+ print *, "" ! Display String
+end subroutine show_str
+
+subroutine show_1d (array)
+ integer, dimension (:) :: array
+
+ print *, "Array Contents:"
+ print *, ""
+
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ write(*, fmt="(i4)", advance="no") array (i)
+ end do
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (i > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+
+ print *, "" ! Display Array Slice 1D
+end subroutine show_1d
+
+subroutine show_2d (array)
integer, dimension (:,:) :: array
- print *, message
+ print *, "Array Contents:"
+ print *, ""
+
do i=LBOUND (array, 2), UBOUND (array, 2), 1
do j=LBOUND (array, 1), UBOUND (array, 1), 1
write(*, fmt="(i4)", advance="no") array (j, i)
end do
print *, ""
- end do
- print *, array
- print *, ""
+ end do
-end subroutine show
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
-program test
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (i > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (j > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 2D
+end subroutine show_2d
+
+subroutine show_3d (array)
+ integer, dimension (:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (i > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (j > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (k > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 3D
+end subroutine show_3d
+
+subroutine show_4d (array)
+ integer, dimension (:,:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ if (i > LBOUND (array, 4)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (j > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (k > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (l > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (l, k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 4D
+end subroutine show_4d
+!
+! Start of test program.
+!
+program test
interface
- subroutine show (message, array)
- character (len=*) :: message
+ subroutine show_str (array)
+ character (len=*) :: array
+ end subroutine show_str
+
+ subroutine show_1d (array)
+ integer, dimension (:) :: array
+ end subroutine show_1d
+
+ subroutine show_2d (array)
integer, dimension(:,:) :: array
- end subroutine show
+ end subroutine show_2d
+
+ subroutine show_3d (array)
+ integer, dimension(:,:,:) :: array
+ end subroutine show_3d
+
+ subroutine show_4d (array)
+ integer, dimension(:,:,:,:) :: array
+ end subroutine show_4d
end interface
+ ! Declare variables used in this test.
+ integer, dimension (-10:-1,-10:-2) :: neg_array
integer, dimension (1:10,1:10) :: array
integer, allocatable :: other (:, :)
+ character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz"
+ integer, dimension (-2:2,-2:2,-2:2) :: array3d
+ integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d
+ integer, dimension (10:20) :: array1d
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(-1:9,-1:9), target :: tarray
+ ! Allocate or associate any variables as needed.
allocate (other (-5:4, -2:7))
+ pointer2d => tarray
- do i=LBOUND (array, 2), UBOUND (array, 2), 1
- do j=LBOUND (array, 1), UBOUND (array, 1), 1
- array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
- end do
- end do
+ ! Fill arrays with contents ready for testing.
+ call fill_array_1d (array1d)
+
+ call fill_array_2d (neg_array)
+ call fill_array_2d (array)
+ call fill_array_2d (other)
+ call fill_array_2d (tarray)
+
+ call fill_array_3d (array3d)
+ call fill_array_4d (array4d)
+
+ ! The tests. Each call to a show_* function must have a unique set
+ ! of arguments as GDB uses the arguments are part of the test name
+ ! string, so duplicate arguments will result in duplicate test
+ ! names.
+ !
+ ! If a show_* line ends with VARS=... where '...' is a comma
+ ! separated list of variable names, these variables are assumed to
+ ! be part of the call line, and will be expanded by the test script,
+ ! for example:
+ !
+ ! do x=1,9,1
+ ! do y=x,10,1
+ ! call show_1d (some_array (x,y)) ! VARS=x,y
+ ! end do
+ ! end do
+ !
+ ! In this example the test script will automatically expand 'x' and
+ ! 'y' in order to better test different aspects of GDB. Do take
+ ! care, the expansion is not very "smart", so try to avoid clashing
+ ! with other text on the line, in the example above, avoid variables
+ ! named 'some' or 'array', as these will likely clash with
+ ! 'some_array'.
+ call show_str (str_1)
+ call show_str (str_1 (1:20))
+ call show_str (str_1 (10:20))
- do i=LBOUND (other, 2), UBOUND (other, 2), 1
- do j=LBOUND (other, 1), UBOUND (other, 1), 1
- other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
+ call show_elem (array1d (11))
+ call show_elem (pointer2d (2,3))
+
+ call show_1d (array1d)
+ call show_1d (array1d (13:17))
+ call show_1d (array1d (17:13:-1))
+ call show_1d (array (1:5,1))
+ call show_1d (array4d (1,7,3,:))
+ call show_1d (pointer2d (-1:3, 2))
+ call show_1d (pointer2d (-1, 2:4))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_1d ((array (1:5,1)))
+
+ call show_2d (pointer2d)
+ call show_2d (array)
+ call show_2d (array (1:5,1:5))
+ do i=1,10,2
+ do j=1,10,3
+ call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j
+ call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j
end do
end do
+ call show_2d (array (6:2:-1,3:9))
+ call show_2d (array (1:10:2, 1:10:2))
+ call show_2d (other)
+ call show_2d (other (-5:0, -2:0))
+ call show_2d (other (-5:4:2, -2:7:3))
+ call show_2d (neg_array)
+ call show_2d (neg_array (-10:-3,-8:-4:2))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_2d ((array (1:10:3, 1:10:2)))
+ call show_2d ((neg_array (-10:-3,-8:-4:2)))
- call show ("array", array)
- call show ("array (1:5,1:5)", array (1:5,1:5))
- call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
- call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
- call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
+ call show_3d (array3d)
+ call show_3d (array3d(-1:1,-1:1,-1:1))
+ call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1))
- call show ("other", other)
- call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
- call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1)))
+ call show_4d (array4d)
+ call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1))
+ call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1)))
+
+ ! All done. Deallocate.
deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
end program test
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
index 04296ac80c9..0ab74fbbe90 100644
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -44,7 +44,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
gdb_test "print sizeof(vla1(3,2,1))" "4" \
"print sizeof element from allocated vla1"
-gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
+gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
"print sizeof sliced vla1"
# Try to access values in undefined pointer to VLA (dangling)
@@ -61,7 +61,7 @@ gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
gdb_test "print sizeof(pvla(3,2,1))" "4" \
"print sizeof element from associated pvla"
-gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
+gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv2 10/10] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-08-26 14:49 ` [PATCHv2 10/10] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
@ 2020-08-26 17:02 ` Eli Zaretskii
0 siblings, 0 replies; 62+ messages in thread
From: Eli Zaretskii @ 2020-08-26 17:02 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
> From: Andrew Burgess <andrew.burgess@embecosm.com>
> Date: Wed, 26 Aug 2020 15:49:17 +0100
>
> gdb/ChangeLog:
>
> * Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
> * NEWS: Mention new options.
> * expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE.
> * expression.h (enum range_type): Add RANGE_HAS_STRIDE.
> * f-array-walker.h: New file.
> * f-exp.y (arglist): Allow for a series of subranges.
> (subrange): Add cases for subranges with strides.
> * f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
> (repack_array_slices): New static global.
> (show_repack_array_slices): New function.
> (fortran_array_slicing_debug): New static global.
> (show_fortran_array_slicing_debug): New function.
> (value_f90_subarray): Delete.
> (skip_undetermined_arglist): Delete.
> (class fortran_array_repacker_base_impl): New class.
> (class fortran_lazy_array_repacker_impl): New class.
> (class fortran_array_repacker_impl): New class.
> (fortran_value_subarray): Complete rewrite.
> (set_fortran_list): New static global.
> (show_fortran_list): Likewise.
> (_initialize_f_language): Register new commands.
> (fortran_adjust_dynamic_array_base_address_hack): New function.
> * f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
> Declare.
> * f-valprint.c: Include 'f-array-walker.h'.
> (class fortran_array_printer_impl): New class.
> (f77_print_array_1): Delete.
> (f77_print_array): Delete.
> (fortran_print_array): New.
> (f_value_print_inner): Update to call fortran_print_array.
> * gdbtypes.c: Include 'f-lang.h'.
> (resolve_dynamic_type_internal): Call
> fortran_adjust_dynamic_array_base_address_hack.
> * parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE.
>
> gdb/testsuite/ChangeLog:
>
> * gdb.fortran/array-slices-bad.exp: New file.
> * gdb.fortran/array-slices-bad.f90: New file.
> * gdb.fortran/array-slices-sub-slices.exp: New file.
> * gdb.fortran/array-slices-sub-slices.f90: New file.
> * gdb.fortran/array-slices.exp: Rewrite tests.
> * gdb.fortran/array-slices.f90: Rewrite tests.
> * gdb.fortran/vla-sizeof.exp: Correct expected results.
>
> gdb/doc/ChangeLog:
>
> * gdb.texinfo (Debugging Output): Document 'set/show debug
> fotran-array-slicing'.
> (Special Fortran Commands): Document 'set/show fortran
> repack-array-slices'.
The documentation parts are OK, thanks.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv2 09/10] gdb/testsuite: Add missing expected results
2020-08-26 14:49 ` [PATCHv2 09/10] gdb/testsuite: Add missing expected results Andrew Burgess
@ 2020-09-18 9:53 ` Andrew Burgess
0 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-09-18 9:53 UTC (permalink / raw)
To: gdb-patches
I have pushed this patch with a slightly modified commit message.
Thanks,
Andrew
* Andrew Burgess <andrew.burgess@embecosm.com> [2020-08-26 15:49:16 +0100]:
> The tests in this script are driven from two lists of expected
> results, one of the lists is missing some data so DejaGNU ends up
> matching against the empty string (which passes).
>
> This commit adds the missing expected results into the script.
>
> I could rewrite this test to make things more robust, however, a later
> commit is going to completely rewrite this test script, I'm simply
> adding this here so that _before_ the rewrite the test is complete,
> then if anyone ever digs into the history of this test script things
> will make sense (I hope).
>
> gdb/testsuite/ChangeLog:
>
> * gdb.fortran/array-slices.exp: Add missing message data.
> ---
> gdb/testsuite/ChangeLog | 4 ++++
> gdb/testsuite/gdb.fortran/array-slices.exp | 5 ++++-
> 2 files changed, 8 insertions(+), 1 deletion(-)
>
> diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
> index 8587c51e990..31f95a3668d 100644
> --- a/gdb/testsuite/gdb.fortran/array-slices.exp
> +++ b/gdb/testsuite/gdb.fortran/array-slices.exp
> @@ -53,7 +53,10 @@ set message_strings \
> " = 'array \\(1:5,1:5\\)'" \
> " = 'array \\(1:10:2,1:10:2\\)'" \
> " = 'array \\(1:10:3,1:10:2\\)'" \
> - " = 'array \\(1:10:5,1:10:3\\)'" ]
> + " = 'array \\(1:10:5,1:10:3\\)'" \
> + " = 'other'" \
> + " = 'other \\(-5:0, -2:0\\)'" \
> + " = 'other \\(-5:4:2, -2:7:3\\)'" ]
>
> set i 0
> foreach result $array_contents msg $message_strings {
> --
> 2.25.4
>
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv2 05/10] gdb/fortran: Clean up array/string expression evaluation
2020-08-26 14:49 ` [PATCHv2 05/10] gdb/fortran: Clean up array/string expression evaluation Andrew Burgess
@ 2020-09-19 8:53 ` Andrew Burgess
0 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-09-19 8:53 UTC (permalink / raw)
To: gdb-patches
* Andrew Burgess <andrew.burgess@embecosm.com> [2020-08-26 15:49:12 +0100]:
> In preparation for adding Fortan array stride expression support, this
> is the first phase of some clean up to the expression evaluation for
> Fortran arrays and strings.
>
> The current code is split into two blocks, linked, weirdly, with a
> goto. After this commit all the code is moved to its own function,
> and arrays and strings are now handled using the same code; this will
> be useful later when I want to add array stride support where strings
> will want to be treated just like arrays.
>
> For now the new function is added as a static within eval.c, even
> though the function is Fortran only. A following commit will remove
> some of the Fortran specific code from eval.c into one of the Fortran
> specific files, including this new function.
>
> There should be no user visible changes after this commit.
>
> gdb/ChangeLog:
>
> * eval.c (fortran_value_subarray): New function, content is taken
> from...
> (evaluate_subexp_standard): ...here, in two places. Now arrays
> and strings both call the new function.
> (calc_f77_array_dims): Add header comment, handle strings.
I went ahead and pushed this patch with a slightly modified commit
message.
Thanks,
Andrew
> ---
> gdb/ChangeLog | 8 +++
> gdb/eval.c | 136 +++++++++++++++++++++++++-------------------------
> 2 files changed, 75 insertions(+), 69 deletions(-)
>
> diff --git a/gdb/eval.c b/gdb/eval.c
> index cd300ddfef6..660edbe34af 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -1260,6 +1260,67 @@ is_integral_or_integral_reference (struct type *type)
> && is_integral_type (TYPE_TARGET_TYPE (type)));
> }
>
> +/* Called from evaluate_subexp_standard to perform array indexing, and
> + sub-range extraction, for Fortran. As well as arrays this function
> + also handles strings as they can be treated like arrays of characters.
> + ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are
> + as for evaluate_subexp_standard, and NARGS is the number of arguments
> + in this access (e.g. 'array (1,2,3)' would be NARGS 3). */
> +
> +static struct value *
> +fortran_value_subarray (struct value *array, struct expression *exp,
> + int *pos, int nargs, enum noside noside)
> +{
> + if (exp->elts[*pos].opcode == OP_RANGE)
> + return value_f90_subarray (array, exp, pos, noside);
> +
> + if (noside == EVAL_SKIP)
> + {
> + skip_undetermined_arglist (nargs, exp, pos, noside);
> + /* Return the dummy value with the correct type. */
> + return array;
> + }
> +
> + LONGEST subscript_array[MAX_FORTRAN_DIMS];
> + int ndimensions = 1;
> + struct type *type = check_typedef (value_type (array));
> +
> + if (nargs > MAX_FORTRAN_DIMS)
> + error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
> +
> + ndimensions = calc_f77_array_dims (type);
> +
> + if (nargs != ndimensions)
> + error (_("Wrong number of subscripts"));
> +
> + gdb_assert (nargs > 0);
> +
> + /* Now that we know we have a legal array subscript expression let us
> + actually find out where this element exists in the array. */
> +
> + /* Take array indices left to right. */
> + for (int i = 0; i < nargs; i++)
> + {
> + /* Evaluate each subscript; it must be a legal integer in F77. */
> + value *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 (int 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;
> +}
> +
> struct value *
> evaluate_subexp_standard (struct type *expect_type,
> struct expression *exp, int *pos,
> @@ -1954,33 +2015,8 @@ evaluate_subexp_standard (struct type *expect_type,
> switch (code)
> {
> case TYPE_CODE_ARRAY:
> - if (exp->elts[*pos].opcode == OP_RANGE)
> - return value_f90_subarray (arg1, exp, pos, noside);
> - else
> - {
> - if (noside == EVAL_SKIP)
> - {
> - skip_undetermined_arglist (nargs, exp, pos, noside);
> - /* Return the dummy value with the correct type. */
> - return arg1;
> - }
> - goto multi_f77_subscript;
> - }
> -
> case TYPE_CODE_STRING:
> - if (exp->elts[*pos].opcode == OP_RANGE)
> - return value_f90_subarray (arg1, exp, pos, noside);
> - else
> - {
> - if (noside == EVAL_SKIP)
> - {
> - skip_undetermined_arglist (nargs, exp, pos, noside);
> - /* Return the dummy value with the correct type. */
> - return arg1;
> - }
> - arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
> - return value_subscript (arg1, value_as_long (arg2));
> - }
> + return fortran_value_subarray (arg1, exp, pos, nargs, noside);
>
> case TYPE_CODE_PTR:
> case TYPE_CODE_FUNC:
> @@ -2400,49 +2436,6 @@ evaluate_subexp_standard (struct type *expect_type,
> }
> return (arg1);
>
> - multi_f77_subscript:
> - {
> - LONGEST subscript_array[MAX_FORTRAN_DIMS];
> - int ndimensions = 1, i;
> - struct value *array = arg1;
> -
> - if (nargs > MAX_FORTRAN_DIMS)
> - error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
> -
> - ndimensions = calc_f77_array_dims (type);
> -
> - if (nargs != ndimensions)
> - error (_("Wrong number of subscripts"));
> -
> - gdb_assert (nargs > 0);
> -
> - /* Now that we know we have a legal array subscript expression
> - let us actually find out where this element exists in the array. */
> -
> - /* Take array indices left to right. */
> - for (i = 0; i < nargs; i++)
> - {
> - /* Evaluate each subscript; it must be a legal integer in F77. */
> - arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
> -
> - /* Fill in the subscript array. */
> -
> - subscript_array[i] = value_as_long (arg2);
> - }
> -
> - /* Internal type of array is arranged right to left. */
> - for (i = nargs; i > 0; i--)
> - {
> - struct type *array_type = check_typedef (value_type (array));
> - LONGEST index = subscript_array[i - 1];
> -
> - array = value_subscripted_rvalue (array, index,
> - f77_get_lowerbound (array_type));
> - }
> -
> - return array;
> - }
> -
> case BINOP_LOGICAL_AND:
> arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
> if (noside == EVAL_SKIP)
> @@ -3356,12 +3349,17 @@ parse_and_eval_type (char *p, int length)
> return expr->elts[1].type;
> }
>
> +/* Return the number of dimensions for a Fortran array or string. */
> +
> int
> calc_f77_array_dims (struct type *array_type)
> {
> int ndimen = 1;
> struct type *tmp_type;
>
> + if ((array_type->code () == TYPE_CODE_STRING))
> + return 1;
> +
> if ((array_type->code () != TYPE_CODE_ARRAY))
> error (_("Can't get dimensions for a non-array type"));
>
> --
> 2.25.4
>
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv2 06/10] gdb/fortran: Move Fortran expression handling into f-lang.c
2020-08-26 14:49 ` [PATCHv2 06/10] gdb/fortran: Move Fortran expression handling into f-lang.c Andrew Burgess
@ 2020-09-19 8:53 ` Andrew Burgess
0 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-09-19 8:53 UTC (permalink / raw)
To: gdb-patches
* Andrew Burgess <andrew.burgess@embecosm.com> [2020-08-26 15:49:13 +0100]:
> The Fortran specific OP_F77_UNDETERMINED_ARGLIST is currently handled
> in the generic expression handling code. As I start to add array
> stride support in here the amount of Fortran only code that is forced
> into the generic expression evaluation file will grow.
>
> Now seems like a good time to move this Fortran specific operation
> into the Fortran specific files.
>
> There should be no user visible changes after this commit.
>
> gdb/ChangeLog:
>
> * eval.c: Remove 'f-lang.h' include.
> (value_f90_subarray): Moved to f-lang.c.
> (eval_call): Renamed to...
> (evaluate_subexp_do_call): ...this, is no longer static, header
> comment moved into header file.
> (evaluate_funcall): Update call to eval_call.
> (skip_undetermined_arglist): Moved to f-lang.c.
> (fortran_value_subarray): Likewise.
> (evaluate_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
> moved to evaluate_subexp_f.
> (calc_f77_array_dims): Moved to f-lang.c
> * expprint.c (print_subexp_funcall): New function.
> (print_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
> moved to print_subexp_f, OP_FUNCALL uses new function.
> (dump_subexp_body_funcall): New function.
> (dump_subexp_body_standard): OP_F77_UNDETERMINED_ARGLIST handling
> moved to dump_subexp_f, OP_FUNCALL uses new function.
> * expression.h (evaluate_subexp_do_call): Declare.
> * f-lang.c (value_f90_subarray): Moved from eval.c.
> (skip_undetermined_arglist): Likewise.
> (calc_f77_array_dims): Likewise.
> (fortran_value_subarray): Likewise.
> (evaluate_subexp_f): Add OP_F77_UNDETERMINED_ARGLIST support.
> (operator_length_f): Likewise.
> (print_subexp_f): Likewise.
> (dump_subexp_body_f): Likewise.
> * fortran-operator.def (OP_F77_UNDETERMINED_ARGLIST): Move
> declaration of this operation to here.
> * parse.c (operator_length_standard): OP_F77_UNDETERMINED_ARGLIST
> support moved to operator_length_f.
> * parser-defs.h (dump_subexp_body_funcall): Declare.
> (print_subexp_funcall): Declare.
> * std-operator.def (OP_F77_UNDETERMINED_ARGLIST): Moved to
> fortran-operator.def.
I pushed this patch with a slightly modified commit message.
Thanks,
Andrew
> ---
> gdb/ChangeLog | 37 +++++++
> gdb/eval.c | 223 ++-------------------------------------
> gdb/expprint.c | 61 ++++++-----
> gdb/expression.h | 12 +++
> gdb/f-lang.c | 221 ++++++++++++++++++++++++++++++++++++++
> gdb/fortran-operator.def | 8 ++
> gdb/parse.c | 1 -
> gdb/parser-defs.h | 16 +++
> gdb/std-operator.def | 8 --
> 9 files changed, 339 insertions(+), 248 deletions(-)
>
> diff --git a/gdb/eval.c b/gdb/eval.c
> index 660edbe34af..3ccc4148e48 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -26,7 +26,6 @@
> #include "frame.h"
> #include "gdbthread.h"
> #include "language.h" /* For CAST_IS_CONVERSION. */
> -#include "f-lang.h" /* For array bound stuff. */
> #include "cp-abi.h"
> #include "infcall.h"
> #include "objc-lang.h"
> @@ -371,32 +370,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 (value_type (array)->index_type ());
> - 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 = range->bounds ()->low.const_val ();
> - 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 = range->bounds ()->high.const_val ();
> - 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
> @@ -749,17 +722,13 @@ eval_skip_value (expression *exp)
> return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
> }
>
> -/* Evaluate a function call. The function to be called is in
> - ARGVEC[0] and the arguments passed to the function are in
> - ARGVEC[1..NARGS]. FUNCTION_NAME is the name of the function, if
> - known. DEFAULT_RETURN_TYPE is used as the function's return type
> - if the return type is unknown. */
> +/* See expression.h. */
>
> -static value *
> -eval_call (expression *exp, enum noside noside,
> - int nargs, value **argvec,
> - const char *function_name,
> - type *default_return_type)
> +value *
> +evaluate_subexp_do_call (expression *exp, enum noside noside,
> + int nargs, value **argvec,
> + const char *function_name,
> + type *default_return_type)
> {
> if (argvec[0] == NULL)
> error (_("Cannot evaluate function -- may be inlined"));
> @@ -1230,20 +1199,8 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
> /* Nothing to be done; argvec already correctly set up. */
> }
>
> - return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
> -}
> -
> -/* Helper for skipping all the arguments in an undetermined argument list.
> - This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
> - case of evaluate_subexp_standard as multiple, but not all, code paths
> - require a generic skip. */
> -
> -static void
> -skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
> - enum noside noside)
> -{
> - for (int i = 0; i < nargs; ++i)
> - evaluate_subexp (NULL_TYPE, exp, pos, noside);
> + return evaluate_subexp_do_call (exp, noside, nargs, argvec,
> + var_func_name, expect_type);
> }
>
> /* Return true if type is integral or reference to integral */
> @@ -1260,67 +1217,6 @@ is_integral_or_integral_reference (struct type *type)
> && is_integral_type (TYPE_TARGET_TYPE (type)));
> }
>
> -/* Called from evaluate_subexp_standard to perform array indexing, and
> - sub-range extraction, for Fortran. As well as arrays this function
> - also handles strings as they can be treated like arrays of characters.
> - ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are
> - as for evaluate_subexp_standard, and NARGS is the number of arguments
> - in this access (e.g. 'array (1,2,3)' would be NARGS 3). */
> -
> -static struct value *
> -fortran_value_subarray (struct value *array, struct expression *exp,
> - int *pos, int nargs, enum noside noside)
> -{
> - if (exp->elts[*pos].opcode == OP_RANGE)
> - return value_f90_subarray (array, exp, pos, noside);
> -
> - if (noside == EVAL_SKIP)
> - {
> - skip_undetermined_arglist (nargs, exp, pos, noside);
> - /* Return the dummy value with the correct type. */
> - return array;
> - }
> -
> - LONGEST subscript_array[MAX_FORTRAN_DIMS];
> - int ndimensions = 1;
> - struct type *type = check_typedef (value_type (array));
> -
> - if (nargs > MAX_FORTRAN_DIMS)
> - error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
> -
> - ndimensions = calc_f77_array_dims (type);
> -
> - if (nargs != ndimensions)
> - error (_("Wrong number of subscripts"));
> -
> - gdb_assert (nargs > 0);
> -
> - /* Now that we know we have a legal array subscript expression let us
> - actually find out where this element exists in the array. */
> -
> - /* Take array indices left to right. */
> - for (int i = 0; i < nargs; i++)
> - {
> - /* Evaluate each subscript; it must be a legal integer in F77. */
> - value *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 (int 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;
> -}
> -
> struct value *
> evaluate_subexp_standard (struct type *expect_type,
> struct expression *exp, int *pos,
> @@ -1335,7 +1231,6 @@ evaluate_subexp_standard (struct type *expect_type,
> struct type *type;
> int nargs;
> struct value **argvec;
> - int code;
> int ix;
> long mem_offset;
> struct type **arg_types;
> @@ -1977,84 +1872,6 @@ evaluate_subexp_standard (struct type *expect_type,
> case OP_FUNCALL:
> return evaluate_funcall (expect_type, exp, pos, noside);
>
> - case OP_F77_UNDETERMINED_ARGLIST:
> -
> - /* Remember that in F77, functions, substring ops and
> - array subscript operations cannot be disambiguated
> - at parse time. We have made all array subscript operations,
> - substring operations as well as function calls come here
> - and we now have to discover what the heck this thing actually was.
> - If it is a function, we process just as if we got an OP_FUNCALL. */
> -
> - nargs = longest_to_int (exp->elts[pc + 1].longconst);
> - (*pos) += 2;
> -
> - /* First determine the type code we are dealing with. */
> - arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
> - type = check_typedef (value_type (arg1));
> - code = type->code ();
> -
> - if (code == TYPE_CODE_PTR)
> - {
> - /* Fortran always passes variable to subroutines as pointer.
> - So we need to look into its target type to see if it is
> - array, string or function. If it is, we need to switch
> - to the target value the original one points to. */
> - struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
> -
> - if (target_type->code () == TYPE_CODE_ARRAY
> - || target_type->code () == TYPE_CODE_STRING
> - || target_type->code () == TYPE_CODE_FUNC)
> - {
> - arg1 = value_ind (arg1);
> - type = check_typedef (value_type (arg1));
> - code = type->code ();
> - }
> - }
> -
> - switch (code)
> - {
> - case TYPE_CODE_ARRAY:
> - case TYPE_CODE_STRING:
> - return fortran_value_subarray (arg1, exp, pos, nargs, noside);
> -
> - case TYPE_CODE_PTR:
> - case TYPE_CODE_FUNC:
> - case TYPE_CODE_INTERNAL_FUNCTION:
> - /* It's a function call. */
> - /* Allocate arg vector, including space for the function to be
> - called in argvec[0] and a terminating NULL. */
> - argvec = (struct value **)
> - alloca (sizeof (struct value *) * (nargs + 2));
> - argvec[0] = arg1;
> - tem = 1;
> - for (; tem <= nargs; tem++)
> - {
> - argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
> - /* Arguments in Fortran are passed by address. Coerce the
> - arguments here rather than in value_arg_coerce as otherwise
> - the call to malloc to place the non-lvalue parameters in
> - target memory is hit by this Fortran specific logic. This
> - results in malloc being called with a pointer to an integer
> - followed by an attempt to malloc the arguments to malloc in
> - target memory. Infinite recursion ensues. */
> - if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
> - {
> - bool is_artificial
> - = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
> - argvec[tem] = fortran_argument_convert (argvec[tem],
> - is_artificial);
> - }
> - }
> - argvec[tem] = 0; /* signal end of arglist */
> - if (noside == EVAL_SKIP)
> - return eval_skip_value (exp);
> - return eval_call (exp, noside, nargs, argvec, NULL, expect_type);
> -
> - default:
> - error (_("Cannot perform substring on this type"));
> - }
> -
> case OP_COMPLEX:
> /* We have a complex number, There should be 2 floating
> point numbers that compose it. */
> @@ -3348,27 +3165,3 @@ parse_and_eval_type (char *p, int length)
> error (_("Internal error in eval_type."));
> return expr->elts[1].type;
> }
> -
> -/* Return the number of dimensions for a Fortran array or string. */
> -
> -int
> -calc_f77_array_dims (struct type *array_type)
> -{
> - int ndimen = 1;
> - struct type *tmp_type;
> -
> - if ((array_type->code () == TYPE_CODE_STRING))
> - return 1;
> -
> - if ((array_type->code () != 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 (tmp_type->code () == TYPE_CODE_ARRAY)
> - ++ndimen;
> - }
> - return ndimen;
> -}
> diff --git a/gdb/expprint.c b/gdb/expprint.c
> index 5427a56f6ae..350f291b75e 100644
> --- a/gdb/expprint.c
> +++ b/gdb/expprint.c
> @@ -53,6 +53,25 @@ print_subexp (struct expression *exp, int *pos,
> exp->language_defn->la_exp_desc->print_subexp (exp, pos, stream, prec);
> }
>
> +/* See parser-defs.h. */
> +
> +void
> +print_subexp_funcall (struct expression *exp, int *pos,
> + struct ui_file *stream)
> +{
> + (*pos) += 2;
> + unsigned nargs = longest_to_int (exp->elts[*pos].longconst);
> + print_subexp (exp, pos, stream, PREC_SUFFIX);
> + fputs_filtered (" (", stream);
> + for (unsigned tem = 0; tem < nargs; tem++)
> + {
> + if (tem != 0)
> + fputs_filtered (", ", stream);
> + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
> + }
> + fputs_filtered (")", stream);
> +}
> +
> /* Standard implementation of print_subexp for use in language_defn
> vectors. */
> void
> @@ -187,18 +206,7 @@ print_subexp_standard (struct expression *exp, int *pos,
> return;
>
> case OP_FUNCALL:
> - case OP_F77_UNDETERMINED_ARGLIST:
> - (*pos) += 2;
> - nargs = longest_to_int (exp->elts[pc + 1].longconst);
> - print_subexp (exp, pos, stream, PREC_SUFFIX);
> - fputs_filtered (" (", stream);
> - for (tem = 0; tem < nargs; tem++)
> - {
> - if (tem != 0)
> - fputs_filtered (", ", stream);
> - print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
> - }
> - fputs_filtered (")", stream);
> + print_subexp_funcall (exp, pos, stream);
> return;
>
> case OP_NAME:
> @@ -796,6 +804,22 @@ dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
> return exp->language_defn->la_exp_desc->dump_subexp_body (exp, stream, elt);
> }
>
> +/* See parser-defs.h. */
> +
> +int
> +dump_subexp_body_funcall (struct expression *exp,
> + struct ui_file *stream, int elt)
> +{
> + int nargs = longest_to_int (exp->elts[elt].longconst);
> + fprintf_filtered (stream, "Number of args: %d", nargs);
> + elt += 2;
> +
> + for (int i = 1; i <= nargs + 1; i++)
> + elt = dump_subexp (exp, stream, elt);
> +
> + return elt;
> +}
> +
> /* Default value for subexp_body in exp_descriptor vector. */
>
> int
> @@ -931,18 +955,7 @@ dump_subexp_body_standard (struct expression *exp,
> elt += 2;
> break;
> case OP_FUNCALL:
> - case OP_F77_UNDETERMINED_ARGLIST:
> - {
> - int i, nargs;
> -
> - nargs = longest_to_int (exp->elts[elt].longconst);
> -
> - fprintf_filtered (stream, "Number of args: %d", nargs);
> - elt += 2;
> -
> - for (i = 1; i <= nargs + 1; i++)
> - elt = dump_subexp (exp, stream, elt);
> - }
> + elt = dump_subexp_body_funcall (exp, stream, elt);
> break;
> case OP_ARRAY:
> {
> diff --git a/gdb/expression.h b/gdb/expression.h
> index f1128c44248..5af10f05db1 100644
> --- a/gdb/expression.h
> +++ b/gdb/expression.h
> @@ -155,6 +155,18 @@ enum noside
> extern struct value *evaluate_subexp_standard
> (struct type *, struct expression *, int *, enum noside);
>
> +/* Evaluate a function call. The function to be called is in ARGVEC[0] and
> + the arguments passed to the function are in ARGVEC[1..NARGS].
> + FUNCTION_NAME is the name of the function, if known.
> + DEFAULT_RETURN_TYPE is used as the function's return type if the return
> + type is unknown. */
> +
> +extern struct value *evaluate_subexp_do_call (expression *exp,
> + enum noside noside,
> + int nargs, value **argvec,
> + const char *function_name,
> + type *default_return_type);
> +
> /* From expprint.c */
>
> extern void print_expression (struct expression *, struct ui_file *);
> diff --git a/gdb/f-lang.c b/gdb/f-lang.c
> index 58b41d11d11..6210522c182 100644
> --- a/gdb/f-lang.c
> +++ b/gdb/f-lang.c
> @@ -114,6 +114,134 @@ enum f_primitive_types {
> nr_f_primitive_types
> };
>
> +/* Called from fortran_value_subarray to take a slice of an array or a
> + string. ARRAY is the array or string to be accessed. EXP, POS, and
> + NOSIDE are as for evaluate_subexp_standard. Return a value that is a
> + slice of the array. */
> +
> +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 (value_type (array)->index_type ());
> + 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 = range->bounds ()->low.const_val ();
> + 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 = range->bounds ()->high.const_val ();
> + else
> + high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
> +
> + return value_slice (array, low_bound, high_bound - low_bound + 1);
> +}
> +
> +/* Helper for skipping all the arguments in an undetermined argument list.
> + This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
> + case of evaluate_subexp_standard as multiple, but not all, code paths
> + require a generic skip. */
> +
> +static void
> +skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
> + enum noside noside)
> +{
> + for (int i = 0; i < nargs; ++i)
> + evaluate_subexp (NULL_TYPE, exp, pos, noside);
> +}
> +
> +/* Return the number of dimensions for a Fortran array or string. */
> +
> +int
> +calc_f77_array_dims (struct type *array_type)
> +{
> + int ndimen = 1;
> + struct type *tmp_type;
> +
> + if ((array_type->code () == TYPE_CODE_STRING))
> + return 1;
> +
> + if ((array_type->code () != 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 (tmp_type->code () == TYPE_CODE_ARRAY)
> + ++ndimen;
> + }
> + return ndimen;
> +}
> +
> +/* Called from evaluate_subexp_standard to perform array indexing, and
> + sub-range extraction, for Fortran. As well as arrays this function
> + also handles strings as they can be treated like arrays of characters.
> + ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are
> + as for evaluate_subexp_standard, and NARGS is the number of arguments
> + in this access (e.g. 'array (1,2,3)' would be NARGS 3). */
> +
> +static struct value *
> +fortran_value_subarray (struct value *array, struct expression *exp,
> + int *pos, int nargs, enum noside noside)
> +{
> + if (exp->elts[*pos].opcode == OP_RANGE)
> + return value_f90_subarray (array, exp, pos, noside);
> +
> + if (noside == EVAL_SKIP)
> + {
> + skip_undetermined_arglist (nargs, exp, pos, noside);
> + /* Return the dummy value with the correct type. */
> + return array;
> + }
> +
> + LONGEST subscript_array[MAX_FORTRAN_DIMS];
> + int ndimensions = 1;
> + struct type *type = check_typedef (value_type (array));
> +
> + if (nargs > MAX_FORTRAN_DIMS)
> + error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
> +
> + ndimensions = calc_f77_array_dims (type);
> +
> + if (nargs != ndimensions)
> + error (_("Wrong number of subscripts"));
> +
> + gdb_assert (nargs > 0);
> +
> + /* Now that we know we have a legal array subscript expression let us
> + actually find out where this element exists in the array. */
> +
> + /* Take array indices left to right. */
> + for (int i = 0; i < nargs; i++)
> + {
> + /* Evaluate each subscript; it must be a legal integer in F77. */
> + value *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 (int 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;
> +}
> +
> /* Special expression evaluation cases for Fortran. */
>
> static struct value *
> @@ -285,6 +413,87 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
> TYPE_LENGTH (type));
> return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
> TYPE_LENGTH (TYPE_TARGET_TYPE (type)));
> +
> +
> + case OP_F77_UNDETERMINED_ARGLIST:
> + /* Remember that in F77, functions, substring ops and array subscript
> + operations cannot be disambiguated at parse time. We have made
> + all array subscript operations, substring operations as well as
> + function calls come here and we now have to discover what the heck
> + this thing actually was. If it is a function, we process just as
> + if we got an OP_FUNCALL. */
> + int nargs = longest_to_int (exp->elts[pc + 1].longconst);
> + (*pos) += 2;
> +
> + /* First determine the type code we are dealing with. */
> + arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
> + type = check_typedef (value_type (arg1));
> + enum type_code code = type->code ();
> +
> + if (code == TYPE_CODE_PTR)
> + {
> + /* Fortran always passes variable to subroutines as pointer.
> + So we need to look into its target type to see if it is
> + array, string or function. If it is, we need to switch
> + to the target value the original one points to. */
> + struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
> +
> + if (target_type->code () == TYPE_CODE_ARRAY
> + || target_type->code () == TYPE_CODE_STRING
> + || target_type->code () == TYPE_CODE_FUNC)
> + {
> + arg1 = value_ind (arg1);
> + type = check_typedef (value_type (arg1));
> + code = type->code ();
> + }
> + }
> +
> + switch (code)
> + {
> + case TYPE_CODE_ARRAY:
> + case TYPE_CODE_STRING:
> + return fortran_value_subarray (arg1, exp, pos, nargs, noside);
> +
> + case TYPE_CODE_PTR:
> + case TYPE_CODE_FUNC:
> + case TYPE_CODE_INTERNAL_FUNCTION:
> + {
> + /* It's a function call. Allocate arg vector, including
> + space for the function to be called in argvec[0] and a
> + termination NULL. */
> + struct value **argvec = (struct value **)
> + alloca (sizeof (struct value *) * (nargs + 2));
> + argvec[0] = arg1;
> + int tem = 1;
> + for (; tem <= nargs; tem++)
> + {
> + argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
> + /* Arguments in Fortran are passed by address. Coerce the
> + arguments here rather than in value_arg_coerce as
> + otherwise the call to malloc to place the non-lvalue
> + parameters in target memory is hit by this Fortran
> + specific logic. This results in malloc being called
> + with a pointer to an integer followed by an attempt to
> + malloc the arguments to malloc in target memory.
> + Infinite recursion ensues. */
> + if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
> + {
> + bool is_artificial
> + = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
> + argvec[tem] = fortran_argument_convert (argvec[tem],
> + is_artificial);
> + }
> + }
> + argvec[tem] = 0; /* signal end of arglist */
> + if (noside == EVAL_SKIP)
> + return eval_skip_value (exp);
> + return evaluate_subexp_do_call (exp, noside, nargs, argvec, NULL,
> + expect_type);
> + }
> +
> + default:
> + error (_("Cannot perform substring on this type"));
> + }
> }
>
> /* Should be unreachable. */
> @@ -318,6 +527,11 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp,
> oplen = 1;
> args = 2;
> break;
> +
> + case OP_F77_UNDETERMINED_ARGLIST:
> + oplen = 3;
> + args = 1 + longest_to_int (exp->elts[pc - 2].longconst);
> + break;
> }
>
> *oplenp = oplen;
> @@ -390,6 +604,10 @@ print_subexp_f (struct expression *exp, int *pos,
> case BINOP_FORTRAN_MODULO:
> print_binop_subexp_f (exp, pos, stream, prec, "MODULO");
> return;
> +
> + case OP_F77_UNDETERMINED_ARGLIST:
> + print_subexp_funcall (exp, pos, stream);
> + return;
> }
> }
>
> @@ -432,6 +650,9 @@ dump_subexp_body_f (struct expression *exp,
> case BINOP_FORTRAN_MODULO:
> operator_length_f (exp, (elt + 1), &oplen, &nargs);
> break;
> +
> + case OP_F77_UNDETERMINED_ARGLIST:
> + return dump_subexp_body_funcall (exp, stream, elt);
> }
>
> elt += oplen;
> diff --git a/gdb/fortran-operator.def b/gdb/fortran-operator.def
> index fd4051ebe59..bfdbc401711 100644
> --- a/gdb/fortran-operator.def
> +++ b/gdb/fortran-operator.def
> @@ -17,6 +17,14 @@
> You should have received a copy of the GNU General Public License
> along with this program. If not, see <http://www.gnu.org/licenses/>. */
>
> +/* This is EXACTLY like OP_FUNCALL but is semantically different.
> + In F77, array subscript expressions, substring expressions and
> + function calls are all exactly the same syntactically. They
> + may only be disambiguated at runtime. Thus this operator,
> + which indicates that we have found something of the form
> + <name> ( <stuff> ). */
> +OP (OP_F77_UNDETERMINED_ARGLIST)
> +
> /* Single operand builtins. */
> OP (UNOP_FORTRAN_KIND)
> OP (UNOP_FORTRAN_FLOOR)
> diff --git a/gdb/parse.c b/gdb/parse.c
> index 2fb474e27f1..435f87a06e4 100644
> --- a/gdb/parse.c
> +++ b/gdb/parse.c
> @@ -817,7 +817,6 @@ operator_length_standard (const struct expression *expr, int endpos,
> break;
>
> case OP_FUNCALL:
> - case OP_F77_UNDETERMINED_ARGLIST:
> oplen = 3;
> args = 1 + longest_to_int (expr->elts[endpos - 2].longconst);
> break;
> diff --git a/gdb/parser-defs.h b/gdb/parser-defs.h
> index a9b8a12959b..bc6fc2f9ba3 100644
> --- a/gdb/parser-defs.h
> +++ b/gdb/parser-defs.h
> @@ -338,6 +338,13 @@ extern int dump_subexp (struct expression *, struct ui_file *, int);
> extern int dump_subexp_body_standard (struct expression *,
> struct ui_file *, int);
>
> +/* Dump (to STREAM) a function call like expression at position ELT in the
> + expression array EXP. Return a new value for ELT just after the
> + function call expression. */
> +
> +extern int dump_subexp_body_funcall (struct expression *exp,
> + struct ui_file *stream, int elt);
> +
> extern void operator_length (const struct expression *, int, int *, int *);
>
> extern void operator_length_standard (const struct expression *, int, int *,
> @@ -440,6 +447,15 @@ extern void print_subexp (struct expression *, int *, struct ui_file *,
> extern void print_subexp_standard (struct expression *, int *,
> struct ui_file *, enum precedence);
>
> +/* Print a function call like expression to STREAM. This is called as a
> + helper function by which point the expression node identifying this as a
> + function call has already been stripped off and POS should point to the
> + number of function call arguments. EXP is the object containing the
> + list of expression elements. */
> +
> +extern void print_subexp_funcall (struct expression *exp, int *pos,
> + struct ui_file *stream);
> +
> /* Function used to avoid direct calls to fprintf
> in the code generated by the bison parser. */
>
> diff --git a/gdb/std-operator.def b/gdb/std-operator.def
> index e969bdccaed..6f90875f477 100644
> --- a/gdb/std-operator.def
> +++ b/gdb/std-operator.def
> @@ -168,14 +168,6 @@ OP (OP_FUNCALL)
> pointer. This is an Objective C message. */
> OP (OP_OBJC_MSGCALL)
>
> -/* This is EXACTLY like OP_FUNCALL but is semantically different.
> - In F77, array subscript expressions, substring expressions and
> - function calls are all exactly the same syntactically. They
> - may only be disambiguated at runtime. Thus this operator,
> - which indicates that we have found something of the form
> - <name> ( <stuff> ). */
> -OP (OP_F77_UNDETERMINED_ARGLIST)
> -
> /* OP_COMPLEX takes a type in the following element, followed by another
> OP_COMPLEX, making three exp_elements. It is followed by two double
> args, and converts them into a complex number of the given type. */
> --
> 2.25.4
>
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv2 07/10] gdb/fortran: Change whitespace when printing arrays
2020-08-26 14:49 ` [PATCHv2 07/10] gdb/fortran: Change whitespace when printing arrays Andrew Burgess
@ 2020-09-19 8:54 ` Andrew Burgess
0 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-09-19 8:54 UTC (permalink / raw)
To: gdb-patches
* Andrew Burgess <andrew.burgess@embecosm.com> [2020-08-26 15:49:14 +0100]:
> This commit makes the whitespace usage when printing Fortran arrays
> more consistent, and more inline with how we print C arrays.
>
> Currently a 2 dimensional Fotran array is printed like this, I find
> the marked whitespace unpleasant:
>
> (( 1, 2, 3) ( 4, 5, 6) )
> ^ ^ ^
>
> After this commit the same array is printed like this:
>
> ((1, 2, 3) (4, 5, 6))
>
> Which seems more inline with how we print C arrays, in the case of C
> arrays we don't add extra whitespace before the first element.
>
> gdb/ChangeLog:
>
> * f-valprint.c (f77_print_array_1): Adjust printing of whitespace
> for arrays.
>
> gdb/testsuite/ChangeLog:
>
> * gdb.fortran/array-slices.exp: Update expected results.
> * gdb.fortran/class-allocatable-array.exp: Likewise.
> * gdb.fortran/multi-dim.exp: Likewise.
> * gdb.fortran/vla-type.exp: Likewise.
> * gdb.mi/mi-vla-fortran.exp: Likewise.
I pushed this patch.
Thanks,
Andrew
> ---
> gdb/ChangeLog | 5 +++++
> gdb/f-valprint.c | 7 +++++--
> gdb/testsuite/ChangeLog | 8 ++++++++
> gdb/testsuite/gdb.fortran/array-slices.exp | 16 ++++++++--------
> .../gdb.fortran/class-allocatable-array.exp | 2 +-
> gdb/testsuite/gdb.fortran/multi-dim.exp | 2 +-
> gdb/testsuite/gdb.fortran/vla-type.exp | 6 +++---
> gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 2 +-
> 8 files changed, 32 insertions(+), 16 deletions(-)
>
> diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
> index fabdf458616..3973984542c 100644
> --- a/gdb/f-valprint.c
> +++ b/gdb/f-valprint.c
> @@ -137,14 +137,17 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
> (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
> + offs, addr + offs);
>
> - fprintf_filtered (stream, "( ");
> + fprintf_filtered (stream, "(");
> f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
> value_contents_for_printing (subarray),
> value_embedded_offset (subarray),
> value_address (subarray),
> stream, recurse, subarray, options, elts);
> offs += byte_stride;
> - fprintf_filtered (stream, ") ");
> + fprintf_filtered (stream, ")");
> +
> + if (i < upperbound)
> + fprintf_filtered (stream, " ");
> }
> if (*elts >= options->print_max && i < upperbound)
> fprintf_filtered (stream, "...");
> diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
> index 4ca1db90f7f..8587c51e990 100644
> --- a/gdb/testsuite/gdb.fortran/array-slices.exp
> +++ b/gdb/testsuite/gdb.fortran/array-slices.exp
> @@ -38,14 +38,14 @@ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
>
> set array_contents \
> [list \
> - " = \\(\\( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\( 11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\( 21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\( 31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\( 41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\( 51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\( 61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\( 71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\( 81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\( 91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\) \\)" \
> - " = \\(\\( 1, 2, 3, 4, 5\\) \\( 11, 12, 13, 14, 15\\) \\( 21, 22, 23, 24, 25\\) \\( 31, 32, 33, 34, 35\\) \\( 41, 42, 43, 44, 45\\) \\)" \
> - " = \\(\\( 1, 3, 5, 7, 9\\) \\( 21, 23, 25, 27, 29\\) \\( 41, 43, 45, 47, 49\\) \\( 61, 63, 65, 67, 69\\) \\( 81, 83, 85, 87, 89\\) \\)" \
> - " = \\(\\( 1, 4, 7, 10\\) \\( 21, 24, 27, 30\\) \\( 41, 44, 47, 50\\) \\( 61, 64, 67, 70\\) \\( 81, 84, 87, 90\\) \\)" \
> - " = \\(\\( 1, 5, 9\\) \\( 31, 35, 39\\) \\( 61, 65, 69\\) \\( 91, 95, 99\\) \\)" \
> - " = \\(\\( -26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\( -19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\( -12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\( -5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\( 2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\( 9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\( 16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\( 23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\( 30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\( 37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\) \\)" \
> - " = \\(\\( -26, -25, -24, -23, -22, -21\\) \\( -19, -18, -17, -16, -15, -14\\) \\( -12, -11, -10, -9, -8, -7\\) \\)" \
> - " = \\(\\( -26, -24, -22, -20, -18\\) \\( -5, -3, -1, 1, 3\\) \\( 16, 18, 20, 22, 24\\) \\( 37, 39, 41, 43, 45\\) \\)" ]
> + " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
> + " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
> + " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
> + " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
> + " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
> + " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
> + " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
> + " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
>
> set message_strings \
> [list \
> diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
> index 9475ba3b393..cdee73ff5cb 100644
> --- a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
> +++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp
> @@ -40,4 +40,4 @@ gdb_continue_to_breakpoint "Break Here"
> # cetainly going to fail.
> gdb_test "print this" " = \\( _data = \[^\r\n\]+, _vptr = \[^\r\n\]+\\)"
> gdb_test "print this%_data" " = \\(PTR TO -> \\( Type test_type \\)\\) \[^\r\n\]+"
> -gdb_test "print this%_data%b" " = \\(\\( 1, 2, 3\\) \\( 4, 5, 6\\) \\)"
> +gdb_test "print this%_data%b" " = \\(\\(1, 2, 3\\) \\(4, 5, 6\\)\\)"
> diff --git a/gdb/testsuite/gdb.fortran/multi-dim.exp b/gdb/testsuite/gdb.fortran/multi-dim.exp
> index ef6c6da8bd5..8cb419a0a7e 100644
> --- a/gdb/testsuite/gdb.fortran/multi-dim.exp
> +++ b/gdb/testsuite/gdb.fortran/multi-dim.exp
> @@ -57,7 +57,7 @@ gdb_test "print foo(3,3,4)" \
> "print an invalid array index (3,3,4)"
>
> gdb_test "print foo" \
> - { = \(\( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 20\) \) \)} \
> + { = \(\(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 20\)\)\)} \
> "print full contents of the array"
>
> gdb_breakpoint [gdb_get_line_number "break-variable"]
> diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
> index e2b8d71b4cb..dbf85bb13d9 100755
> --- a/gdb/testsuite/gdb.fortran/vla-type.exp
> +++ b/gdb/testsuite/gdb.fortran/vla-type.exp
> @@ -66,9 +66,9 @@ gdb_test "ptype twov" \
> "\\s+$int, allocatable :: ivla1\\\(5,12,99\\\)" \
> "\\s+$int, allocatable :: ivla2\\\(9,12\\\)" \
> "End Type two" ]
> -gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\
> - \\\( 1, 1, 321, 1, 1\\\)\
> - \\\( 1, 1, 1, 1, 1\\\) .*"
> +gdb_test "print twov" " = \\\( ivla1 = \\\(\\\(\\\(1, 1, 1, 1, 1\\\)\
> + \\\(1, 1, 321, 1, 1\\\)\
> + \\\(1, 1, 1, 1, 1\\\) .*"
>
> # Check type with attribute at beginn of type
> gdb_breakpoint [gdb_get_line_number "threev-filled"]
> diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
> index 05e71e57ddd..e862725f48d 100644
> --- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
> +++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
> @@ -180,7 +180,7 @@ mi_run_cmd
> mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
> { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
> mi_gdb_test "590-data-evaluate-expression pvla2" \
> - "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \
> + "590\\^done,value=\"\\(\\(2, 2, 2, 2, 2\\) \\(2, 2, 2, 2, 2\\)\\)\"" \
> "evaluate associated vla"
>
> mi_create_varobj_checked pvla2_associated pvla2 \
> --
> 2.25.4
>
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv3 0/2] Fortran Array Slicing and Striding Support
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
` (9 preceding siblings ...)
2020-08-26 14:49 ` [PATCHv2 10/10] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
@ 2020-09-19 9:47 ` Andrew Burgess
2020-09-19 9:48 ` [PATCHv3 1/2] gdb: Convert enum range_type to a bit field enum Andrew Burgess
` (2 more replies)
10 siblings, 3 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-09-19 9:47 UTC (permalink / raw)
To: gdb-patches
Since v2 of this series:
- Patches 1 to 4 have been dropped, replaced by Pedro's already
committed enum_flags reworking.
- Patches 5, 6, 7, and 9 have been committed, these were refactor,
testsuite fixes, and a change in whitespace output that I thought
was an obvious improvement, so I just comitted these.
The remaining two patches are the ones that I really think need some
review before I can merge them.
All feedback is welcome.
Thanks,
Andrew
---
Andrew Burgess (2):
gdb: Convert enum range_type to a bit field enum
gdb/fortran: Add support for Fortran array slices at the GDB prompt
gdb/ChangeLog | 52 ++
gdb/Makefile.in | 1 +
gdb/NEWS | 13 +
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 30 +
gdb/expprint.c | 53 +-
gdb/expression.h | 27 +-
gdb/f-array-walker.h | 255 +++++++
gdb/f-exp.y | 52 +-
gdb/f-lang.c | 704 ++++++++++++++++--
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 190 ++---
gdb/gdbtypes.c | 12 +-
gdb/parse.c | 24 +-
gdb/rust-exp.y | 21 +-
gdb/rust-lang.c | 25 +-
gdb/testsuite/ChangeLog | 10 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 ++
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 267 ++++++-
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
24 files changed, 2129 insertions(+), 319 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv3 1/2] gdb: Convert enum range_type to a bit field enum
2020-09-19 9:47 ` [PATCHv3 0/2] Fortran Array Slicing and Striding Support Andrew Burgess
@ 2020-09-19 9:48 ` Andrew Burgess
2020-09-19 13:50 ` Simon Marchi
2020-09-19 9:48 ` [PATCHv3 2/2] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-09-28 9:40 ` [PATCHv4 0/3] Fortran Array Slicing and Striding Support Andrew Burgess
2 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-09-19 9:48 UTC (permalink / raw)
To: gdb-patches
The expression range_type enum represents the following ideas:
- Lower bound is set to default,
- Upper bound is set to default,
- Upper bound is exclusive.
There are currently 6 entries in the enum to represent the combination
of all those ideas.
In a future commit I'd like to add stride information to the range,
this could in theory appear with any of the existing enum entries, so
this would take us to 12 enum entries.
This feels like its getting a little out of hand, so in this commit I
switch the range_type enum over to being a flags style enum. There's
one entry to represent no flags being set, then 3 flags to represent
the 3 ideas above. Adding stride information will require adding only
one more enum flag.
I've then gone through and updated the code to handle this change.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* expprint.c (print_subexp_standard): Update to reflect changes to
enum range_type.
(dump_subexp_body_standard): Likewise.
* expression.h (enum range_type): Convert to a bit field enum.
* f-exp.y (subrange): Update to reflect changes to enum
range_type.
* f-lang.c (value_f90_subarray): Likewise.
* parse.c (operator_length_standard): Likewise.
* rust-exp.y (rust_parser::convert_ast_to_expression): Likewise.
* rust-lang.c (rust_range): Likewise.
(rust_compute_range): Likewise.
(rust_subscript): Likewise.
---
gdb/ChangeLog | 15 +++++++++++++++
gdb/expprint.c | 49 ++++++++++++++----------------------------------
gdb/expression.h | 24 ++++++++++++------------
gdb/f-exp.y | 14 +++++++++-----
gdb/f-lang.c | 4 ++--
gdb/parse.c | 22 +++++++---------------
gdb/rust-exp.y | 21 +++++++++++++--------
gdb/rust-lang.c | 25 +++++++++++-------------
8 files changed, 83 insertions(+), 91 deletions(-)
diff --git a/gdb/expprint.c b/gdb/expprint.c
index d7d7c871bdd..bdb69a92f75 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -585,17 +585,13 @@ print_subexp_standard (struct expression *exp, int *pos,
longest_to_int (exp->elts[pc + 1].longconst);
*pos += 2;
- if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE
- || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)
+ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
fputs_filtered ("EXCLUSIVE_", stream);
fputs_filtered ("RANGE(", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
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 & RANGE_HIGH_BOUND_DEFAULT))
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
@@ -1116,36 +1112,19 @@ dump_subexp_body_standard (struct expression *exp,
longest_to_int (exp->elts[elt].longconst);
elt += 2;
- switch (range_type)
- {
- case BOTH_BOUND_DEFAULT:
- fputs_filtered ("Range '..'", stream);
- break;
- case LOW_BOUND_DEFAULT:
- fputs_filtered ("Range '..EXP'", stream);
- break;
- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- fputs_filtered ("ExclusiveRange '..EXP'", stream);
- break;
- case HIGH_BOUND_DEFAULT:
- fputs_filtered ("Range 'EXP..'", stream);
- break;
- case NONE_BOUND_DEFAULT:
- fputs_filtered ("Range 'EXP..EXP'", stream);
- break;
- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
- break;
- default:
- fputs_filtered ("Invalid Range!", stream);
- break;
- }
+ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
+ fputs_filtered ("Exclusive", stream);
+ fputs_filtered ("Range '", stream);
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ fputs_filtered ("EXP", stream);
+ fputs_filtered ("..", stream);
+ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ fputs_filtered ("EXP", stream);
+ fputs_filtered ("'", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
- if (range_type == LOW_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 5af10f05db1..9dc598984e0 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -187,20 +187,20 @@ extern void dump_prefix_expression (struct expression *, struct ui_file *);
enum range_type
{
- /* Neither the low nor the high bound was given -- so this refers to
- the entire available range. */
- BOTH_BOUND_DEFAULT,
+ /* This is a standard range. Both the lower and upper bounds are
+ defined, and the bounds are inclusive. */
+ RANGE_STANDARD = 0,
+
/* The low bound was not given and the high bound is inclusive. */
- LOW_BOUND_DEFAULT,
+ RANGE_LOW_BOUND_DEFAULT = 1 << 0,
+
/* The high bound was not given and the low bound in inclusive. */
- HIGH_BOUND_DEFAULT,
- /* Both bounds were given and both are inclusive. */
- NONE_BOUND_DEFAULT,
- /* The low bound was not given and the high bound is exclusive. */
- NONE_BOUND_DEFAULT_EXCLUSIVE,
- /* Both bounds were given. The low bound is inclusive and the high
- bound is exclusive. */
- LOW_BOUND_DEFAULT_EXCLUSIVE,
+ RANGE_HIGH_BOUND_DEFAULT = 1 << 1,
+
+ /* The high bound of this range is exclusive. */
+ RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
};
+DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
+
#endif /* !defined (EXPRESSION_H) */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 0ccb3c68d3e..a3314082d90 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -287,26 +287,30 @@ 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, RANGE_STANDARD);
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,
+ RANGE_HIGH_BOUND_DEFAULT);
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,
+ RANGE_LOW_BOUND_DEFAULT);
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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HIGH_BOUND_DEFAULT));
write_exp_elt_opcode (pstate, OP_RANGE); }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index e13097baee4..fcab973f874 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -131,12 +131,12 @@ value_f90_subarray (struct value *array,
*pos += 3;
- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ if (range_type & RANGE_LOW_BOUND_DEFAULT)
low_bound = range->bounds ()->low.const_val ();
else
low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ if (range_type & RANGE_HIGH_BOUND_DEFAULT)
high_bound = range->bounds ()->high.const_val ();
else
high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
diff --git a/gdb/parse.c b/gdb/parse.c
index 6b9541bfdc2..6661fba81d7 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -921,21 +921,13 @@ operator_length_standard (const struct expression *expr, int endpos,
range_type = (enum range_type)
longest_to_int (expr->elts[endpos - 2].longconst);
- switch (range_type)
- {
- case LOW_BOUND_DEFAULT:
- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- case HIGH_BOUND_DEFAULT:
- args = 1;
- break;
- case BOTH_BOUND_DEFAULT:
- args = 0;
- break;
- case NONE_BOUND_DEFAULT:
- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- args = 2;
- break;
- }
+ /* Assume the range has 2 arguments (low bound and high bound), then
+ reduce the argument count if any bounds are set to default. */
+ args = 2;
+ if (range_type & RANGE_LOW_BOUND_DEFAULT)
+ --args;
+ if (range_type & RANGE_HIGH_BOUND_DEFAULT)
+ --args;
break;
diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
index db888098c4a..5111de9cf9c 100644
--- a/gdb/rust-exp.y
+++ b/gdb/rust-exp.y
@@ -2492,24 +2492,29 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
case OP_RANGE:
{
- enum range_type kind = BOTH_BOUND_DEFAULT;
+ enum range_type kind = (RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_LOW_BOUND_DEFAULT);
if (operation->left.op != NULL)
{
convert_ast_to_expression (operation->left.op, top);
- kind = HIGH_BOUND_DEFAULT;
+ kind = RANGE_HIGH_BOUND_DEFAULT;
}
if (operation->right.op != NULL)
{
convert_ast_to_expression (operation->right.op, top);
- if (kind == BOTH_BOUND_DEFAULT)
- kind = (operation->inclusive
- ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE);
+ if (kind == (RANGE_HIGH_BOUND_DEFAULT | RANGE_LOW_BOUND_DEFAULT))
+ {
+ kind = RANGE_LOW_BOUND_DEFAULT;
+ if (!operation->inclusive)
+ kind |= RANGE_HIGH_BOUND_EXCLUSIVE;
+ }
else
{
- gdb_assert (kind == HIGH_BOUND_DEFAULT);
- kind = (operation->inclusive
- ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE);
+ gdb_assert (kind == RANGE_HIGH_BOUND_DEFAULT);
+ kind = RANGE_STANDARD;
+ if (!operation->inclusive)
+ kind |= RANGE_HIGH_BOUND_EXCLUSIVE;
}
}
else
diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
index f7c762eb640..820ebb92c43 100644
--- a/gdb/rust-lang.c
+++ b/gdb/rust-lang.c
@@ -1077,13 +1077,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
*pos += 3;
- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT
- || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(kind & RANGE_LOW_BOUND_DEFAULT))
low = evaluate_subexp (nullptr, exp, pos, noside);
- if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE
- || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(kind & RANGE_HIGH_BOUND_DEFAULT))
high = evaluate_subexp (nullptr, exp, pos, noside);
- bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT);
+ bool inclusive = !(kind & RANGE_HIGH_BOUND_EXCLUSIVE);
if (noside == EVAL_SKIP)
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
@@ -1166,13 +1164,13 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
static void
rust_compute_range (struct type *type, struct value *range,
LONGEST *low, LONGEST *high,
- enum range_type *kind)
+ range_types *kind)
{
int i;
*low = 0;
*high = 0;
- *kind = BOTH_BOUND_DEFAULT;
+ *kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
if (type->num_fields () == 0)
return;
@@ -1180,15 +1178,15 @@ 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 = RANGE_HIGH_BOUND_DEFAULT;
*low = value_as_long (value_field (range, 0));
++i;
}
if (type->num_fields () > i
&& strcmp (TYPE_FIELD_NAME (type, i), "end") == 0)
{
- *kind = (*kind == BOTH_BOUND_DEFAULT
- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
+ *kind = (*kind == (RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT)
+ ? RANGE_LOW_BOUND_DEFAULT : RANGE_STANDARD);
*high = value_as_long (value_field (range, i));
if (rust_inclusive_range_type_p (type))
@@ -1206,7 +1204,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;
+ range_types kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
LONGEST high = 0;
int want_slice = 0;
@@ -1303,8 +1301,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
else
error (_("Cannot subscript non-array type"));
- if (want_slice
- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT))
+ if (want_slice && (kind & RANGE_LOW_BOUND_DEFAULT))
low = low_bound;
if (low < 0)
error (_("Index less than zero"));
@@ -1322,7 +1319,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 & RANGE_HIGH_BOUND_DEFAULT)
high = high_bound;
if (high < 0)
error (_("High index less than zero"));
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv3 2/2] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-09-19 9:47 ` [PATCHv3 0/2] Fortran Array Slicing and Striding Support Andrew Burgess
2020-09-19 9:48 ` [PATCHv3 1/2] gdb: Convert enum range_type to a bit field enum Andrew Burgess
@ 2020-09-19 9:48 ` Andrew Burgess
2020-09-19 10:03 ` Eli Zaretskii
2020-09-28 9:40 ` [PATCHv4 0/3] Fortran Array Slicing and Striding Support Andrew Burgess
2 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-09-19 9:48 UTC (permalink / raw)
To: gdb-patches
This commit brings array slice support to GDB.
WARNING: This patch contains a rather big hack which is limited to
Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More
details on this below.
This patch rewrites two areas of GDB's Fortran support, the code to
extract an array slice, and the code to print an array.
After this commit a user can, from the GDB prompt, ask for a slice of
a Fortran array and should get the correct result back. Slices can
(optionally) have the lower bound, upper bound, and a stride
specified. Slices can also have a negative stride.
Fortran has the concept of repacking array slices. Within a compiled
Fortran program if a user passes a non-contiguous array slice to a
function then the compiler may have to repack the slice, this involves
copying the elements of the slice to a new area of memory before the
call, and copying the elements back to the original array after the
call. Whether repacking occurs will depend on which version of
Fortran is being used, and what type of function is being called.
This commit adds support for both packed, and unpacked array slicing,
with the default being unpacked.
With an unpacked array slice, when the user asks for a slice of an
array GDB creates a new type that accurately describes where the
elements of the slice can be found within the original array, a
value of this type is then returned to the user. The address of an
element within the slice will be equal to the address of an element
within the original array.
A user can choose to selected packed array slices instead using:
(gdb) set fortran repack-array-slices on|off
(gdb) show fortran repack-array-slices
With packed array slices GDB creates a new type that reflects how the
elements of the slice would look if they were laid out in contiguous
memory, allocates a value of this type, and then fetches the elements
from the original array and places then into the contents buffer of
the new value.
One benefit of using packed slices over unapacked slices is the memory
usage, taking a small slice of N elements from a large array will
require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked
array will also include all of the "padding" between the
non-contiguous elements. There are new tests added that highlight
this difference.
There is also a new debugging flag added with this commit that
introduces these commands:
(gdb) set debug fortran-array-slicing on|off
(gdb) show debug fortran-array-slicing
This prints information about how the array slices are being built.
As both the repacking, and the array printing requires GDB to walk
through a multi-dimensional Fortran array visiting each element, this
commit adds the file f-array-walk.h, which introduces some
infrastructure to support this process. This means the array printing
code in f-valprint.c is significantly reduced.
The only slight issue with this commit is the "rather big hack" that I
mentioned above. This hack allows us to handle one specific case,
array slices with negative strides. This is something that I don't
believe the current GDB value contents model will allow us to
"correctly" handle, and rather than rewrite the value contents code
right now, I'm hoping to slip this hack in as a work around.
The problem is that as I see it the current value contents model
assumes that an object base address will be the lowest address within
that object, and that the contents of the object start at this base
address and occupy the TYPE_LENGTH bytes after that.
We do have the embedded_offset, which is used for C++ sub-classes,
such that an object can start at some offset from the content buffer,
however, the assumption that the object then occupies the next
TYPE_LENGTH bytes is still true within GDB.
The problem is that Fortran arrays with a negative stride don't follow
this pattern. In this case the base address of the object points to
the element with the highest address, the contents of the array then
start at some offset _before_ the base address, and proceed for one
element _past_ the base address.
This is further complicated because arrays with negative strides like
this are always dynamic types, the program being debugged has passed a
slice with a negative stride to a function, and it is only when we
actually try to look at the slice within the function that the dynamic
type is resolved, and the negative type is seen. When dealing with
dynamic types like this the address is actually stored on the _type_,
not the value, this dynamic address then overrides the value's address
in the value_address function.
I currently don't see any way to handle this address configuration
with GDB's current dynamic type and value system, which is why I've
added this hack:
When we resolve a dynamic Fortran array type, if the stride is
negative, then we adjust the base address to point to the lowest
address required by the array. The printing and slicing code is aware
of this adjustment and will correctly slice and print Fortran arrays.
Where this hack will show through to the user is if they ask for the
address of an array in their program with a negative array stride, the
address they get from GDB will not match the address that would be
computed within the Fortran program.
gdb/ChangeLog:
* Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
* NEWS: Mention new options.
* expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE.
* expression.h (enum range_type): Add RANGE_HAS_STRIDE.
* f-array-walker.h: New file.
* f-exp.y (arglist): Allow for a series of subranges.
(subrange): Add cases for subranges with strides.
* f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
(repack_array_slices): New static global.
(show_repack_array_slices): New function.
(fortran_array_slicing_debug): New static global.
(show_fortran_array_slicing_debug): New function.
(value_f90_subarray): Delete.
(skip_undetermined_arglist): Delete.
(class fortran_array_repacker_base_impl): New class.
(class fortran_lazy_array_repacker_impl): New class.
(class fortran_array_repacker_impl): New class.
(fortran_value_subarray): Complete rewrite.
(set_fortran_list): New static global.
(show_fortran_list): Likewise.
(_initialize_f_language): Register new commands.
(fortran_adjust_dynamic_array_base_address_hack): New function.
* f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
Declare.
* f-valprint.c: Include 'f-array-walker.h'.
(class fortran_array_printer_impl): New class.
(f77_print_array_1): Delete.
(f77_print_array): Delete.
(fortran_print_array): New.
(f_value_print_inner): Update to call fortran_print_array.
* gdbtypes.c: Include 'f-lang.h'.
(resolve_dynamic_type_internal): Call
fortran_adjust_dynamic_array_base_address_hack.
* parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE.
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices-bad.exp: New file.
* gdb.fortran/array-slices-bad.f90: New file.
* gdb.fortran/array-slices-sub-slices.exp: New file.
* gdb.fortran/array-slices-sub-slices.f90: New file.
* gdb.fortran/array-slices.exp: Rewrite tests.
* gdb.fortran/array-slices.f90: Rewrite tests.
* gdb.fortran/vla-sizeof.exp: Correct expected results.
gdb/doc/ChangeLog:
* gdb.texinfo (Debugging Output): Document 'set/show debug
fotran-array-slicing'.
(Special Fortran Commands): Document 'set/show fortran
repack-array-slices'.
---
gdb/ChangeLog | 37 +
gdb/Makefile.in | 1 +
gdb/NEWS | 13 +
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 30 +
gdb/expprint.c | 4 +
gdb/expression.h | 3 +
gdb/f-array-walker.h | 255 +++++++
gdb/f-exp.y | 38 +
gdb/f-lang.c | 704 ++++++++++++++++--
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 190 ++---
gdb/gdbtypes.c | 12 +-
gdb/parse.c | 2 +
gdb/testsuite/ChangeLog | 10 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 ++
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 267 ++++++-
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
22 files changed, 2048 insertions(+), 230 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
diff --git a/gdb/Makefile.in b/gdb/Makefile.in
index dbede7a9cfc..5bd8751cf1e 100644
--- a/gdb/Makefile.in
+++ b/gdb/Makefile.in
@@ -1269,6 +1269,7 @@ HFILES_NO_SRCDIR = \
expression.h \
extension.h \
extension-priv.h \
+ f-array-walker.h \
f-lang.h \
fbsd-nat.h \
fbsd-tdep.h \
diff --git a/gdb/NEWS b/gdb/NEWS
index f30d7183312..81b8f95595b 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -123,6 +123,19 @@ maintenance print core-file-backed-mappings
Prints file-backed mappings loaded from a core file's note section.
Output is expected to be similar to that of "info proc mappings".
+set debug fortran-array-slicing on|off
+show debug fortran-array-slicing
+ Print debugging when taking slices of Fortran arrays.
+
+set fortran repack-array-slices on|off
+show fortran repack-array-slices
+ When taking slices from Fortran arrays and strings, if the slice is
+ non-contiguous within the original value then, when this option is
+ on, the new value will be repacked into a single contiguous value.
+ When this option is off then the value returned will consist of a
+ descriptor that describes the slice within the memory of the
+ original parent value.
+
* Changed commands
alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...]
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index 8bff27c940d..dc165d91744 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -16919,6 +16919,29 @@
block whose name is @var{common-name}. With no argument, the names of
all @code{COMMON} blocks visible at the current program location are
printed.
+@cindex arrays slices (Fortran)
+@kindex set fortran repack-array-slices
+@kindex show fortran repack-array-slices
+@item set fortran repack-array-slices [on|off]
+@item show fortran repack-array-slices
+When taking a slice from an array a Fortran compiler can choose to
+either produce an array descriptor that describes the slice in place,
+or it may repack the slice, copying the elements of the slice into a
+new region of memory.
+
+When this setting is on then @value{GDBN} will also repack array
+slices in some situations. When this setting is off then @value{GDBN}
+will create array descriptors for slices that reference the original
+data in place.
+
+@value{GDBN} will never repack an array slice if the data for the
+slice is contiguous within the original array.
+
+@value{GDBN} will always repack string slices if the data for the
+slice is non-contiguous within the original string as @value{GDBN}
+does not support printing non-contiguous strings.
+
+The default for this setting is @code{off}.
@end table
@node Pascal
@@ -26486,6 +26509,13 @@
Turns on or off debugging messages from the FreeBSD native target.
@item show debug fbsd-nat
Show the current state of FreeBSD native target debugging messages.
+@item set debug fortran-array-slicing
+@cindex fortran array slicing debugging info
+Turns on or off display of @value{GDBN} Fortran array slicing
+debugging info. The default is off.
+@item show debug fortran-array-slicing
+Displays the current state of displaying @value{GDBN} Fortran array
+slicing debugging info.
@item set debug frame
@cindex frame debugging info
Turns on or off display of @value{GDBN} frame debugging info. The
diff --git a/gdb/expprint.c b/gdb/expprint.c
index bdb69a92f75..f4f2070af63 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -1120,12 +1120,16 @@ dump_subexp_body_standard (struct expression *exp,
fputs_filtered ("..", stream);
if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
fputs_filtered ("EXP", stream);
+ if (range_type & RANGE_HAS_STRIDE)
+ fputs_filtered (":EXP", stream);
fputs_filtered ("'", stream);
if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
+ if (range_type & RANGE_HAS_STRIDE)
+ elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 9dc598984e0..4d712a7735c 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -199,6 +199,9 @@ enum range_type
/* The high bound of this range is exclusive. */
RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
+
+ /* The range has a stride. */
+ RANGE_HAS_STRIDE = 1 << 3,
};
DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h
new file mode 100644
index 00000000000..395c26e5350
--- /dev/null
+++ b/gdb/f-array-walker.h
@@ -0,0 +1,255 @@
+/* Copyright (C) 2020 Free Software Foundation, Inc.
+
+ This file is part of GDB.
+
+ 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/>. */
+
+/* Support classes to wrap up the process of iterating over a
+ multi-dimensional Fortran array. */
+
+#ifndef F_ARRAY_WALKER_H
+#define F_ARRAY_WALKER_H
+
+#include "defs.h"
+#include "gdbtypes.h"
+#include "f-lang.h"
+
+/* Class for calculating the byte offset for elements within a single
+ dimension of a Fortran array. */
+class fortran_array_offset_calculator
+{
+public:
+ /* Create a new offset calculator for TYPE, which is either an array or a
+ string. */
+ fortran_array_offset_calculator (struct type *type)
+ {
+ /* Validate the type. */
+ type = check_typedef (type);
+ if (type->code () != TYPE_CODE_ARRAY
+ && (type->code () != TYPE_CODE_STRING))
+ error (_("can only compute offsets for arrays and strings"));
+
+ /* Get the range, and extract the bounds. */
+ struct type *range_type = type->index_type ();
+ if (get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound) < 0)
+ error ("unable to read array bounds");
+
+ /* Figure out the stride for this array. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ m_stride = type->index_type ()->bounds ()->bit_stride ();
+ if (m_stride == 0)
+ m_stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ m_stride /= (unit_size * 8);
+ }
+ };
+
+ /* Get the byte offset for element INDEX within the type we are working
+ on. There is no bounds checking done on INDEX. If the stride is
+ negative then we still assume that the base address (for the array
+ object) points to the element with the lowest memory address, we then
+ calculate an offset assuming that index 0 will be the element at the
+ highest address, index 1 the next highest, and so on. This is not
+ quite how Fortran works in reality; in reality the base address of
+ the object would point at the element with the highest address, and
+ we would index backwards from there in the "normal" way, however,
+ GDB's current value contents model doesn't support having the base
+ address be near to the end of the value contents, so we currently
+ adjust the base address of Fortran arrays with negative strides so
+ their base address points at the lowest memory address. This code
+ here is part of working around this weirdness. */
+ LONGEST index_offset (LONGEST index)
+ {
+ LONGEST offset;
+ if (m_stride < 0)
+ offset = std::abs (m_stride) * (m_upperbound - index);
+ else
+ offset = std::abs (m_stride) * (index - m_lowerbound);
+ return offset;
+ }
+
+private:
+
+ /* The stride for the type we are working with. */
+ LONGEST m_stride;
+
+ /* The upper bound for the type we are working with. */
+ LONGEST m_upperbound;
+
+ /* The lower bound for the type we are working with. */
+ LONGEST m_lowerbound;
+};
+
+/* A base class used by fortran_array_walker. */
+class fortran_array_walker_base_impl
+{
+public:
+ /* Constructor. */
+ explicit fortran_array_walker_base_impl ()
+ { /* Nothing. */ }
+
+ /* Called when iterating between the lower and upper bounds of each
+ dimension of the array. Return true if GDB should continue iterating,
+ otherwise, return false.
+
+ SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
+ be taken into consideration when deciding what to return. If
+ SHOULD_CONTINUE is false then this function must also return false,
+ the function is still called though in case extra work needs to be
+ done as part of the stopping process. */
+ bool continue_walking (bool should_continue)
+ { return should_continue; }
+
+ /* Called when GDB starts iterating over a dimension of the array. This
+ function will be called once for each of the bounds in this dimension.
+ DIM is the current dimension number, NDIM is the total number of
+ dimensions, and FIRST_P is true for the first bound of this
+ dimension, and false in all other cases. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ { /* Nothing. */ }
+
+ /* Called when GDB finishes iterating over a dimension of the array.
+ This function will be called once for each of the bounds in this
+ dimension. DIM is the current dimension number, NDIM is the total
+ number of dimensions, and LAST_P is true for the last bound of this
+ dimension, and false in all other cases. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ { /* Nothing. */ }
+
+ /* Called when processing the inner most dimension of the array, for
+ every element in the array. PARENT_VALUE is the value from which
+ elements are being extracted, ELT_TYPE is the type of the element
+ being extracted, and ELT_OFF is the offset of the element from the
+ start of PARENT_VALUE. */
+ void process_element (struct value *parent_value, struct type *elt_type,
+ LONGEST elt_off)
+ { /* Nothing. */ }
+};
+
+/* A class to wrap up the process of iterating over a multi-dimensional
+ Fortran array. IMPL is used to specialise what happens as we walk over
+ the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
+ methods than can be used to customise the array walk. */
+template<typename Impl>
+class fortran_array_walker
+{
+ /* Ensure that Impl is derived from the required base class. This just
+ ensures that all of the required API methods are available and have a
+ sensible default implementation. */
+ gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
+
+public:
+ /* Create a new array walker. TYPE is the type of the array being walked
+ over, and ADDRESS is the base address for the object of TYPE in
+ memory. All other arguments are forwarded to the constructor of the
+ template parameter class IMPL. */
+ template <typename ...Args>
+ fortran_array_walker (struct type *type, CORE_ADDR address,
+ Args... args)
+ : m_type (type),
+ m_address (address),
+ m_impl (type, address, args...)
+ {
+ m_ndimensions = calc_f77_array_dims (m_type);
+ }
+
+ /* Walk the array. */
+ void
+ walk ()
+ {
+ walk_1 (1, m_type, 0);
+ }
+
+private:
+ /* The core of the array walking algorithm. NSS is the current
+ dimension number being processed, TYPE is the type of this dimension,
+ and OFFSET is the offset (in bytes) for the start of this dimension. */
+ void
+ walk_1 (int nss, struct type *type, int offset)
+ {
+ /* Extract the range, and get lower and upper bounds. */
+ struct type *range_type = check_typedef (type)->index_type ();
+ LONGEST lowerbound, upperbound;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* CALC is used to calculate the offsets for each element in this
+ dimension. */
+ fortran_array_offset_calculator calc (type);
+
+ if (nss != m_ndimensions)
+ {
+ /* For dimensions other than the inner most, walk each element and
+ recurse while peeling off one more dimension of the array. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ m_impl.start_dimension (nss, m_ndimensions, (i == lowerbound));
+
+ /* Use the index and the stride to work out a new offset. */
+ LONGEST new_offset = offset + calc.index_offset (i);
+
+ /* Now print the lower dimension. */
+ struct type *subarray_type
+ = TYPE_TARGET_TYPE (check_typedef (type));
+ walk_1 (nss + 1, subarray_type, new_offset);
+
+ m_impl.finish_dimension (nss, m_ndimensions, (i == upperbound));
+ }
+ }
+ else
+ {
+ /* For the inner most dimension of the array, process each element
+ within this dimension. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ m_impl.start_dimension (nss, m_ndimensions, (i == lowerbound));
+
+ LONGEST elt_off = offset + calc.index_offset (i);
+
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ if (is_dynamic_type (elt_type))
+ {
+ CORE_ADDR e_address = m_address + elt_off;
+ elt_type = resolve_dynamic_type (elt_type, {}, e_address);
+ }
+
+ m_impl.process_element (elt_type, elt_off);
+
+ m_impl.finish_dimension (nss, m_ndimensions, (i == upperbound));
+ }
+ }
+ }
+
+ /* The array type being processed. */
+ struct type *m_type;
+
+ /* The address in target memory for the object of M_TYPE being
+ processed. This is required in order to resolve dynamic types. */
+ CORE_ADDR m_address;
+
+ /* An instance of the template specialisation class. */
+ Impl m_impl;
+
+ /* The total number of dimensions in M_TYPE. */
+ int m_ndimensions;
+};
+
+#endif /* F_ARRAY_WALKER_H */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index a3314082d90..f227690cea6 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -284,6 +284,10 @@ arglist : arglist ',' exp %prec ABOVE_COMMA
{ pstate->arglist_len++; }
;
+arglist : arglist ',' subrange %prec ABOVE_COMMA
+ { pstate->arglist_len++; }
+ ;
+
/* There are four sorts of subrange types in F90. */
subrange: exp ':' exp %prec ABOVE_COMMA
@@ -314,6 +318,40 @@ subrange: ':' %prec ABOVE_COMMA
write_exp_elt_opcode (pstate, OP_RANGE); }
;
+/* And each of the four subrange types can also have a stride. */
+subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (pstate, OP_RANGE);
+ write_exp_elt_longcst (pstate,
+ (RANGE_STANDARD
+ | RANGE_HAS_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,
+ (RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_HAS_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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HAS_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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_HAS_STRIDE));
+ write_exp_elt_opcode (pstate, OP_RANGE); }
+ ;
+
complexnum: exp ',' exp
{ }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index fcab973f874..5a3871adb03 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -36,9 +36,36 @@
#include "c-lang.h"
#include "target-float.h"
#include "gdbarch.h"
+#include "gdbcmd.h"
+#include "f-array-walker.h"
#include <math.h>
+/* Whether GDB should repack array slices created by the user. */
+static bool repack_array_slices = false;
+
+/* Implement 'show fortran repack-array-slices'. */
+static void
+show_repack_array_slices (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c, const char *value)
+{
+ fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"),
+ value);
+}
+
+/* Debugging of Fortran's array slicing. */
+static bool fortran_array_slicing_debug = false;
+
+/* Implement 'show debug fortran-array-slicing'. */
+static void
+show_fortran_array_slicing_debug (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c,
+ const char *value)
+{
+ fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"),
+ value);
+}
+
/* Local functions */
/* Return the encoding that should be used for the character type
@@ -114,49 +141,6 @@ enum f_primitive_types {
nr_f_primitive_types
};
-/* Called from fortran_value_subarray to take a slice of an array or a
- string. ARRAY is the array or string to be accessed. EXP, POS, and
- NOSIDE are as for evaluate_subexp_standard. Return a value that is a
- slice of the array. */
-
-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 (value_type (array)->index_type ());
- enum range_type range_type
- = (enum range_type) longest_to_int (exp->elts[pc].longconst);
-
- *pos += 3;
-
- if (range_type & RANGE_LOW_BOUND_DEFAULT)
- low_bound = range->bounds ()->low.const_val ();
- else
- low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
-
- if (range_type & RANGE_HIGH_BOUND_DEFAULT)
- high_bound = range->bounds ()->high.const_val ();
- else
- high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
-
- return value_slice (array, low_bound, high_bound - low_bound + 1);
-}
-
-/* Helper for skipping all the arguments in an undetermined argument list.
- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
- case of evaluate_subexp_standard as multiple, but not all, code paths
- require a generic skip. */
-
-static void
-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
- enum noside noside)
-{
- for (int i = 0; i < nargs; ++i)
- evaluate_subexp (nullptr, exp, pos, noside);
-}
-
/* Return the number of dimensions for a Fortran array or string. */
int
@@ -181,6 +165,145 @@ calc_f77_array_dims (struct type *array_type)
return ndimen;
}
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This is a base class for two alternative repacking mechanisms,
+ one for when repacking from a lazy value, and one for repacking from a
+ non-lazy (already loaded) value. */
+class fortran_array_repacker_base_impl
+ : public fortran_array_walker_base_impl
+{
+public:
+ /* Constructor, DEST is the value we are repacking into. */
+ fortran_array_repacker_base_impl (struct value *dest)
+ : m_dest (dest),
+ m_dest_offset (0)
+ { /* Nothing. */ }
+
+ /* When we start processing the inner most dimension, this is where we
+ will be creating values for each element as we load them and then copy
+ them into the M_DEST value. Set a value mark so we can free these
+ temporary values. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ {
+ if (dim == ndim && first_p)
+ {
+ gdb_assert (m_mark == nullptr);
+ m_mark = value_mark ();
+ }
+ }
+
+ /* When we finish processing the inner most dimension free all temporary
+ value that were created. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ {
+ if (dim == ndim && last_p)
+ {
+ gdb_assert (m_mark != nullptr);
+ value_free_to_mark (m_mark);
+ m_mark = nullptr;
+ }
+ }
+
+protected:
+ /* Copy the contents of array element ELT into M_DEST at the next
+ available offset. */
+ void copy_element_to_dest (struct value *elt)
+ {
+ value_contents_copy (m_dest, m_dest_offset, elt, 0,
+ TYPE_LENGTH (value_type (elt)));
+ m_dest_offset += TYPE_LENGTH (value_type (elt));
+ }
+
+ /* The value being written to. */
+ struct value *m_dest;
+
+ /* The byte offset in M_DEST at which the next element should be
+ written. */
+ LONGEST m_dest_offset;
+
+ /* Set with a call to VALUE_MARK, and then reset after calling
+ VALUE_FREE_TO_MARK. */
+ struct value *m_mark = nullptr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ lazy array value, as such it does not require the parent array value to
+ be loaded into GDB's memory; the parent value could be huge, while the
+ slice could be tiny. */
+class fortran_lazy_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type of the slice being loaded from the
+ parent value, so this type will correctly reflect the strides required
+ to find all of the elements from the parent value. ADDRESS is the
+ address in target memory of value matching TYPE, and DEST is the value
+ we are repacking into. */
+ explicit fortran_lazy_array_repacker_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_addr (address)
+ { /* Nothing. */ }
+
+ /* Create a lazy value in target memory representing a single element,
+ then load the element into GDB's memory and copy the contents into the
+ destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off));
+ }
+
+private:
+ /* The address in target memory where the parent value starts. */
+ CORE_ADDR m_addr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ previously loaded (non-lazy) array value, as such it fetches the
+ element values from the contents of the parent value. */
+class fortran_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type for the array slice within the parent
+ value, as such it has stride values as required to find the elements
+ within the original parent value. ADDRESS is the address in target
+ memory of the value matching TYPE. BASE_OFFSET is the offset from
+ the start of VAL's content buffer to the start of the object of TYPE,
+ VAL is the parent object from which we are loading the value, and
+ DEST is the value into which we are repacking. */
+ explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address,
+ LONGEST base_offset,
+ struct value *val, struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_base_offset (base_offset),
+ m_val (val)
+ {
+ gdb_assert (!value_lazy (val));
+ }
+
+ /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF)
+ from the content buffer of M_VAL then copy this extracted value into
+ the repacked destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ struct value *elt
+ = value_from_component (m_val, elt_type, (elt_off + m_base_offset));
+ copy_element_to_dest (elt);
+ }
+
+private:
+ /* The offset into the content buffer of M_VAL to the start of the slice
+ being extracted. */
+ LONGEST m_base_offset;
+
+ /* The parent value from which we are extracting a slice. */
+ struct value *m_val;
+};
+
/* Called from evaluate_subexp_standard to perform array indexing, and
sub-range extraction, for Fortran. As well as arrays this function
also handles strings as they can be treated like arrays of characters.
@@ -192,51 +315,394 @@ static struct value *
fortran_value_subarray (struct value *array, struct expression *exp,
int *pos, int nargs, enum noside noside)
{
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (array, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
+ type *original_array_type = check_typedef (value_type (array));
+ bool is_string_p = original_array_type->code () == TYPE_CODE_STRING;
+
+ /* Perform checks for ARRAY not being available. The somewhat overly
+ complex logic here is just to keep backward compatibility with the
+ errors that we used to get before FORTRAN_VALUE_SUBARRAY was
+ rewritten. Maybe a future task would streamline the error messages we
+ get here, and update all the expected test results. */
+ if (exp->elts[*pos].opcode != OP_RANGE)
{
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return array;
+ if (type_not_associated (original_array_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (original_array_type))
+ error (_("no such vector element (vector not allocated)"));
+ }
+ else
+ {
+ if (type_not_associated (original_array_type))
+ error (_("array not associated"));
+ else if (type_not_allocated (original_array_type))
+ error (_("array not allocated"));
}
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1;
- struct type *type = check_typedef (value_type (array));
+ /* First check that the number of dimensions in the type we are slicing
+ matches the number of arguments we were passed. */
+ int ndimensions = calc_f77_array_dims (original_array_type);
+ if (nargs != ndimensions)
+ error (_("Wrong number of subscripts"));
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+ /* This will be initialised below with the type of the elements held in
+ ARRAY. */
+ struct type *inner_element_type;
+
+ /* Extract the types of each array dimension from the original array
+ type. We need these available so we can fill in the default upper and
+ lower bounds if the user requested slice doesn't provide that
+ information. Additionally unpacking the dimensions like this gives us
+ the inner element type. */
+ std::vector<struct type *> dim_types;
+ {
+ dim_types.reserve (ndimensions);
+ struct type *type = original_array_type;
+ for (int i = 0; i < ndimensions; ++i)
+ {
+ dim_types.push_back (type);
+ type = TYPE_TARGET_TYPE (type);
+ }
+ /* TYPE is now the inner element type of the array, we start the new
+ array slice off as this type, then as we process the requested slice
+ (from the user) we wrap new types around this to build up the final
+ slice type. */
+ inner_element_type = type;
+ }
- ndimensions = calc_f77_array_dims (type);
+ /* As we analyse the new slice type we need to understand if the data
+ being referenced is contiguous. Do decide this we must track the size
+ of an element at each dimension of the new slice array. Initially the
+ elements of the inner most dimension of the array are the same inner
+ most elements as the original ARRAY. */
+ LONGEST slice_element_size = TYPE_LENGTH (inner_element_type);
+
+ /* Start off assuming all data is contiguous, this will be set to false
+ if access to any dimension results in non-contiguous data. */
+ bool is_all_contiguous = true;
+
+ /* The TOTAL_OFFSET is the distance in bytes from the start of the
+ original ARRAY to the start of the new slice. This is calculated as
+ we process the information from the user. */
+ LONGEST total_offset = 0;
+
+ /* A structure representing information about each dimension of the
+ resulting slice. */
+ struct slice_dim
+ {
+ /* Constructor. */
+ slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx)
+ : low (l),
+ high (h),
+ stride (s),
+ index (idx)
+ { /* Nothing. */ }
+
+ /* The low bound for this dimension of the slice. */
+ LONGEST low;
+
+ /* The high bound for this dimension of the slice. */
+ LONGEST high;
+
+ /* The byte stride for this dimension of the slice. */
+ LONGEST stride;
+
+ struct type *index;
+ };
+
+ /* The dimensions of the resulting slice. */
+ std::vector<slice_dim> slice_dims;
+
+ /* Process the incoming arguments. These arguments are in the reverse
+ order to the array dimensions, that is the first argument refers to
+ the last array dimension. */
+ if (fortran_array_slicing_debug)
+ debug_printf ("Processing array access:\n");
+ for (int i = 0; i < nargs; ++i)
+ {
+ /* For each dimension of the array the user will have either provided
+ a ranged access with optional lower bound, upper bound, and
+ stride, or the user will have supplied a single index. */
+ struct type *dim_type = dim_types[ndimensions - (i + 1)];
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ {
+ int pc = (*pos) + 1;
+ enum range_type range_type = (enum range_type) exp->elts[pc].longconst;
+ *pos += 3;
+
+ LONGEST low, high, stride;
+ low = high = stride = 0;
+
+ if ((range_type & RANGE_LOW_BOUND_DEFAULT) == 0)
+ low = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ low = f77_get_lowerbound (dim_type);
+ if ((range_type & RANGE_HIGH_BOUND_DEFAULT) == 0)
+ high = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ high = f77_get_upperbound (dim_type);
+ if ((range_type & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
+ stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ stride = 1;
+
+ if (stride == 0)
+ error (_("stride must not be 0"));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride ();
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type) * 8;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Range access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Bit stride: %ld\n", sd);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd / 8);
+ debug_printf ("| | |-> Type size: %ld\n",
+ TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| |-> Accessing:\n");
+ debug_printf ("| | |-> Low bound: %ld\n",
+ low);
+ debug_printf ("| | |-> High bound: %ld\n",
+ high);
+ debug_printf ("| | '-> Element stride: %ld\n",
+ stride);
+ }
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
+ /* Check the user hasn't asked for something invalid. */
+ if (high > ub || low < lb)
+ error (_("array subscript out of bounds"));
+
+ /* Calculate what this dimension of the new slice array will look
+ like. OFFSET is the byte offset from the start of the
+ previous (more outer) dimension to the start of this
+ dimension. E_COUNT is the number of elements in this
+ dimension. REMAINDER is the number of elements remaining
+ between the last included element and the upper bound. For
+ example an access '1:6:2' will include elements 1, 3, 5 and
+ have a remainder of 1 (element #6). */
+ LONGEST lowest = std::min (low, high);
+ LONGEST offset = (sd / 8) * (lowest - lb);
+ LONGEST e_count = std::abs (high - low) + 1;
+ e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride);
+ LONGEST new_low = 1;
+ LONGEST new_high = new_low + e_count - 1;
+ LONGEST new_stride = (sd * stride) / 8;
+ LONGEST last_elem = low + ((e_count - 1) * stride);
+ LONGEST remainder = high - last_elem;
+ if (low > high)
+ {
+ offset += std::abs (remainder) * TYPE_LENGTH (target_type);
+ if (stride > 0)
+ error (_("incorrect stride and boundary combination"));
+ }
+ else if (stride < 0)
+ error (_("incorrect stride and boundary combination"));
+
+ /* Is the data within this dimension contiguous? It is if the
+ newly computed stride is the same size as a single element of
+ this dimension. */
+ bool is_dim_contiguous = (new_stride == slice_element_size);
+ is_all_contiguous &= is_dim_contiguous;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("| '-> Results:\n");
+ debug_printf ("| |-> Offset = %ld\n", offset);
+ debug_printf ("| |-> Elements = %ld\n", e_count);
+ debug_printf ("| |-> Low bound = %ld\n", new_low);
+ debug_printf ("| |-> High bound = %ld\n", new_high);
+ debug_printf ("| |-> Byte stride = %ld\n", new_stride);
+ debug_printf ("| |-> Last element = %ld\n", last_elem);
+ debug_printf ("| |-> Remainder = %ld\n", remainder);
+ debug_printf ("| '-> Contiguous = %s\n",
+ (is_dim_contiguous ? "Yes" : "No"));
+ }
+
+ /* Figure out how big (in bytes) an element of this dimension of
+ the new array slice will be. */
+ slice_element_size = std::abs (new_stride * e_count);
+
+ slice_dims.emplace_back (new_low, new_high, new_stride,
+ index_type);
+
+ /* Update the total offset. */
+ total_offset += offset;
+ }
+ else
+ {
+ /* There is a single index for this dimension. */
+ LONGEST index
+ = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride () / 8;
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type);
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Index access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd);
+ debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| '-> Accessing:\n");
+ debug_printf ("| '-> Index: %ld\n", index);
+ }
- gdb_assert (nargs > 0);
+ /* If the array has actual content then check the index is in
+ bounds. An array without content (an unbound array) doesn't
+ have a known upper bound, so don't error check in that
+ situation. */
+ if (index < lb
+ || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED
+ && index > ub)
+ || (VALUE_LVAL (array) != lval_memory
+ && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED))
+ {
+ if (type_not_associated (dim_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (dim_type))
+ error (_("no such vector element (vector not allocated)"));
+ else
+ error (_("no such vector element"));
+ }
- /* Now that we know we have a legal array subscript expression let us
- actually find out where this element exists in the array. */
+ /* Calculate using the type stride, not the target type size. */
+ LONGEST offset = sd * (index - lb);
+ total_offset += offset;
+ }
+ }
- /* Take array indices left to right. */
- for (int i = 0; i < nargs; i++)
+ if (noside == EVAL_SKIP)
+ return array;
+
+ /* Build a type that represents the new array slice in the target memory
+ of the original ARRAY, this type makes use of strides to correctly
+ find only those elements that are part of the new slice. */
+ struct type *array_slice_type = inner_element_type;
+ for (const auto &d : slice_dims)
{
- /* Evaluate each subscript; it must be a legal integer in F77. */
- value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (d.stride);
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ array_slice_type
+ = create_array_type (nullptr, array_slice_type, new_range);
+ }
- /* Fill in the subscript array. */
- subscript_array[i] = value_as_long (arg2);
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("'-> Final result:\n");
+ debug_printf (" |-> Type: %s\n",
+ type_to_string (array_slice_type).c_str ());
+ debug_printf (" |-> Total offset: %ld\n", total_offset);
+ debug_printf (" |-> Base address: %s\n",
+ core_addr_to_string (value_address (array)));
+ debug_printf (" '-> Contiguous = %s\n",
+ (is_all_contiguous ? "Yes" : "No"));
}
- /* Internal type of array is arranged right to left. */
- for (int i = nargs; i > 0; i--)
+ /* Should we repack this array slice? */
+ if (!is_all_contiguous && (repack_array_slices || is_string_p))
{
- struct type *array_type = check_typedef (value_type (array));
- LONGEST index = subscript_array[i - 1];
+ /* Build a type for the repacked slice. */
+ struct type *repacked_array_type = inner_element_type;
+ for (const auto &d : slice_dims)
+ {
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (TYPE_LENGTH (repacked_array_type));
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ repacked_array_type
+ = create_array_type (nullptr, repacked_array_type, new_range);
+ }
- array = value_subscripted_rvalue (array, index,
- f77_get_lowerbound (array_type));
+ /* Now copy the elements from the original ARRAY into the packed
+ array value DEST. */
+ struct value *dest = allocate_value (repacked_array_type);
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ {
+ fortran_array_walker<fortran_lazy_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset, dest);
+ p.walk ();
+ }
+ else
+ {
+ fortran_array_walker<fortran_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset,
+ total_offset, array, dest);
+ p.walk ();
+ }
+ array = dest;
+ }
+ else
+ {
+ if (VALUE_LVAL (array) == lval_memory)
+ {
+ /* If the value we're taking a slice from is not yet loaded, or
+ the requested slice is outside the values content range then
+ just create a new lazy value pointing at the memory where the
+ contents we're looking for exist. */
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ array = value_at_lazy (array_slice_type,
+ value_address (array) + total_offset);
+ else
+ array = value_from_contents_and_address (array_slice_type,
+ (value_contents (array)
+ + total_offset),
+ (value_address (array)
+ + total_offset));
+ }
+ else if (!value_lazy (array))
+ {
+ const void *valaddr = value_contents (array) + total_offset;
+ array = allocate_value (array_slice_type);
+ memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type));
+ }
+ else
+ error (_("cannot subscript arrays that are not in memory"));
}
return array;
@@ -1050,11 +1516,50 @@ builtin_f_type (struct gdbarch *gdbarch)
return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
}
+/* Command-list for the "set/show fortran" prefix command. */
+static struct cmd_list_element *set_fortran_list;
+static struct cmd_list_element *show_fortran_list;
+
void _initialize_f_language ();
void
_initialize_f_language ()
{
f_type_data = gdbarch_data_register_post_init (build_fortran_types);
+
+ add_basic_prefix_cmd ("fortran", no_class,
+ _("Prefix command for changing Fortran-specific settings."),
+ &set_fortran_list, "set fortran ", 0, &setlist);
+
+ add_show_prefix_cmd ("fortran", no_class,
+ _("Generic command for showing Fortran-specific settings."),
+ &show_fortran_list, "show fortran ", 0, &showlist);
+
+ add_setshow_boolean_cmd ("repack-array-slices", class_vars,
+ &repack_array_slices, _("\
+Enable or disable repacking of non-contiguous array slices."), _("\
+Show whether non-contiguous array slices are repacked."), _("\
+When the user requests a slice of a Fortran array then we can either return\n\
+a descriptor that describes the array in place (using the original array data\n\
+in its existing location) or the original data can be repacked (copied) to a\n\
+new location.\n\
+\n\
+When the content of the array slice is contiguous within the original array\n\
+then the result will never be repacked, but when the data for the new array\n\
+is non-contiguous within the original array repacking will only be performed\n\
+when this setting is on."),
+ NULL,
+ show_repack_array_slices,
+ &set_fortran_list, &show_fortran_list);
+
+ /* Debug Fortran's array slicing logic. */
+ add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance,
+ &fortran_array_slicing_debug, _("\
+Set debugging of Fortran array slicing."), _("\
+Show debugging of Fortran array slicing."), _("\
+When on, debugging of Fortran array slicing is enabled."),
+ NULL,
+ show_fortran_array_slicing_debug,
+ &setdebuglist, &showdebuglist);
}
/* See f-lang.h. */
@@ -1093,3 +1598,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type)
return value_type (arg);
return type;
}
+
+/* See f-lang.h. */
+
+CORE_ADDR
+fortran_adjust_dynamic_array_base_address_hack (struct type *type,
+ CORE_ADDR address)
+{
+ gdb_assert (type->code () == TYPE_CODE_ARRAY);
+
+ int ndimensions = calc_f77_array_dims (type);
+ LONGEST total_offset = 0;
+
+ /* Walk through each of the dimensions of this array type and figure out
+ if any of the dimensions are "backwards", that is the base address
+ for this dimension points to the element at the highest memory
+ address and the stride is negative. */
+ struct type *tmp_type = type;
+ for (int i = 0 ; i < ndimensions; ++i)
+ {
+ /* Grab the range for this dimension and extract the lower and upper
+ bounds. */
+ tmp_type = check_typedef (tmp_type);
+ struct type *range_type = tmp_type->index_type ();
+ LONGEST lowerbound, upperbound, stride;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* Figure out the stride for this dimension. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
+ stride = tmp_type->index_type ()->bounds ()->bit_stride ();
+ if (stride == 0)
+ stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ stride /= (unit_size * 8);
+ }
+
+ /* If this dimension is "backward" then figure out the offset
+ adjustment required to point to the element at the lowest memory
+ address, and add this to the total offset. */
+ LONGEST offset = 0;
+ if (stride < 0 && lowerbound < upperbound)
+ offset = (upperbound - lowerbound) * stride;
+ total_offset += offset;
+ tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ }
+
+ /* Adjust the address of this object and return it. */
+ address += total_offset;
+ return address;
+}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 4710b14aa62..dee63158ff4 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -64,7 +64,6 @@ extern void f77_get_dynamic_array_length (struct type *);
extern int calc_f77_array_dims (struct type *);
-
/* Fortran (F77) types */
struct builtin_f_type
@@ -122,4 +121,22 @@ extern struct value *fortran_argument_convert (struct value *value,
extern struct type *fortran_preserve_arg_pointer (struct value *arg,
struct type *type);
+/* Fortran arrays can have a negative stride. When this happens it is
+ often the case that the base address for an object is not the lowest
+ address occupied by that object. For example, an array slice (10:1:-1)
+ will be encoded with lower bound 1, upper bound 10, a stride of
+ -ELEMENT_SIZE, and have a base address pointer that points at the
+ element with the highest address in memory.
+
+ This really doesn't play well with our current model of value contents,
+ but could easily require a significant update in order to be supported
+ "correctly".
+
+ For now, we manually force the base address to be the lowest addressed
+ element here. Yes, this will break some things, but it fixes other
+ things. The hope is that it fixes more than it breaks. */
+
+extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
+ (struct type *type, CORE_ADDR address);
+
#endif /* F_LANG_H */
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index e7dc20d0ea5..f742057d897 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -35,6 +35,7 @@
#include "dictionary.h"
#include "cli/cli-style.h"
#include "gdbarch.h"
+#include "f-array-walker.h"
static void f77_get_dynamic_length_of_aggregate (struct type *);
@@ -100,100 +101,110 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
* TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
}
-/* Actual function which prints out F77 arrays, Valaddr == address in
- the superior. Address == the address in the inferior. */
+/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array
+ walking template. This specialisation prints Fortran arrays. */
-static void
-f77_print_array_1 (int nss, int ndimensions, struct type *type,
- const gdb_byte *valaddr,
- int embedded_offset, CORE_ADDR address,
- struct ui_file *stream, int recurse,
- const struct value *val,
- const struct value_print_options *options,
- int *elts)
+class fortran_array_printer_impl : public fortran_array_walker_base_impl
{
- struct type *range_type = check_typedef (type)->index_type ();
- CORE_ADDR addr = address + embedded_offset;
- LONGEST lowerbound, upperbound;
- LONGEST i;
-
- get_discrete_bounds (range_type, &lowerbound, &upperbound);
-
- if (nss != ndimensions)
- {
- struct gdbarch *gdbarch = get_type_arch (type);
- size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type));
- int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
- size_t byte_stride = type->bit_stride () / (unit_size * 8);
- if (byte_stride == 0)
- byte_stride = dim_size;
- size_t offs = 0;
-
- for (i = lowerbound;
- (i < upperbound + 1 && (*elts) < options->print_max);
- i++)
- {
- struct value *subarray = value_from_contents_and_address
- (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
- + offs, addr + offs);
-
- fprintf_filtered (stream, "(");
- f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
- value_contents_for_printing (subarray),
- value_embedded_offset (subarray),
- value_address (subarray),
- stream, recurse, subarray, options, elts);
- offs += byte_stride;
- fprintf_filtered (stream, ")");
-
- if (i < upperbound)
- fprintf_filtered (stream, " ");
- }
- if (*elts >= options->print_max && i < upperbound)
- fprintf_filtered (stream, "...");
- }
- else
- {
- for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
- i++, (*elts)++)
- {
- struct value *elt = value_subscript ((struct value *)val, i);
-
- common_val_print (elt, stream, recurse, options, current_language);
-
- if (i != upperbound)
- fprintf_filtered (stream, ", ");
-
- if ((*elts == options->print_max - 1)
- && (i != upperbound))
- fprintf_filtered (stream, "...");
- }
- }
-}
+public:
+ /* Constructor. TYPE is the array type being printed, ADDRESS is the
+ address in target memory for the object of TYPE being printed. VAL is
+ the GDB value (of TYPE) being printed. STREAM is where to print to,
+ RECOURSE is passed through (and prevents infinite recursion), and
+ OPTIONS are the printing control options. */
+ explicit fortran_array_printer_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *val,
+ struct ui_file *stream,
+ int recurse,
+ const struct value_print_options *options)
+ : m_elts (0),
+ m_val (val),
+ m_stream (stream),
+ m_recurse (recurse),
+ m_options (options)
+ { /* Nothing. */ }
+
+ /* Called while iterating over the array bounds. When SHOULD_CONTINUE is
+ false then we must return false, as we have reached the end of the
+ array bounds for this dimension. However, we also return false if we
+ have printed too many elements (after printing '...'). In all other
+ cases, return true. */
+ bool continue_walking (bool should_continue)
+ {
+ bool cont = should_continue && (m_elts < m_options->print_max);
+ if (!cont && should_continue)
+ fprintf_filtered (m_stream, "...");
+ return cont;
+ }
+
+ /* Called when we start iterating over a dimension. If it's not the
+ inner most dimension then print an opening '(' character. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ {
+ if (dim != ndim)
+ fprintf_filtered (m_stream, "(");
+ }
+
+ /* Called when we finish processing a batch of items within a dimension
+ of the array. Depending on whether this is the inner most dimension
+ or not we print different things, but this is all about adding
+ separators between elements, and dimensions of the array. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ {
+ if (dim != ndim)
+ {
+ fprintf_filtered (m_stream, ")");
+ if (!last_p)
+ fprintf_filtered (m_stream, " ");
+ }
+ else
+ {
+ if (!last_p)
+ fprintf_filtered (m_stream, ", ");
+ }
+ }
+
+ /* Called to process an element of ELT_TYPE at offset ELT_OFF from the
+ start of the parent object. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ /* Extract the element value from the parent value. */
+ struct value *e_val
+ = value_from_component (m_val, elt_type, elt_off);
+ common_val_print (e_val, m_stream, m_recurse, m_options, current_language);
+ ++m_elts;
+ }
+
+private:
+ /* The number of elements printed so far. */
+ int m_elts;
+
+ /* The value from which we are printing elements. */
+ struct value *m_val;
+
+ /* The stream we should print too. */
+ struct ui_file *m_stream;
+
+ /* The recursion counter, passed through when we print each element. */
+ int m_recurse;
+
+ /* The print control options. Gives us the maximum number of elements to
+ print, and is passed through to each element that we print. */
+ const struct value_print_options *m_options = nullptr;
+};
-/* This function gets called to print an F77 array, we set up some
- stuff and then immediately call f77_print_array_1(). */
+/* This function gets called to print a Fortran array. */
static void
-f77_print_array (struct type *type, const gdb_byte *valaddr,
- int embedded_offset,
- CORE_ADDR address, struct ui_file *stream,
- int recurse,
- const struct value *val,
- const struct value_print_options *options)
+fortran_print_array (struct type *type, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ const struct value *val,
+ const struct value_print_options *options)
{
- int ndimensions;
- int elts = 0;
-
- ndimensions = calc_f77_array_dims (type);
-
- if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
- error (_("\
-Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
- ndimensions, MAX_FORTRAN_DIMS);
-
- f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
- address, stream, recurse, val, options, &elts);
+ fortran_array_walker<fortran_array_printer_impl> p
+ (type, address, (struct value *) val, stream, recurse, options);
+ p.walk ();
}
\f
@@ -238,8 +249,7 @@ f_value_print_inner (struct value *val, struct ui_file *stream, int recurse,
if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR)
{
fprintf_filtered (stream, "(");
- f77_print_array (type, valaddr, 0,
- address, stream, recurse, val, options);
+ fortran_print_array (type, address, stream, recurse, val, options);
fprintf_filtered (stream, ")");
}
else
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 63f0d7c8489..5d2f90cfb51 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -39,6 +39,7 @@
#include "dwarf2/loc.h"
#include "gdbcore.h"
#include "floatformat.h"
+#include "f-lang.h"
#include <algorithm>
/* Initialize BADNESS constants. */
@@ -2621,7 +2622,16 @@ resolve_dynamic_type_internal (struct type *type,
prop = TYPE_DATA_LOCATION (resolved_type);
if (prop != NULL
&& dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
- prop->set_const_val (value);
+ {
+ /* Start of Fortran hack. See comment in f-lang.h for what is going
+ on here.*/
+ if (current_language->la_language == language_fortran
+ && resolved_type->code () == TYPE_CODE_ARRAY)
+ value = fortran_adjust_dynamic_array_base_address_hack (resolved_type,
+ value);
+ /* End of Fortran hack. */
+ prop->set_const_val (value);
+ }
return resolved_type;
}
diff --git a/gdb/parse.c b/gdb/parse.c
index 6661fba81d7..e5bc62e0d46 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -924,6 +924,8 @@ operator_length_standard (const struct expression *expr, int endpos,
/* Assume the range has 2 arguments (low bound and high bound), then
reduce the argument count if any bounds are set to default. */
args = 2;
+ if (range_type & RANGE_HAS_STRIDE)
+ ++args;
if (range_type & RANGE_LOW_BOUND_DEFAULT)
--args;
if (range_type & RANGE_HIGH_BOUND_DEFAULT)
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
new file mode 100644
index 00000000000..2583cdecc94
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
@@ -0,0 +1,69 @@
+# Copyright 2020 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/> .
+
+# Test invalid element and slice array accesses.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "First Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Second Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+gdb_continue_to_breakpoint "First Breakpoint"
+
+# Access not yet allocated array.
+gdb_test "print other" " = <not allocated>"
+gdb_test "print other(0:4,2:3)" "array not allocated"
+gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)"
+
+# Access not yet associated pointer.
+gdb_test "print pointer2d" " = <not associated>"
+gdb_test "print pointer2d(1:2,1:2)" "array not associated"
+gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)"
+
+gdb_continue_to_breakpoint "Second Breakpoint"
+
+# Accessing just outside the arrays.
+foreach name {array pointer2d other} {
+ gdb_test "print $name (0:,:)" "array subscript out of bounds"
+ gdb_test "print $name (:11,:)" "array subscript out of bounds"
+ gdb_test "print $name (:,0:)" "array subscript out of bounds"
+ gdb_test "print $name (:,:11)" "array subscript out of bounds"
+
+ gdb_test "print $name (0,:)" "no such vector element"
+ gdb_test "print $name (11,:)" "no such vector element"
+ gdb_test "print $name (:,0)" "no such vector element"
+ gdb_test "print $name (:,11)" "no such vector element"
+}
+
+# Stride in the wrong direction.
+gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination"
+gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
new file mode 100644
index 00000000000..0f3d45ab8cd
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
@@ -0,0 +1,42 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Declare variables used in this test.
+ integer, dimension (1:10,1:10) :: array
+ integer, allocatable :: other (:, :)
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(1:10,1:10), target :: tarray
+
+ print *, "" ! First Breakpoint.
+
+ ! Allocate or associate any variables as needed.
+ allocate (other (1:10, 1:10))
+ pointer2d => tarray
+ array = 0
+
+ print *, "" ! Second Breakpoint.
+
+ ! All done. Deallocate.
+ deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
new file mode 100644
index 00000000000..05b4802c678
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
@@ -0,0 +1,111 @@
+# Copyright 2020 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/> .
+
+# Create a slice of an array, then take a slice of that slice.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Stop Here"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We're going to print some reasonably large arrays.
+gdb_test_no_output "set print elements unlimited"
+
+gdb_continue_to_breakpoint "Stop Here"
+
+# Print a slice, capture the convenience variable name created.
+set cmd "print array (1:10:2, 1:10:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ }
+}
+
+# Now check that we can correctly extract all the elements from this
+# slice.
+for { set j 1 } { $j < 6 } { incr j } {
+ for { set i 1 } { $i < 6 } { incr i } {
+ set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1]
+ gdb_test "print ${varname} ($i,$j)" " = $val"
+ }
+}
+
+# Now take a slice of the slice.
+gdb_test "print ${varname} (3:5, 3:5)" \
+ " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)"
+
+# Now take a different slice of a slice.
+set cmd "print ${varname} (1:5:2, 1:5:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Now take a slice from the slice, of a slice!
+set cmd "print ${varname} (1:3:2, 1:3:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# And again!
+set cmd "print ${varname} (1:2:2, 1:2:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Test taking a slice with stride of a string. This isn't actually
+# supported within gfortran (at least), but naturally drops out of how
+# GDB models arrays and strings in a similar way, so we may as well
+# test that this is still working.
+gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'"
+gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'"
+gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'"
+
+# Now test the memory requirements of taking a slice from an array.
+# The idea is that we shouldn't require more memory to extract a slice
+# than the size of the slice.
+#
+# This will only work if array repacking is turned on, otherwise GDB
+# will create the slice by generating a new type that sits over the
+# existing value in memory.
+gdb_test_no_output "set fortran repack-array-slices on"
+set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"]
+set slice_size [expr $element_size * 4]
+gdb_test_no_output "set max-value-size $slice_size"
+gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)"
+gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)"
+gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
new file mode 100644
index 00000000000..c3530f567d4
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
@@ -0,0 +1,96 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+ integer, dimension (1:10,1:11) :: array
+ character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz"
+
+ call fill_array_2d (array)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Stop Here
+
+ print *, array
+ print *, str
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index 31f95a3668d..ff00fae886f 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -18,6 +18,21 @@
# the subroutine. This should exercise GDB's ability to handle
# different strides for the different dimensions.
+# Testing GDB's ability to print array (and string) slices, including
+# slices that make use of array strides.
+#
+# In the Fortran code various arrays of different ranks are filled
+# with data, and slices are passed to a series of show functions.
+#
+# In this test script we break in each of the show functions, print
+# the array slice that was passed in, and then move up the stack to
+# the parent frame and check GDB can manually extract the same slice.
+#
+# This test also checks that the size of the array slice passed to the
+# function (so as extracted and described by the compiler and the
+# debug information) matches the size of the slice manually extracted
+# by GDB.
+
if {[skip_fortran_tests]} { return -1 }
standard_testfile ".f90"
@@ -28,44 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
return -1
}
-if ![fortran_runto_main] {
- untested "could not run to main"
- return -1
+# Takes the name of an array slice as used in the test source, and extracts
+# the base array name. For example: 'array (1,2)' becomes 'array'.
+proc array_slice_to_var { slice_str } {
+ regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname
+ return $varname
}
-gdb_breakpoint "show"
-gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
-
-set array_contents \
- [list \
- " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
- " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
- " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
- " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
- " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
- " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
-
-set message_strings \
- [list \
- " = 'array'" \
- " = 'array \\(1:5,1:5\\)'" \
- " = 'array \\(1:10:2,1:10:2\\)'" \
- " = 'array \\(1:10:3,1:10:2\\)'" \
- " = 'array \\(1:10:5,1:10:3\\)'" \
- " = 'other'" \
- " = 'other \\(-5:0, -2:0\\)'" \
- " = 'other \\(-5:4:2, -2:7:3\\)'" ]
-
-set i 0
-foreach result $array_contents msg $message_strings {
- incr i
- with_test_prefix "test $i" {
- gdb_continue_to_breakpoint "show"
- gdb_test "p array" $result
- gdb_test "p message" "$msg"
+proc run_test { repack } {
+ global binfile gdb_prompt
+
+ clean_restart ${binfile}
+
+ if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
}
+
+ gdb_test_no_output "set fortran repack-array-slices $repack"
+
+ # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+ gdb_breakpoint [gdb_get_line_number "Display Element"]
+ gdb_breakpoint [gdb_get_line_number "Display String"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"]
+ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+ # We're going to print some reasonably large arrays.
+ gdb_test_no_output "set print elements unlimited"
+
+ set found_final_breakpoint false
+
+ # We place a limit on the number of tests that can be run, just in
+ # case something goes wrong, and GDB gets stuck in an loop here.
+ set test_count 0
+ while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ set found_final_breakpoint false
+ set expected_result ""
+ set func_name ""
+ gdb_test_multiple "continue" "continue" {
+ -re ".*GDB = (\[^\r\n\]+)\r\n" {
+ set expected_result $expect_out(1,string)
+ exp_continue
+ }
+ -re "! Display Element" {
+ set func_name "show_elem"
+ exp_continue
+ }
+ -re "! Display String" {
+ set func_name "show_str"
+ exp_continue
+ }
+ -re "! Display Array Slice (.)D" {
+ set func_name "show_$expect_out(1,string)d"
+ exp_continue
+ }
+ -re "! Final Breakpoint" {
+ set found_final_breakpoint true
+ exp_continue
+ }
+ -re "$gdb_prompt $" {
+ # We're done.
+ }
+ }
+
+ if ($found_final_breakpoint) {
+ break
+ }
+
+ # We want to take a look at the line in the previous frame that
+ # called the current function. I couldn't find a better way of
+ # doing this than 'up', which will print the line, then 'down'
+ # again.
+ #
+ # I don't want to fill the log with passes for these up/down
+ # commands, so we don't report any. If something goes wrong then we
+ # should get a fail from gdb_test_multiple.
+ set array_slice_name ""
+ set unique_id ""
+ array unset replacement_vars
+ array set replacement_vars {}
+ gdb_test_multiple "up" "up" {
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ }
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ set unique_id $expect_out(2,string)
+ }
+ }
+ if {$unique_id != ""} {
+ set str ""
+ foreach v [split $unique_id ,] {
+ set val [get_integer_valueof "${v}" "??"\
+ "get variable '$v' for '$array_slice_name'"]
+ set replacement_vars($v) $val
+ if {$str != ""} {
+ set str "Str,"
+ }
+ set str "$str$v=$val"
+ }
+ set unique_id " $str"
+ }
+ gdb_test_multiple "down" "down" {
+ -re "\r\n$gdb_prompt $" {
+ # Don't issue a pass here.
+ }
+ }
+
+ # Check we have all the information we need to successfully run one
+ # of these tests.
+ if { $expected_result == "" } {
+ perror "failed to extract expected results"
+ return 0
+ }
+ if { $array_slice_name == "" } {
+ perror "failed to extract array slice name"
+ return 0
+ }
+
+ # Check GDB can correctly print the array slice that was passed into
+ # the current frame.
+ set pattern [string_to_regexp " = $expected_result"]
+ gdb_test "p array" "$pattern" \
+ "check value of '$array_slice_name'$unique_id"
+
+ # Get the size of the slice.
+ set size_in_show \
+ [get_integer_valueof "sizeof (array)" "show_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in show"]
+ set addr_in_show \
+ [get_hexadecimal_valueof "&array" "show_unknown" \
+ "get address '$array_slice_name'$unique_id in show"]
+
+ # Now move into the previous frame, and see if GDB can extract the
+ # array slice from the original parent object. Again, use of
+ # gdb_test_multiple to avoid filling the logs with unnecessary
+ # passes.
+ gdb_test_multiple "up" "up" {
+ -re "\r\n$gdb_prompt $" {
+ # Do nothing.
+ }
+ }
+
+ # Print the array slice, this will force GDB to manually extract the
+ # slice from the parent array.
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted"
+
+ # Get the size of the slice in the calling frame.
+ set size_in_parent \
+ [get_integer_valueof "sizeof ($array_slice_name)" \
+ "parent_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in parent"]
+
+ # Figure out the start and end addresses of the full array in the
+ # parent frame.
+ set full_var_name [array_slice_to_var $array_slice_name]
+ set start_addr [get_hexadecimal_valueof "&${full_var_name}" \
+ "start unknown"]
+ set end_addr [get_hexadecimal_valueof \
+ "(&${full_var_name}) + sizeof (${full_var_name})" \
+ "end unknown"]
+
+ # The Fortran compiler can choose to either send a descriptor that
+ # describes the array slice to the subroutine, or it can repack the
+ # slice into an array section and send that.
+ #
+ # We find the address range of the original array in the parent,
+ # and the address of the slice in the show function, if the
+ # address of the slice (from show) is in the range of the original
+ # array then repacking has not occurred, otherwise, the slice is
+ # outside of the parent, and repacking must have occurred.
+ #
+ # The goal here is to compare the sizes of the slice in show with
+ # the size of the slice extracted by GDB. So we can only compare
+ # sizes when GDB's repacking setting matches the repacking
+ # behaviour we got from the compiler.
+ if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \
+ == ($repack == "on") } {
+ gdb_assert {$size_in_show == $size_in_parent} \
+ "check sizes match"
+ } elseif { $repack == "off" } {
+ # GDB's repacking is off (so slices are left unpacked), but
+ # the compiler did pack this one. As a result we can't
+ # compare the sizes between the compiler's slice and GDB's
+ # slice.
+ verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared"
+ } else {
+ # Like the above, but the reverse, GDB's repacking is on, but
+ # the compiler didn't repack this slice.
+ verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared"
+ }
+
+ # If the array name we just tested included variable names, then
+ # test again with all the variables expanded.
+ if {$unique_id != ""} {
+ foreach v [array names replacement_vars] {
+ set val $replacement_vars($v)
+ set array_slice_name \
+ [regsub "\\y${v}\\y" $array_slice_name $val]
+ }
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded"
+ }
+ }
+ }
+
+ # Ensure we reached the final breakpoint. If more tests have been added
+ # to the test script, and this starts failing, then the safety 'while'
+ # loop above might need to be increased.
+ gdb_assert {$found_final_breakpoint} "ran all tests"
}
-gdb_continue_to_breakpoint "continue to Final Breakpoint"
+foreach_with_prefix repack { on off } {
+ run_test $repack
+}
diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
index a66fa6ba784..6d75a385699 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.f90
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -13,58 +13,368 @@
! 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 show (message, array)
- character (len=*) :: message
+subroutine show_elem (array)
+ integer :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = "
+ write(*, fmt="(I0)", advance="no") array
+ write(*, fmt="(A)", advance="yes") ""
+
+ print *, "" ! Display Element
+end subroutine show_elem
+
+subroutine show_str (array)
+ character (len=*) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+ write (*, fmt="(A)", advance="no") "GDB = '"
+ write (*, fmt="(A)", advance="no") array
+ write (*, fmt="(A)", advance="yes") "'"
+
+ print *, "" ! Display String
+end subroutine show_str
+
+subroutine show_1d (array)
+ integer, dimension (:) :: array
+
+ print *, "Array Contents:"
+ print *, ""
+
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ write(*, fmt="(i4)", advance="no") array (i)
+ end do
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (i > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+
+ print *, "" ! Display Array Slice 1D
+end subroutine show_1d
+
+subroutine show_2d (array)
integer, dimension (:,:) :: array
- print *, message
+ print *, "Array Contents:"
+ print *, ""
+
do i=LBOUND (array, 2), UBOUND (array, 2), 1
do j=LBOUND (array, 1), UBOUND (array, 1), 1
write(*, fmt="(i4)", advance="no") array (j, i)
end do
print *, ""
- end do
- print *, array
- print *, ""
+ end do
-end subroutine show
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
-program test
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (i > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (j > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 2D
+end subroutine show_2d
+
+subroutine show_3d (array)
+ integer, dimension (:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (i > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (j > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (k > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 3D
+end subroutine show_3d
+
+subroutine show_4d (array)
+ integer, dimension (:,:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ if (i > LBOUND (array, 4)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (j > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (k > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (l > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (l, k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 4D
+end subroutine show_4d
+!
+! Start of test program.
+!
+program test
interface
- subroutine show (message, array)
- character (len=*) :: message
+ subroutine show_str (array)
+ character (len=*) :: array
+ end subroutine show_str
+
+ subroutine show_1d (array)
+ integer, dimension (:) :: array
+ end subroutine show_1d
+
+ subroutine show_2d (array)
integer, dimension(:,:) :: array
- end subroutine show
+ end subroutine show_2d
+
+ subroutine show_3d (array)
+ integer, dimension(:,:,:) :: array
+ end subroutine show_3d
+
+ subroutine show_4d (array)
+ integer, dimension(:,:,:,:) :: array
+ end subroutine show_4d
end interface
+ ! Declare variables used in this test.
+ integer, dimension (-10:-1,-10:-2) :: neg_array
integer, dimension (1:10,1:10) :: array
integer, allocatable :: other (:, :)
+ character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz"
+ integer, dimension (-2:2,-2:2,-2:2) :: array3d
+ integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d
+ integer, dimension (10:20) :: array1d
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(-1:9,-1:9), target :: tarray
+ ! Allocate or associate any variables as needed.
allocate (other (-5:4, -2:7))
+ pointer2d => tarray
- do i=LBOUND (array, 2), UBOUND (array, 2), 1
- do j=LBOUND (array, 1), UBOUND (array, 1), 1
- array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
- end do
- end do
+ ! Fill arrays with contents ready for testing.
+ call fill_array_1d (array1d)
+
+ call fill_array_2d (neg_array)
+ call fill_array_2d (array)
+ call fill_array_2d (other)
+ call fill_array_2d (tarray)
+
+ call fill_array_3d (array3d)
+ call fill_array_4d (array4d)
+
+ ! The tests. Each call to a show_* function must have a unique set
+ ! of arguments as GDB uses the arguments are part of the test name
+ ! string, so duplicate arguments will result in duplicate test
+ ! names.
+ !
+ ! If a show_* line ends with VARS=... where '...' is a comma
+ ! separated list of variable names, these variables are assumed to
+ ! be part of the call line, and will be expanded by the test script,
+ ! for example:
+ !
+ ! do x=1,9,1
+ ! do y=x,10,1
+ ! call show_1d (some_array (x,y)) ! VARS=x,y
+ ! end do
+ ! end do
+ !
+ ! In this example the test script will automatically expand 'x' and
+ ! 'y' in order to better test different aspects of GDB. Do take
+ ! care, the expansion is not very "smart", so try to avoid clashing
+ ! with other text on the line, in the example above, avoid variables
+ ! named 'some' or 'array', as these will likely clash with
+ ! 'some_array'.
+ call show_str (str_1)
+ call show_str (str_1 (1:20))
+ call show_str (str_1 (10:20))
- do i=LBOUND (other, 2), UBOUND (other, 2), 1
- do j=LBOUND (other, 1), UBOUND (other, 1), 1
- other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
+ call show_elem (array1d (11))
+ call show_elem (pointer2d (2,3))
+
+ call show_1d (array1d)
+ call show_1d (array1d (13:17))
+ call show_1d (array1d (17:13:-1))
+ call show_1d (array (1:5,1))
+ call show_1d (array4d (1,7,3,:))
+ call show_1d (pointer2d (-1:3, 2))
+ call show_1d (pointer2d (-1, 2:4))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_1d ((array (1:5,1)))
+
+ call show_2d (pointer2d)
+ call show_2d (array)
+ call show_2d (array (1:5,1:5))
+ do i=1,10,2
+ do j=1,10,3
+ call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j
+ call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j
end do
end do
+ call show_2d (array (6:2:-1,3:9))
+ call show_2d (array (1:10:2, 1:10:2))
+ call show_2d (other)
+ call show_2d (other (-5:0, -2:0))
+ call show_2d (other (-5:4:2, -2:7:3))
+ call show_2d (neg_array)
+ call show_2d (neg_array (-10:-3,-8:-4:2))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_2d ((array (1:10:3, 1:10:2)))
+ call show_2d ((neg_array (-10:-3,-8:-4:2)))
- call show ("array", array)
- call show ("array (1:5,1:5)", array (1:5,1:5))
- call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
- call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
- call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
+ call show_3d (array3d)
+ call show_3d (array3d(-1:1,-1:1,-1:1))
+ call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1))
- call show ("other", other)
- call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
- call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1)))
+ call show_4d (array4d)
+ call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1))
+ call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1)))
+
+ ! All done. Deallocate.
deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
end program test
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
index 04296ac80c9..0ab74fbbe90 100644
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -44,7 +44,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
gdb_test "print sizeof(vla1(3,2,1))" "4" \
"print sizeof element from allocated vla1"
-gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
+gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
"print sizeof sliced vla1"
# Try to access values in undefined pointer to VLA (dangling)
@@ -61,7 +61,7 @@ gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
gdb_test "print sizeof(pvla(3,2,1))" "4" \
"print sizeof element from associated pvla"
-gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
+gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv3 2/2] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-09-19 9:48 ` [PATCHv3 2/2] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
@ 2020-09-19 10:03 ` Eli Zaretskii
0 siblings, 0 replies; 62+ messages in thread
From: Eli Zaretskii @ 2020-09-19 10:03 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
> From: Andrew Burgess <andrew.burgess@embecosm.com>
> Date: Sat, 19 Sep 2020 10:48:01 +0100
>
> gdb/ChangeLog:
>
> * Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
> * NEWS: Mention new options.
> * expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE.
> * expression.h (enum range_type): Add RANGE_HAS_STRIDE.
> * f-array-walker.h: New file.
> * f-exp.y (arglist): Allow for a series of subranges.
> (subrange): Add cases for subranges with strides.
> * f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
> (repack_array_slices): New static global.
> (show_repack_array_slices): New function.
> (fortran_array_slicing_debug): New static global.
> (show_fortran_array_slicing_debug): New function.
> (value_f90_subarray): Delete.
> (skip_undetermined_arglist): Delete.
> (class fortran_array_repacker_base_impl): New class.
> (class fortran_lazy_array_repacker_impl): New class.
> (class fortran_array_repacker_impl): New class.
> (fortran_value_subarray): Complete rewrite.
> (set_fortran_list): New static global.
> (show_fortran_list): Likewise.
> (_initialize_f_language): Register new commands.
> (fortran_adjust_dynamic_array_base_address_hack): New function.
> * f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
> Declare.
> * f-valprint.c: Include 'f-array-walker.h'.
> (class fortran_array_printer_impl): New class.
> (f77_print_array_1): Delete.
> (f77_print_array): Delete.
> (fortran_print_array): New.
> (f_value_print_inner): Update to call fortran_print_array.
> * gdbtypes.c: Include 'f-lang.h'.
> (resolve_dynamic_type_internal): Call
> fortran_adjust_dynamic_array_base_address_hack.
> * parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE.
>
> gdb/testsuite/ChangeLog:
>
> * gdb.fortran/array-slices-bad.exp: New file.
> * gdb.fortran/array-slices-bad.f90: New file.
> * gdb.fortran/array-slices-sub-slices.exp: New file.
> * gdb.fortran/array-slices-sub-slices.f90: New file.
> * gdb.fortran/array-slices.exp: Rewrite tests.
> * gdb.fortran/array-slices.f90: Rewrite tests.
> * gdb.fortran/vla-sizeof.exp: Correct expected results.
>
> gdb/doc/ChangeLog:
>
> * gdb.texinfo (Debugging Output): Document 'set/show debug
> fotran-array-slicing'.
> (Special Fortran Commands): Document 'set/show fortran
> repack-array-slices'.
Thanks, the documentation parts are approved, but please add the
missing commas in sentences like this one:
> +When taking a slice from an array a Fortran compiler can choose to
^
There.
> +When this setting is on then @value{GDBN} will also repack array
^
And there.
(There are a few more sentences like these two, where a comma is
missing after a "When SOMETHING" construct.)
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv3 1/2] gdb: Convert enum range_type to a bit field enum
2020-09-19 9:48 ` [PATCHv3 1/2] gdb: Convert enum range_type to a bit field enum Andrew Burgess
@ 2020-09-19 13:50 ` Simon Marchi
0 siblings, 0 replies; 62+ messages in thread
From: Simon Marchi @ 2020-09-19 13:50 UTC (permalink / raw)
To: Andrew Burgess, gdb-patches
On 2020-09-19 5:48 a.m., Andrew Burgess wrote:
> The expression range_type enum represents the following ideas:
>
> - Lower bound is set to default,
> - Upper bound is set to default,
> - Upper bound is exclusive.
>
> There are currently 6 entries in the enum to represent the combination
> of all those ideas.
>
> In a future commit I'd like to add stride information to the range,
> this could in theory appear with any of the existing enum entries, so
> this would take us to 12 enum entries.
>
> This feels like its getting a little out of hand, so in this commit I
> switch the range_type enum over to being a flags style enum. There's
> one entry to represent no flags being set, then 3 flags to represent
> the 3 ideas above. Adding stride information will require adding only
> one more enum flag.
>
> I've then gone through and updated the code to handle this change.
>
> There should be no user visible changes after this commit.
I think it's a good idea. I noted a few comments below.
> diff --git a/gdb/expression.h b/gdb/expression.h
> index 5af10f05db1..9dc598984e0 100644
> --- a/gdb/expression.h
> +++ b/gdb/expression.h
> @@ -187,20 +187,20 @@ extern void dump_prefix_expression (struct expression *, struct ui_file *);
>
> enum range_type
> {
> - /* Neither the low nor the high bound was given -- so this refers to
> - the entire available range. */
> - BOTH_BOUND_DEFAULT,
> + /* This is a standard range. Both the lower and upper bounds are
> + defined, and the bounds are inclusive. */
> + RANGE_STANDARD = 0,
> +
> /* The low bound was not given and the high bound is inclusive. */
> - LOW_BOUND_DEFAULT,
> + RANGE_LOW_BOUND_DEFAULT = 1 << 0,
> +
> /* The high bound was not given and the low bound in inclusive. */
> - HIGH_BOUND_DEFAULT,
> - /* Both bounds were given and both are inclusive. */
> - NONE_BOUND_DEFAULT,
> - /* The low bound was not given and the high bound is exclusive. */
> - NONE_BOUND_DEFAULT_EXCLUSIVE,
> - /* Both bounds were given. The low bound is inclusive and the high
> - bound is exclusive. */
> - LOW_BOUND_DEFAULT_EXCLUSIVE,
> + RANGE_HIGH_BOUND_DEFAULT = 1 << 1,
I don't think the comments on RANGE_LOW_BOUND_DEFAULT and
RANGE_HIGH_BOUND_DEFAULT should mention that the other bound is
inclusive anymore, since that's controlled by another flag.
> +DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
I think the type name is confusing. I thought at first it was related
to a TYPE_CODE_RANGE `struct type`. What about renaming to "enum
range_flag" and the enum flags type to "range_flags"?
> diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
> index db888098c4a..5111de9cf9c 100644
> --- a/gdb/rust-exp.y
> +++ b/gdb/rust-exp.y
> @@ -2492,24 +2492,29 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
>
> case OP_RANGE:
> {
> - enum range_type kind = BOTH_BOUND_DEFAULT;
> + enum range_type kind = (RANGE_HIGH_BOUND_DEFAULT
> + | RANGE_LOW_BOUND_DEFAULT);
>
> if (operation->left.op != NULL)
> {
> convert_ast_to_expression (operation->left.op, top);
> - kind = HIGH_BOUND_DEFAULT;
> + kind = RANGE_HIGH_BOUND_DEFAULT;
What I understand from this code is: if the low bound (left) is provided
to the range operator, we want to clear the RANGE_LOW_BOUND_DEFAULT bit.
So I think it would be more natural to write in the typical form to
clear bits:
kind &= ~RANGE_LOW_BOUND_DEFAULT;
I think it expresses the intent better.
You'll need to make the enum type explicitly unsigned to be able to use
the ~ operator.
Simon
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv4 0/3] Fortran Array Slicing and Striding Support
2020-09-19 9:47 ` [PATCHv3 0/2] Fortran Array Slicing and Striding Support Andrew Burgess
2020-09-19 9:48 ` [PATCHv3 1/2] gdb: Convert enum range_type to a bit field enum Andrew Burgess
2020-09-19 9:48 ` [PATCHv3 2/2] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
@ 2020-09-28 9:40 ` Andrew Burgess
2020-09-28 9:40 ` [PATCHv4 1/3] gdb: Convert enum range_type to a bit field enum Andrew Burgess
` (3 more replies)
2 siblings, 4 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-09-28 9:40 UTC (permalink / raw)
To: gdb-patches
Changes since v3:
- Addressed Simon's feedback for patch #1.
- Added new patch #2 to address the enum rename suggestion from
Simon.
- Addressed Eli's feedback for what was patch #2, but is now patch
#3.
- Other than adapting to the enum rename in patch #2, the code
content of patch #3 is unchanged from v3.
I'm still super keen to get some more eyes on the changes in patch #3,
if nothing else then the changes in gdbtypes.c could really benefit
from a review.
All feedback welcome,
Thanks,
Andrew
Andrew Burgess (3):
gdb: Convert enum range_type to a bit field enum
gdb: rename 'enum range_type' to 'enum range_flag'
gdb/fortran: Add support for Fortran array slices at the GDB prompt
gdb/ChangeLog | 72 ++
gdb/Makefile.in | 1 +
gdb/NEWS | 13 +
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 30 +
gdb/expprint.c | 61 +-
gdb/expression.h | 33 +-
gdb/f-array-walker.h | 255 +++++++
gdb/f-exp.y | 52 +-
gdb/f-lang.c | 704 ++++++++++++++++--
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 190 ++---
gdb/gdbtypes.c | 12 +-
gdb/parse.c | 28 +-
gdb/rust-exp.y | 21 +-
gdb/rust-lang.c | 29 +-
gdb/testsuite/ChangeLog | 10 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 ++
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 267 ++++++-
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
24 files changed, 2160 insertions(+), 330 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv4 1/3] gdb: Convert enum range_type to a bit field enum
2020-09-28 9:40 ` [PATCHv4 0/3] Fortran Array Slicing and Striding Support Andrew Burgess
@ 2020-09-28 9:40 ` Andrew Burgess
2020-09-28 9:40 ` [PATCHv4 2/3] gdb: rename 'enum range_type' to 'enum range_flag' Andrew Burgess
` (2 subsequent siblings)
3 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-09-28 9:40 UTC (permalink / raw)
To: gdb-patches
The expression range_type enum represents the following ideas:
- Lower bound is set to default,
- Upper bound is set to default,
- Upper bound is exclusive.
There are currently 6 entries in the enum to represent the combination
of all those ideas.
In a future commit I'd like to add stride information to the range,
this could in theory appear with any of the existing enum entries, so
this would take us to 12 enum entries.
This feels like its getting a little out of hand, so in this commit I
switch the range_type enum over to being a flags style enum. There's
one entry to represent no flags being set, then 3 flags to represent
the 3 ideas above. Adding stride information will require adding only
one more enum flag.
I've then gone through and updated the code to handle this change.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* expprint.c (print_subexp_standard): Update to reflect changes to
enum range_type.
(dump_subexp_body_standard): Likewise.
* expression.h (enum range_type): Convert to a bit field enum, and
make the enum unsigned.
* f-exp.y (subrange): Update to reflect changes to enum
range_type.
* f-lang.c (value_f90_subarray): Likewise.
* parse.c (operator_length_standard): Likewise.
* rust-exp.y (rust_parser::convert_ast_to_expression): Likewise.
* rust-lang.c (rust_range): Likewise.
(rust_compute_range): Likewise.
(rust_subscript): Likewise.
---
gdb/ChangeLog | 16 ++++++++++++++++
gdb/expprint.c | 49 ++++++++++++++----------------------------------
gdb/expression.h | 30 ++++++++++++++---------------
gdb/f-exp.y | 14 +++++++++-----
gdb/f-lang.c | 4 ++--
gdb/parse.c | 22 +++++++---------------
gdb/rust-exp.y | 21 +++++++++++++--------
gdb/rust-lang.c | 25 +++++++++++-------------
8 files changed, 87 insertions(+), 94 deletions(-)
diff --git a/gdb/expprint.c b/gdb/expprint.c
index d7d7c871bdd..bdb69a92f75 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -585,17 +585,13 @@ print_subexp_standard (struct expression *exp, int *pos,
longest_to_int (exp->elts[pc + 1].longconst);
*pos += 2;
- if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE
- || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)
+ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
fputs_filtered ("EXCLUSIVE_", stream);
fputs_filtered ("RANGE(", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
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 & RANGE_HIGH_BOUND_DEFAULT))
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
@@ -1116,36 +1112,19 @@ dump_subexp_body_standard (struct expression *exp,
longest_to_int (exp->elts[elt].longconst);
elt += 2;
- switch (range_type)
- {
- case BOTH_BOUND_DEFAULT:
- fputs_filtered ("Range '..'", stream);
- break;
- case LOW_BOUND_DEFAULT:
- fputs_filtered ("Range '..EXP'", stream);
- break;
- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- fputs_filtered ("ExclusiveRange '..EXP'", stream);
- break;
- case HIGH_BOUND_DEFAULT:
- fputs_filtered ("Range 'EXP..'", stream);
- break;
- case NONE_BOUND_DEFAULT:
- fputs_filtered ("Range 'EXP..EXP'", stream);
- break;
- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
- break;
- default:
- fputs_filtered ("Invalid Range!", stream);
- break;
- }
+ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
+ fputs_filtered ("Exclusive", stream);
+ fputs_filtered ("Range '", stream);
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ fputs_filtered ("EXP", stream);
+ fputs_filtered ("..", stream);
+ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ fputs_filtered ("EXP", stream);
+ fputs_filtered ("'", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
- if (range_type == LOW_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 5af10f05db1..6bd3fc0c3c5 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -185,22 +185,22 @@ extern void dump_prefix_expression (struct expression *, struct ui_file *);
or inclusive. So we have six sorts of subrange. This enumeration
type is to identify this. */
-enum range_type
+enum range_type : unsigned
{
- /* Neither the low nor the high bound was given -- so this refers to
- the entire available range. */
- BOTH_BOUND_DEFAULT,
- /* The low bound was not given and the high bound is inclusive. */
- LOW_BOUND_DEFAULT,
- /* The high bound was not given and the low bound in inclusive. */
- HIGH_BOUND_DEFAULT,
- /* Both bounds were given and both are inclusive. */
- NONE_BOUND_DEFAULT,
- /* The low bound was not given and the high bound is exclusive. */
- NONE_BOUND_DEFAULT_EXCLUSIVE,
- /* Both bounds were given. The low bound is inclusive and the high
- bound is exclusive. */
- LOW_BOUND_DEFAULT_EXCLUSIVE,
+ /* This is a standard range. Both the lower and upper bounds are
+ defined, and the bounds are inclusive. */
+ RANGE_STANDARD = 0,
+
+ /* The low bound was not given. */
+ RANGE_LOW_BOUND_DEFAULT = 1 << 0,
+
+ /* The high bound was not given. */
+ RANGE_HIGH_BOUND_DEFAULT = 1 << 1,
+
+ /* The high bound of this range is exclusive. */
+ RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
};
+DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
+
#endif /* !defined (EXPRESSION_H) */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 0ccb3c68d3e..a3314082d90 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -287,26 +287,30 @@ 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, RANGE_STANDARD);
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,
+ RANGE_HIGH_BOUND_DEFAULT);
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,
+ RANGE_LOW_BOUND_DEFAULT);
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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HIGH_BOUND_DEFAULT));
write_exp_elt_opcode (pstate, OP_RANGE); }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index e13097baee4..fcab973f874 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -131,12 +131,12 @@ value_f90_subarray (struct value *array,
*pos += 3;
- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ if (range_type & RANGE_LOW_BOUND_DEFAULT)
low_bound = range->bounds ()->low.const_val ();
else
low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ if (range_type & RANGE_HIGH_BOUND_DEFAULT)
high_bound = range->bounds ()->high.const_val ();
else
high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
diff --git a/gdb/parse.c b/gdb/parse.c
index 6b9541bfdc2..6661fba81d7 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -921,21 +921,13 @@ operator_length_standard (const struct expression *expr, int endpos,
range_type = (enum range_type)
longest_to_int (expr->elts[endpos - 2].longconst);
- switch (range_type)
- {
- case LOW_BOUND_DEFAULT:
- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- case HIGH_BOUND_DEFAULT:
- args = 1;
- break;
- case BOTH_BOUND_DEFAULT:
- args = 0;
- break;
- case NONE_BOUND_DEFAULT:
- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- args = 2;
- break;
- }
+ /* Assume the range has 2 arguments (low bound and high bound), then
+ reduce the argument count if any bounds are set to default. */
+ args = 2;
+ if (range_type & RANGE_LOW_BOUND_DEFAULT)
+ --args;
+ if (range_type & RANGE_HIGH_BOUND_DEFAULT)
+ --args;
break;
diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
index db888098c4a..ea9fbdc25fb 100644
--- a/gdb/rust-exp.y
+++ b/gdb/rust-exp.y
@@ -2492,24 +2492,29 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
case OP_RANGE:
{
- enum range_type kind = BOTH_BOUND_DEFAULT;
+ enum range_type kind = (RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_LOW_BOUND_DEFAULT);
if (operation->left.op != NULL)
{
convert_ast_to_expression (operation->left.op, top);
- kind = HIGH_BOUND_DEFAULT;
+ kind &= ~RANGE_LOW_BOUND_DEFAULT;
}
if (operation->right.op != NULL)
{
convert_ast_to_expression (operation->right.op, top);
- if (kind == BOTH_BOUND_DEFAULT)
- kind = (operation->inclusive
- ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE);
+ if (kind == (RANGE_HIGH_BOUND_DEFAULT | RANGE_LOW_BOUND_DEFAULT))
+ {
+ kind = RANGE_LOW_BOUND_DEFAULT;
+ if (!operation->inclusive)
+ kind |= RANGE_HIGH_BOUND_EXCLUSIVE;
+ }
else
{
- gdb_assert (kind == HIGH_BOUND_DEFAULT);
- kind = (operation->inclusive
- ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE);
+ gdb_assert (kind == RANGE_HIGH_BOUND_DEFAULT);
+ kind = RANGE_STANDARD;
+ if (!operation->inclusive)
+ kind |= RANGE_HIGH_BOUND_EXCLUSIVE;
}
}
else
diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
index f7c762eb640..820ebb92c43 100644
--- a/gdb/rust-lang.c
+++ b/gdb/rust-lang.c
@@ -1077,13 +1077,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
*pos += 3;
- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT
- || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(kind & RANGE_LOW_BOUND_DEFAULT))
low = evaluate_subexp (nullptr, exp, pos, noside);
- if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE
- || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(kind & RANGE_HIGH_BOUND_DEFAULT))
high = evaluate_subexp (nullptr, exp, pos, noside);
- bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT);
+ bool inclusive = !(kind & RANGE_HIGH_BOUND_EXCLUSIVE);
if (noside == EVAL_SKIP)
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
@@ -1166,13 +1164,13 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
static void
rust_compute_range (struct type *type, struct value *range,
LONGEST *low, LONGEST *high,
- enum range_type *kind)
+ range_types *kind)
{
int i;
*low = 0;
*high = 0;
- *kind = BOTH_BOUND_DEFAULT;
+ *kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
if (type->num_fields () == 0)
return;
@@ -1180,15 +1178,15 @@ 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 = RANGE_HIGH_BOUND_DEFAULT;
*low = value_as_long (value_field (range, 0));
++i;
}
if (type->num_fields () > i
&& strcmp (TYPE_FIELD_NAME (type, i), "end") == 0)
{
- *kind = (*kind == BOTH_BOUND_DEFAULT
- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
+ *kind = (*kind == (RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT)
+ ? RANGE_LOW_BOUND_DEFAULT : RANGE_STANDARD);
*high = value_as_long (value_field (range, i));
if (rust_inclusive_range_type_p (type))
@@ -1206,7 +1204,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;
+ range_types kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
LONGEST high = 0;
int want_slice = 0;
@@ -1303,8 +1301,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
else
error (_("Cannot subscript non-array type"));
- if (want_slice
- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT))
+ if (want_slice && (kind & RANGE_LOW_BOUND_DEFAULT))
low = low_bound;
if (low < 0)
error (_("Index less than zero"));
@@ -1322,7 +1319,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 & RANGE_HIGH_BOUND_DEFAULT)
high = high_bound;
if (high < 0)
error (_("High index less than zero"));
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv4 2/3] gdb: rename 'enum range_type' to 'enum range_flag'
2020-09-28 9:40 ` [PATCHv4 0/3] Fortran Array Slicing and Striding Support Andrew Burgess
2020-09-28 9:40 ` [PATCHv4 1/3] gdb: Convert enum range_type to a bit field enum Andrew Burgess
@ 2020-09-28 9:40 ` Andrew Burgess
2020-09-28 9:40 ` [PATCHv4 3/3] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-10-11 18:12 ` [PATCHv5 0/4] Fortran Array Slicing and Striding Support Andrew Burgess
3 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-09-28 9:40 UTC (permalink / raw)
To: gdb-patches
To avoid confusion with other parts of GDB relating to types and
ranges, rename this enum to make it clearer that it is a set of
individual flags rather than an enumeration of different types of
range.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* expprint.c (print_subexp_standard): Change enum range_type to
range_flag and rename variables to match.
(dump_subexp_body_standard): Likewise.
* expression.h (enum range_type): Rename to...
(enum range_flag): ...this.
(range_types): Rename to...
(range_flags): ...this.
* f-lang.c (value_f90_subarray): Change enum range_type to
range_flag and rename variables to match.
* parse.c (operator_length_standard): Likewise.
* rust-exp.y (rust_parser::convert_ast_to_expression): Change enum
range_type to range_flag.
* rust-lang.c (rust_evaluate_funcall): Likewise.
(rust_range): Likewise.
(rust_compute_range): Likewise.
(rust_subscript): Likewise.
---
gdb/ChangeLog | 19 +++++++++++++++++++
gdb/expprint.c | 24 ++++++++++++------------
gdb/expression.h | 4 ++--
gdb/f-lang.c | 8 ++++----
gdb/parse.c | 8 ++++----
gdb/rust-exp.y | 2 +-
gdb/rust-lang.c | 8 ++++----
7 files changed, 46 insertions(+), 27 deletions(-)
diff --git a/gdb/expprint.c b/gdb/expprint.c
index bdb69a92f75..2dee2bb1932 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -579,19 +579,19 @@ print_subexp_standard (struct expression *exp, int *pos,
case OP_RANGE:
{
- enum range_type range_type;
+ enum range_flag range_flag;
- range_type = (enum range_type)
+ range_flag = (enum range_flag)
longest_to_int (exp->elts[pc + 1].longconst);
*pos += 2;
- if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
+ if (range_flag & RANGE_HIGH_BOUND_EXCLUSIVE)
fputs_filtered ("EXCLUSIVE_", stream);
fputs_filtered ("RANGE(", stream);
- if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_LOW_BOUND_DEFAULT))
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered ("..", stream);
- if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
@@ -1106,25 +1106,25 @@ dump_subexp_body_standard (struct expression *exp,
break;
case OP_RANGE:
{
- enum range_type range_type;
+ enum range_flag range_flag;
- range_type = (enum range_type)
+ range_flag = (enum range_flag)
longest_to_int (exp->elts[elt].longconst);
elt += 2;
- if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
+ if (range_flag & RANGE_HIGH_BOUND_EXCLUSIVE)
fputs_filtered ("Exclusive", stream);
fputs_filtered ("Range '", stream);
- if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_LOW_BOUND_DEFAULT))
fputs_filtered ("EXP", stream);
fputs_filtered ("..", stream);
- if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
fputs_filtered ("EXP", stream);
fputs_filtered ("'", stream);
- if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
- if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 6bd3fc0c3c5..fd483e5f277 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -185,7 +185,7 @@ extern void dump_prefix_expression (struct expression *, struct ui_file *);
or inclusive. So we have six sorts of subrange. This enumeration
type is to identify this. */
-enum range_type : unsigned
+enum range_flag : unsigned
{
/* This is a standard range. Both the lower and upper bounds are
defined, and the bounds are inclusive. */
@@ -201,6 +201,6 @@ enum range_type : unsigned
RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
};
-DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
+DEF_ENUM_FLAGS_TYPE (enum range_flag, range_flags);
#endif /* !defined (EXPRESSION_H) */
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index fcab973f874..37d05b27653 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -126,17 +126,17 @@ value_f90_subarray (struct value *array,
int pc = (*pos) + 1;
LONGEST low_bound, high_bound;
struct type *range = check_typedef (value_type (array)->index_type ());
- enum range_type range_type
- = (enum range_type) longest_to_int (exp->elts[pc].longconst);
+ enum range_flag range_flag
+ = (enum range_flag) longest_to_int (exp->elts[pc].longconst);
*pos += 3;
- if (range_type & RANGE_LOW_BOUND_DEFAULT)
+ if (range_flag & RANGE_LOW_BOUND_DEFAULT)
low_bound = range->bounds ()->low.const_val ();
else
low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
- if (range_type & RANGE_HIGH_BOUND_DEFAULT)
+ if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
high_bound = range->bounds ()->high.const_val ();
else
high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
diff --git a/gdb/parse.c b/gdb/parse.c
index 6661fba81d7..4a15de8a499 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -774,7 +774,7 @@ operator_length_standard (const struct expression *expr, int endpos,
{
int oplen = 1;
int args = 0;
- enum range_type range_type;
+ enum range_flag range_flag;
int i;
if (endpos < 1)
@@ -918,15 +918,15 @@ operator_length_standard (const struct expression *expr, int endpos,
case OP_RANGE:
oplen = 3;
- range_type = (enum range_type)
+ range_flag = (enum range_flag)
longest_to_int (expr->elts[endpos - 2].longconst);
/* Assume the range has 2 arguments (low bound and high bound), then
reduce the argument count if any bounds are set to default. */
args = 2;
- if (range_type & RANGE_LOW_BOUND_DEFAULT)
+ if (range_flag & RANGE_LOW_BOUND_DEFAULT)
--args;
- if (range_type & RANGE_HIGH_BOUND_DEFAULT)
+ if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
--args;
break;
diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
index ea9fbdc25fb..802ccc0a7f6 100644
--- a/gdb/rust-exp.y
+++ b/gdb/rust-exp.y
@@ -2492,7 +2492,7 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
case OP_RANGE:
{
- enum range_type kind = (RANGE_HIGH_BOUND_DEFAULT
+ enum range_flag kind = (RANGE_HIGH_BOUND_DEFAULT
| RANGE_LOW_BOUND_DEFAULT);
if (operation->left.op != NULL)
diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
index 820ebb92c43..86e7289c5e6 100644
--- a/gdb/rust-lang.c
+++ b/gdb/rust-lang.c
@@ -1065,7 +1065,6 @@ rust_evaluate_funcall (struct expression *exp, int *pos, enum noside noside)
static struct value *
rust_range (struct expression *exp, int *pos, enum noside noside)
{
- enum range_type kind;
struct value *low = NULL, *high = NULL;
struct value *addrval, *result;
CORE_ADDR addr;
@@ -1074,7 +1073,8 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
struct type *temp_type;
const char *name;
- kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
+ auto kind
+ = (enum range_flag) longest_to_int (exp->elts[*pos + 1].longconst);
*pos += 3;
if (!(kind & RANGE_LOW_BOUND_DEFAULT))
@@ -1164,7 +1164,7 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
static void
rust_compute_range (struct type *type, struct value *range,
LONGEST *low, LONGEST *high,
- range_types *kind)
+ range_flags *kind)
{
int i;
@@ -1204,7 +1204,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
struct type *rhstype;
LONGEST low, high_bound;
/* Initialized to appease the compiler. */
- range_types kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
+ range_flags kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
LONGEST high = 0;
int want_slice = 0;
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv4 3/3] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-09-28 9:40 ` [PATCHv4 0/3] Fortran Array Slicing and Striding Support Andrew Burgess
2020-09-28 9:40 ` [PATCHv4 1/3] gdb: Convert enum range_type to a bit field enum Andrew Burgess
2020-09-28 9:40 ` [PATCHv4 2/3] gdb: rename 'enum range_type' to 'enum range_flag' Andrew Burgess
@ 2020-09-28 9:40 ` Andrew Burgess
2020-09-28 9:52 ` Eli Zaretskii
2020-10-11 18:12 ` [PATCHv5 0/4] Fortran Array Slicing and Striding Support Andrew Burgess
3 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-09-28 9:40 UTC (permalink / raw)
To: gdb-patches
This commit brings array slice support to GDB.
WARNING: This patch contains a rather big hack which is limited to
Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More
details on this below.
This patch rewrites two areas of GDB's Fortran support, the code to
extract an array slice, and the code to print an array.
After this commit a user can, from the GDB prompt, ask for a slice of
a Fortran array and should get the correct result back. Slices can
(optionally) have the lower bound, upper bound, and a stride
specified. Slices can also have a negative stride.
Fortran has the concept of repacking array slices. Within a compiled
Fortran program if a user passes a non-contiguous array slice to a
function then the compiler may have to repack the slice, this involves
copying the elements of the slice to a new area of memory before the
call, and copying the elements back to the original array after the
call. Whether repacking occurs will depend on which version of
Fortran is being used, and what type of function is being called.
This commit adds support for both packed, and unpacked array slicing,
with the default being unpacked.
With an unpacked array slice, when the user asks for a slice of an
array GDB creates a new type that accurately describes where the
elements of the slice can be found within the original array, a
value of this type is then returned to the user. The address of an
element within the slice will be equal to the address of an element
within the original array.
A user can choose to selected packed array slices instead using:
(gdb) set fortran repack-array-slices on|off
(gdb) show fortran repack-array-slices
With packed array slices GDB creates a new type that reflects how the
elements of the slice would look if they were laid out in contiguous
memory, allocates a value of this type, and then fetches the elements
from the original array and places then into the contents buffer of
the new value.
One benefit of using packed slices over unapacked slices is the memory
usage, taking a small slice of N elements from a large array will
require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked
array will also include all of the "padding" between the
non-contiguous elements. There are new tests added that highlight
this difference.
There is also a new debugging flag added with this commit that
introduces these commands:
(gdb) set debug fortran-array-slicing on|off
(gdb) show debug fortran-array-slicing
This prints information about how the array slices are being built.
As both the repacking, and the array printing requires GDB to walk
through a multi-dimensional Fortran array visiting each element, this
commit adds the file f-array-walk.h, which introduces some
infrastructure to support this process. This means the array printing
code in f-valprint.c is significantly reduced.
The only slight issue with this commit is the "rather big hack" that I
mentioned above. This hack allows us to handle one specific case,
array slices with negative strides. This is something that I don't
believe the current GDB value contents model will allow us to
"correctly" handle, and rather than rewrite the value contents code
right now, I'm hoping to slip this hack in as a work around.
The problem is that as I see it the current value contents model
assumes that an object base address will be the lowest address within
that object, and that the contents of the object start at this base
address and occupy the TYPE_LENGTH bytes after that.
We do have the embedded_offset, which is used for C++ sub-classes,
such that an object can start at some offset from the content buffer,
however, the assumption that the object then occupies the next
TYPE_LENGTH bytes is still true within GDB.
The problem is that Fortran arrays with a negative stride don't follow
this pattern. In this case the base address of the object points to
the element with the highest address, the contents of the array then
start at some offset _before_ the base address, and proceed for one
element _past_ the base address.
This is further complicated because arrays with negative strides like
this are always dynamic types, the program being debugged has passed a
slice with a negative stride to a function, and it is only when we
actually try to look at the slice within the function that the dynamic
type is resolved, and the negative type is seen. When dealing with
dynamic types like this the address is actually stored on the _type_,
not the value, this dynamic address then overrides the value's address
in the value_address function.
I currently don't see any way to handle this address configuration
with GDB's current dynamic type and value system, which is why I've
added this hack:
When we resolve a dynamic Fortran array type, if the stride is
negative, then we adjust the base address to point to the lowest
address required by the array. The printing and slicing code is aware
of this adjustment and will correctly slice and print Fortran arrays.
Where this hack will show through to the user is if they ask for the
address of an array in their program with a negative array stride, the
address they get from GDB will not match the address that would be
computed within the Fortran program.
gdb/ChangeLog:
* Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
* NEWS: Mention new options.
* expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE.
* expression.h (enum range_type): Add RANGE_HAS_STRIDE.
* f-array-walker.h: New file.
* f-exp.y (arglist): Allow for a series of subranges.
(subrange): Add cases for subranges with strides.
* f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
(repack_array_slices): New static global.
(show_repack_array_slices): New function.
(fortran_array_slicing_debug): New static global.
(show_fortran_array_slicing_debug): New function.
(value_f90_subarray): Delete.
(skip_undetermined_arglist): Delete.
(class fortran_array_repacker_base_impl): New class.
(class fortran_lazy_array_repacker_impl): New class.
(class fortran_array_repacker_impl): New class.
(fortran_value_subarray): Complete rewrite.
(set_fortran_list): New static global.
(show_fortran_list): Likewise.
(_initialize_f_language): Register new commands.
(fortran_adjust_dynamic_array_base_address_hack): New function.
* f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
Declare.
* f-valprint.c: Include 'f-array-walker.h'.
(class fortran_array_printer_impl): New class.
(f77_print_array_1): Delete.
(f77_print_array): Delete.
(fortran_print_array): New.
(f_value_print_inner): Update to call fortran_print_array.
* gdbtypes.c: Include 'f-lang.h'.
(resolve_dynamic_type_internal): Call
fortran_adjust_dynamic_array_base_address_hack.
* parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE.
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices-bad.exp: New file.
* gdb.fortran/array-slices-bad.f90: New file.
* gdb.fortran/array-slices-sub-slices.exp: New file.
* gdb.fortran/array-slices-sub-slices.f90: New file.
* gdb.fortran/array-slices.exp: Rewrite tests.
* gdb.fortran/array-slices.f90: Rewrite tests.
* gdb.fortran/vla-sizeof.exp: Correct expected results.
gdb/doc/ChangeLog:
* gdb.texinfo (Debugging Output): Document 'set/show debug
fotran-array-slicing'.
(Special Fortran Commands): Document 'set/show fortran
repack-array-slices'.
---
gdb/ChangeLog | 37 +
gdb/Makefile.in | 1 +
gdb/NEWS | 13 +
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 30 +
gdb/expprint.c | 4 +
gdb/expression.h | 3 +
gdb/f-array-walker.h | 255 +++++++
gdb/f-exp.y | 38 +
gdb/f-lang.c | 704 ++++++++++++++++--
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 190 ++---
gdb/gdbtypes.c | 12 +-
gdb/parse.c | 2 +
gdb/testsuite/ChangeLog | 10 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 ++
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 267 ++++++-
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
22 files changed, 2048 insertions(+), 230 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
diff --git a/gdb/Makefile.in b/gdb/Makefile.in
index dbede7a9cfc..5bd8751cf1e 100644
--- a/gdb/Makefile.in
+++ b/gdb/Makefile.in
@@ -1269,6 +1269,7 @@ HFILES_NO_SRCDIR = \
expression.h \
extension.h \
extension-priv.h \
+ f-array-walker.h \
f-lang.h \
fbsd-nat.h \
fbsd-tdep.h \
diff --git a/gdb/NEWS b/gdb/NEWS
index f30d7183312..253ba089c2b 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -123,6 +123,19 @@ maintenance print core-file-backed-mappings
Prints file-backed mappings loaded from a core file's note section.
Output is expected to be similar to that of "info proc mappings".
+set debug fortran-array-slicing on|off
+show debug fortran-array-slicing
+ Print debugging when taking slices of Fortran arrays.
+
+set fortran repack-array-slices on|off
+show fortran repack-array-slices
+ When taking slices from Fortran arrays and strings, if the slice is
+ non-contiguous within the original value then, when this option is
+ on, the new value will be repacked into a single contiguous value.
+ When this option is off, then the value returned will consist of a
+ descriptor that describes the slice within the memory of the
+ original parent value.
+
* Changed commands
alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...]
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index 8bff27c940d..e3950ca5970 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -16919,6 +16919,29 @@
block whose name is @var{common-name}. With no argument, the names of
all @code{COMMON} blocks visible at the current program location are
printed.
+@cindex arrays slices (Fortran)
+@kindex set fortran repack-array-slices
+@kindex show fortran repack-array-slices
+@item set fortran repack-array-slices [on|off]
+@item show fortran repack-array-slices
+When taking a slice from an array, a Fortran compiler can choose to
+either produce an array descriptor that describes the slice in place,
+or it may repack the slice, copying the elements of the slice into a
+new region of memory.
+
+When this setting is on, then @value{GDBN} will also repack array
+slices in some situations. When this setting is off, then
+@value{GDBN} will create array descriptors for slices that reference
+the original data in place.
+
+@value{GDBN} will never repack an array slice if the data for the
+slice is contiguous within the original array.
+
+@value{GDBN} will always repack string slices if the data for the
+slice is non-contiguous within the original string as @value{GDBN}
+does not support printing non-contiguous strings.
+
+The default for this setting is @code{off}.
@end table
@node Pascal
@@ -26486,6 +26509,13 @@
Turns on or off debugging messages from the FreeBSD native target.
@item show debug fbsd-nat
Show the current state of FreeBSD native target debugging messages.
+@item set debug fortran-array-slicing
+@cindex fortran array slicing debugging info
+Turns on or off display of @value{GDBN} Fortran array slicing
+debugging info. The default is off.
+@item show debug fortran-array-slicing
+Displays the current state of displaying @value{GDBN} Fortran array
+slicing debugging info.
@item set debug frame
@cindex frame debugging info
Turns on or off display of @value{GDBN} frame debugging info. The
diff --git a/gdb/expprint.c b/gdb/expprint.c
index 2dee2bb1932..a14eeb00f19 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -1120,12 +1120,16 @@ dump_subexp_body_standard (struct expression *exp,
fputs_filtered ("..", stream);
if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
fputs_filtered ("EXP", stream);
+ if (range_flag & RANGE_HAS_STRIDE)
+ fputs_filtered (":EXP", stream);
fputs_filtered ("'", stream);
if (!(range_flag & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
+ if (range_flag & RANGE_HAS_STRIDE)
+ elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index fd483e5f277..8de712310ec 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -199,6 +199,9 @@ enum range_flag : unsigned
/* The high bound of this range is exclusive. */
RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
+
+ /* The range has a stride. */
+ RANGE_HAS_STRIDE = 1 << 3,
};
DEF_ENUM_FLAGS_TYPE (enum range_flag, range_flags);
diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h
new file mode 100644
index 00000000000..395c26e5350
--- /dev/null
+++ b/gdb/f-array-walker.h
@@ -0,0 +1,255 @@
+/* Copyright (C) 2020 Free Software Foundation, Inc.
+
+ This file is part of GDB.
+
+ 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/>. */
+
+/* Support classes to wrap up the process of iterating over a
+ multi-dimensional Fortran array. */
+
+#ifndef F_ARRAY_WALKER_H
+#define F_ARRAY_WALKER_H
+
+#include "defs.h"
+#include "gdbtypes.h"
+#include "f-lang.h"
+
+/* Class for calculating the byte offset for elements within a single
+ dimension of a Fortran array. */
+class fortran_array_offset_calculator
+{
+public:
+ /* Create a new offset calculator for TYPE, which is either an array or a
+ string. */
+ fortran_array_offset_calculator (struct type *type)
+ {
+ /* Validate the type. */
+ type = check_typedef (type);
+ if (type->code () != TYPE_CODE_ARRAY
+ && (type->code () != TYPE_CODE_STRING))
+ error (_("can only compute offsets for arrays and strings"));
+
+ /* Get the range, and extract the bounds. */
+ struct type *range_type = type->index_type ();
+ if (get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound) < 0)
+ error ("unable to read array bounds");
+
+ /* Figure out the stride for this array. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ m_stride = type->index_type ()->bounds ()->bit_stride ();
+ if (m_stride == 0)
+ m_stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ m_stride /= (unit_size * 8);
+ }
+ };
+
+ /* Get the byte offset for element INDEX within the type we are working
+ on. There is no bounds checking done on INDEX. If the stride is
+ negative then we still assume that the base address (for the array
+ object) points to the element with the lowest memory address, we then
+ calculate an offset assuming that index 0 will be the element at the
+ highest address, index 1 the next highest, and so on. This is not
+ quite how Fortran works in reality; in reality the base address of
+ the object would point at the element with the highest address, and
+ we would index backwards from there in the "normal" way, however,
+ GDB's current value contents model doesn't support having the base
+ address be near to the end of the value contents, so we currently
+ adjust the base address of Fortran arrays with negative strides so
+ their base address points at the lowest memory address. This code
+ here is part of working around this weirdness. */
+ LONGEST index_offset (LONGEST index)
+ {
+ LONGEST offset;
+ if (m_stride < 0)
+ offset = std::abs (m_stride) * (m_upperbound - index);
+ else
+ offset = std::abs (m_stride) * (index - m_lowerbound);
+ return offset;
+ }
+
+private:
+
+ /* The stride for the type we are working with. */
+ LONGEST m_stride;
+
+ /* The upper bound for the type we are working with. */
+ LONGEST m_upperbound;
+
+ /* The lower bound for the type we are working with. */
+ LONGEST m_lowerbound;
+};
+
+/* A base class used by fortran_array_walker. */
+class fortran_array_walker_base_impl
+{
+public:
+ /* Constructor. */
+ explicit fortran_array_walker_base_impl ()
+ { /* Nothing. */ }
+
+ /* Called when iterating between the lower and upper bounds of each
+ dimension of the array. Return true if GDB should continue iterating,
+ otherwise, return false.
+
+ SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
+ be taken into consideration when deciding what to return. If
+ SHOULD_CONTINUE is false then this function must also return false,
+ the function is still called though in case extra work needs to be
+ done as part of the stopping process. */
+ bool continue_walking (bool should_continue)
+ { return should_continue; }
+
+ /* Called when GDB starts iterating over a dimension of the array. This
+ function will be called once for each of the bounds in this dimension.
+ DIM is the current dimension number, NDIM is the total number of
+ dimensions, and FIRST_P is true for the first bound of this
+ dimension, and false in all other cases. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ { /* Nothing. */ }
+
+ /* Called when GDB finishes iterating over a dimension of the array.
+ This function will be called once for each of the bounds in this
+ dimension. DIM is the current dimension number, NDIM is the total
+ number of dimensions, and LAST_P is true for the last bound of this
+ dimension, and false in all other cases. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ { /* Nothing. */ }
+
+ /* Called when processing the inner most dimension of the array, for
+ every element in the array. PARENT_VALUE is the value from which
+ elements are being extracted, ELT_TYPE is the type of the element
+ being extracted, and ELT_OFF is the offset of the element from the
+ start of PARENT_VALUE. */
+ void process_element (struct value *parent_value, struct type *elt_type,
+ LONGEST elt_off)
+ { /* Nothing. */ }
+};
+
+/* A class to wrap up the process of iterating over a multi-dimensional
+ Fortran array. IMPL is used to specialise what happens as we walk over
+ the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
+ methods than can be used to customise the array walk. */
+template<typename Impl>
+class fortran_array_walker
+{
+ /* Ensure that Impl is derived from the required base class. This just
+ ensures that all of the required API methods are available and have a
+ sensible default implementation. */
+ gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
+
+public:
+ /* Create a new array walker. TYPE is the type of the array being walked
+ over, and ADDRESS is the base address for the object of TYPE in
+ memory. All other arguments are forwarded to the constructor of the
+ template parameter class IMPL. */
+ template <typename ...Args>
+ fortran_array_walker (struct type *type, CORE_ADDR address,
+ Args... args)
+ : m_type (type),
+ m_address (address),
+ m_impl (type, address, args...)
+ {
+ m_ndimensions = calc_f77_array_dims (m_type);
+ }
+
+ /* Walk the array. */
+ void
+ walk ()
+ {
+ walk_1 (1, m_type, 0);
+ }
+
+private:
+ /* The core of the array walking algorithm. NSS is the current
+ dimension number being processed, TYPE is the type of this dimension,
+ and OFFSET is the offset (in bytes) for the start of this dimension. */
+ void
+ walk_1 (int nss, struct type *type, int offset)
+ {
+ /* Extract the range, and get lower and upper bounds. */
+ struct type *range_type = check_typedef (type)->index_type ();
+ LONGEST lowerbound, upperbound;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* CALC is used to calculate the offsets for each element in this
+ dimension. */
+ fortran_array_offset_calculator calc (type);
+
+ if (nss != m_ndimensions)
+ {
+ /* For dimensions other than the inner most, walk each element and
+ recurse while peeling off one more dimension of the array. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ m_impl.start_dimension (nss, m_ndimensions, (i == lowerbound));
+
+ /* Use the index and the stride to work out a new offset. */
+ LONGEST new_offset = offset + calc.index_offset (i);
+
+ /* Now print the lower dimension. */
+ struct type *subarray_type
+ = TYPE_TARGET_TYPE (check_typedef (type));
+ walk_1 (nss + 1, subarray_type, new_offset);
+
+ m_impl.finish_dimension (nss, m_ndimensions, (i == upperbound));
+ }
+ }
+ else
+ {
+ /* For the inner most dimension of the array, process each element
+ within this dimension. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ m_impl.start_dimension (nss, m_ndimensions, (i == lowerbound));
+
+ LONGEST elt_off = offset + calc.index_offset (i);
+
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ if (is_dynamic_type (elt_type))
+ {
+ CORE_ADDR e_address = m_address + elt_off;
+ elt_type = resolve_dynamic_type (elt_type, {}, e_address);
+ }
+
+ m_impl.process_element (elt_type, elt_off);
+
+ m_impl.finish_dimension (nss, m_ndimensions, (i == upperbound));
+ }
+ }
+ }
+
+ /* The array type being processed. */
+ struct type *m_type;
+
+ /* The address in target memory for the object of M_TYPE being
+ processed. This is required in order to resolve dynamic types. */
+ CORE_ADDR m_address;
+
+ /* An instance of the template specialisation class. */
+ Impl m_impl;
+
+ /* The total number of dimensions in M_TYPE. */
+ int m_ndimensions;
+};
+
+#endif /* F_ARRAY_WALKER_H */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index a3314082d90..f227690cea6 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -284,6 +284,10 @@ arglist : arglist ',' exp %prec ABOVE_COMMA
{ pstate->arglist_len++; }
;
+arglist : arglist ',' subrange %prec ABOVE_COMMA
+ { pstate->arglist_len++; }
+ ;
+
/* There are four sorts of subrange types in F90. */
subrange: exp ':' exp %prec ABOVE_COMMA
@@ -314,6 +318,40 @@ subrange: ':' %prec ABOVE_COMMA
write_exp_elt_opcode (pstate, OP_RANGE); }
;
+/* And each of the four subrange types can also have a stride. */
+subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (pstate, OP_RANGE);
+ write_exp_elt_longcst (pstate,
+ (RANGE_STANDARD
+ | RANGE_HAS_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,
+ (RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_HAS_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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HAS_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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_HAS_STRIDE));
+ write_exp_elt_opcode (pstate, OP_RANGE); }
+ ;
+
complexnum: exp ',' exp
{ }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 37d05b27653..202170e3c25 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -36,9 +36,36 @@
#include "c-lang.h"
#include "target-float.h"
#include "gdbarch.h"
+#include "gdbcmd.h"
+#include "f-array-walker.h"
#include <math.h>
+/* Whether GDB should repack array slices created by the user. */
+static bool repack_array_slices = false;
+
+/* Implement 'show fortran repack-array-slices'. */
+static void
+show_repack_array_slices (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c, const char *value)
+{
+ fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"),
+ value);
+}
+
+/* Debugging of Fortran's array slicing. */
+static bool fortran_array_slicing_debug = false;
+
+/* Implement 'show debug fortran-array-slicing'. */
+static void
+show_fortran_array_slicing_debug (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c,
+ const char *value)
+{
+ fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"),
+ value);
+}
+
/* Local functions */
/* Return the encoding that should be used for the character type
@@ -114,49 +141,6 @@ enum f_primitive_types {
nr_f_primitive_types
};
-/* Called from fortran_value_subarray to take a slice of an array or a
- string. ARRAY is the array or string to be accessed. EXP, POS, and
- NOSIDE are as for evaluate_subexp_standard. Return a value that is a
- slice of the array. */
-
-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 (value_type (array)->index_type ());
- enum range_flag range_flag
- = (enum range_flag) longest_to_int (exp->elts[pc].longconst);
-
- *pos += 3;
-
- if (range_flag & RANGE_LOW_BOUND_DEFAULT)
- low_bound = range->bounds ()->low.const_val ();
- else
- low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
-
- if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
- high_bound = range->bounds ()->high.const_val ();
- else
- high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
-
- return value_slice (array, low_bound, high_bound - low_bound + 1);
-}
-
-/* Helper for skipping all the arguments in an undetermined argument list.
- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
- case of evaluate_subexp_standard as multiple, but not all, code paths
- require a generic skip. */
-
-static void
-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
- enum noside noside)
-{
- for (int i = 0; i < nargs; ++i)
- evaluate_subexp (nullptr, exp, pos, noside);
-}
-
/* Return the number of dimensions for a Fortran array or string. */
int
@@ -181,6 +165,145 @@ calc_f77_array_dims (struct type *array_type)
return ndimen;
}
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This is a base class for two alternative repacking mechanisms,
+ one for when repacking from a lazy value, and one for repacking from a
+ non-lazy (already loaded) value. */
+class fortran_array_repacker_base_impl
+ : public fortran_array_walker_base_impl
+{
+public:
+ /* Constructor, DEST is the value we are repacking into. */
+ fortran_array_repacker_base_impl (struct value *dest)
+ : m_dest (dest),
+ m_dest_offset (0)
+ { /* Nothing. */ }
+
+ /* When we start processing the inner most dimension, this is where we
+ will be creating values for each element as we load them and then copy
+ them into the M_DEST value. Set a value mark so we can free these
+ temporary values. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ {
+ if (dim == ndim && first_p)
+ {
+ gdb_assert (m_mark == nullptr);
+ m_mark = value_mark ();
+ }
+ }
+
+ /* When we finish processing the inner most dimension free all temporary
+ value that were created. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ {
+ if (dim == ndim && last_p)
+ {
+ gdb_assert (m_mark != nullptr);
+ value_free_to_mark (m_mark);
+ m_mark = nullptr;
+ }
+ }
+
+protected:
+ /* Copy the contents of array element ELT into M_DEST at the next
+ available offset. */
+ void copy_element_to_dest (struct value *elt)
+ {
+ value_contents_copy (m_dest, m_dest_offset, elt, 0,
+ TYPE_LENGTH (value_type (elt)));
+ m_dest_offset += TYPE_LENGTH (value_type (elt));
+ }
+
+ /* The value being written to. */
+ struct value *m_dest;
+
+ /* The byte offset in M_DEST at which the next element should be
+ written. */
+ LONGEST m_dest_offset;
+
+ /* Set with a call to VALUE_MARK, and then reset after calling
+ VALUE_FREE_TO_MARK. */
+ struct value *m_mark = nullptr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ lazy array value, as such it does not require the parent array value to
+ be loaded into GDB's memory; the parent value could be huge, while the
+ slice could be tiny. */
+class fortran_lazy_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type of the slice being loaded from the
+ parent value, so this type will correctly reflect the strides required
+ to find all of the elements from the parent value. ADDRESS is the
+ address in target memory of value matching TYPE, and DEST is the value
+ we are repacking into. */
+ explicit fortran_lazy_array_repacker_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_addr (address)
+ { /* Nothing. */ }
+
+ /* Create a lazy value in target memory representing a single element,
+ then load the element into GDB's memory and copy the contents into the
+ destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off));
+ }
+
+private:
+ /* The address in target memory where the parent value starts. */
+ CORE_ADDR m_addr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ previously loaded (non-lazy) array value, as such it fetches the
+ element values from the contents of the parent value. */
+class fortran_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type for the array slice within the parent
+ value, as such it has stride values as required to find the elements
+ within the original parent value. ADDRESS is the address in target
+ memory of the value matching TYPE. BASE_OFFSET is the offset from
+ the start of VAL's content buffer to the start of the object of TYPE,
+ VAL is the parent object from which we are loading the value, and
+ DEST is the value into which we are repacking. */
+ explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address,
+ LONGEST base_offset,
+ struct value *val, struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_base_offset (base_offset),
+ m_val (val)
+ {
+ gdb_assert (!value_lazy (val));
+ }
+
+ /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF)
+ from the content buffer of M_VAL then copy this extracted value into
+ the repacked destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ struct value *elt
+ = value_from_component (m_val, elt_type, (elt_off + m_base_offset));
+ copy_element_to_dest (elt);
+ }
+
+private:
+ /* The offset into the content buffer of M_VAL to the start of the slice
+ being extracted. */
+ LONGEST m_base_offset;
+
+ /* The parent value from which we are extracting a slice. */
+ struct value *m_val;
+};
+
/* Called from evaluate_subexp_standard to perform array indexing, and
sub-range extraction, for Fortran. As well as arrays this function
also handles strings as they can be treated like arrays of characters.
@@ -192,51 +315,394 @@ static struct value *
fortran_value_subarray (struct value *array, struct expression *exp,
int *pos, int nargs, enum noside noside)
{
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (array, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
+ type *original_array_type = check_typedef (value_type (array));
+ bool is_string_p = original_array_type->code () == TYPE_CODE_STRING;
+
+ /* Perform checks for ARRAY not being available. The somewhat overly
+ complex logic here is just to keep backward compatibility with the
+ errors that we used to get before FORTRAN_VALUE_SUBARRAY was
+ rewritten. Maybe a future task would streamline the error messages we
+ get here, and update all the expected test results. */
+ if (exp->elts[*pos].opcode != OP_RANGE)
{
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return array;
+ if (type_not_associated (original_array_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (original_array_type))
+ error (_("no such vector element (vector not allocated)"));
+ }
+ else
+ {
+ if (type_not_associated (original_array_type))
+ error (_("array not associated"));
+ else if (type_not_allocated (original_array_type))
+ error (_("array not allocated"));
}
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1;
- struct type *type = check_typedef (value_type (array));
+ /* First check that the number of dimensions in the type we are slicing
+ matches the number of arguments we were passed. */
+ int ndimensions = calc_f77_array_dims (original_array_type);
+ if (nargs != ndimensions)
+ error (_("Wrong number of subscripts"));
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+ /* This will be initialised below with the type of the elements held in
+ ARRAY. */
+ struct type *inner_element_type;
+
+ /* Extract the types of each array dimension from the original array
+ type. We need these available so we can fill in the default upper and
+ lower bounds if the user requested slice doesn't provide that
+ information. Additionally unpacking the dimensions like this gives us
+ the inner element type. */
+ std::vector<struct type *> dim_types;
+ {
+ dim_types.reserve (ndimensions);
+ struct type *type = original_array_type;
+ for (int i = 0; i < ndimensions; ++i)
+ {
+ dim_types.push_back (type);
+ type = TYPE_TARGET_TYPE (type);
+ }
+ /* TYPE is now the inner element type of the array, we start the new
+ array slice off as this type, then as we process the requested slice
+ (from the user) we wrap new types around this to build up the final
+ slice type. */
+ inner_element_type = type;
+ }
- ndimensions = calc_f77_array_dims (type);
+ /* As we analyse the new slice type we need to understand if the data
+ being referenced is contiguous. Do decide this we must track the size
+ of an element at each dimension of the new slice array. Initially the
+ elements of the inner most dimension of the array are the same inner
+ most elements as the original ARRAY. */
+ LONGEST slice_element_size = TYPE_LENGTH (inner_element_type);
+
+ /* Start off assuming all data is contiguous, this will be set to false
+ if access to any dimension results in non-contiguous data. */
+ bool is_all_contiguous = true;
+
+ /* The TOTAL_OFFSET is the distance in bytes from the start of the
+ original ARRAY to the start of the new slice. This is calculated as
+ we process the information from the user. */
+ LONGEST total_offset = 0;
+
+ /* A structure representing information about each dimension of the
+ resulting slice. */
+ struct slice_dim
+ {
+ /* Constructor. */
+ slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx)
+ : low (l),
+ high (h),
+ stride (s),
+ index (idx)
+ { /* Nothing. */ }
+
+ /* The low bound for this dimension of the slice. */
+ LONGEST low;
+
+ /* The high bound for this dimension of the slice. */
+ LONGEST high;
+
+ /* The byte stride for this dimension of the slice. */
+ LONGEST stride;
+
+ struct type *index;
+ };
+
+ /* The dimensions of the resulting slice. */
+ std::vector<slice_dim> slice_dims;
+
+ /* Process the incoming arguments. These arguments are in the reverse
+ order to the array dimensions, that is the first argument refers to
+ the last array dimension. */
+ if (fortran_array_slicing_debug)
+ debug_printf ("Processing array access:\n");
+ for (int i = 0; i < nargs; ++i)
+ {
+ /* For each dimension of the array the user will have either provided
+ a ranged access with optional lower bound, upper bound, and
+ stride, or the user will have supplied a single index. */
+ struct type *dim_type = dim_types[ndimensions - (i + 1)];
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ {
+ int pc = (*pos) + 1;
+ enum range_flag range_flag = (enum range_flag) exp->elts[pc].longconst;
+ *pos += 3;
+
+ LONGEST low, high, stride;
+ low = high = stride = 0;
+
+ if ((range_flag & RANGE_LOW_BOUND_DEFAULT) == 0)
+ low = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ low = f77_get_lowerbound (dim_type);
+ if ((range_flag & RANGE_HIGH_BOUND_DEFAULT) == 0)
+ high = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ high = f77_get_upperbound (dim_type);
+ if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
+ stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ stride = 1;
+
+ if (stride == 0)
+ error (_("stride must not be 0"));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride ();
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type) * 8;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Range access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Bit stride: %ld\n", sd);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd / 8);
+ debug_printf ("| | |-> Type size: %ld\n",
+ TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| |-> Accessing:\n");
+ debug_printf ("| | |-> Low bound: %ld\n",
+ low);
+ debug_printf ("| | |-> High bound: %ld\n",
+ high);
+ debug_printf ("| | '-> Element stride: %ld\n",
+ stride);
+ }
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
+ /* Check the user hasn't asked for something invalid. */
+ if (high > ub || low < lb)
+ error (_("array subscript out of bounds"));
+
+ /* Calculate what this dimension of the new slice array will look
+ like. OFFSET is the byte offset from the start of the
+ previous (more outer) dimension to the start of this
+ dimension. E_COUNT is the number of elements in this
+ dimension. REMAINDER is the number of elements remaining
+ between the last included element and the upper bound. For
+ example an access '1:6:2' will include elements 1, 3, 5 and
+ have a remainder of 1 (element #6). */
+ LONGEST lowest = std::min (low, high);
+ LONGEST offset = (sd / 8) * (lowest - lb);
+ LONGEST e_count = std::abs (high - low) + 1;
+ e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride);
+ LONGEST new_low = 1;
+ LONGEST new_high = new_low + e_count - 1;
+ LONGEST new_stride = (sd * stride) / 8;
+ LONGEST last_elem = low + ((e_count - 1) * stride);
+ LONGEST remainder = high - last_elem;
+ if (low > high)
+ {
+ offset += std::abs (remainder) * TYPE_LENGTH (target_type);
+ if (stride > 0)
+ error (_("incorrect stride and boundary combination"));
+ }
+ else if (stride < 0)
+ error (_("incorrect stride and boundary combination"));
+
+ /* Is the data within this dimension contiguous? It is if the
+ newly computed stride is the same size as a single element of
+ this dimension. */
+ bool is_dim_contiguous = (new_stride == slice_element_size);
+ is_all_contiguous &= is_dim_contiguous;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("| '-> Results:\n");
+ debug_printf ("| |-> Offset = %ld\n", offset);
+ debug_printf ("| |-> Elements = %ld\n", e_count);
+ debug_printf ("| |-> Low bound = %ld\n", new_low);
+ debug_printf ("| |-> High bound = %ld\n", new_high);
+ debug_printf ("| |-> Byte stride = %ld\n", new_stride);
+ debug_printf ("| |-> Last element = %ld\n", last_elem);
+ debug_printf ("| |-> Remainder = %ld\n", remainder);
+ debug_printf ("| '-> Contiguous = %s\n",
+ (is_dim_contiguous ? "Yes" : "No"));
+ }
+
+ /* Figure out how big (in bytes) an element of this dimension of
+ the new array slice will be. */
+ slice_element_size = std::abs (new_stride * e_count);
+
+ slice_dims.emplace_back (new_low, new_high, new_stride,
+ index_type);
+
+ /* Update the total offset. */
+ total_offset += offset;
+ }
+ else
+ {
+ /* There is a single index for this dimension. */
+ LONGEST index
+ = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride () / 8;
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type);
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Index access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd);
+ debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| '-> Accessing:\n");
+ debug_printf ("| '-> Index: %ld\n", index);
+ }
- gdb_assert (nargs > 0);
+ /* If the array has actual content then check the index is in
+ bounds. An array without content (an unbound array) doesn't
+ have a known upper bound, so don't error check in that
+ situation. */
+ if (index < lb
+ || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED
+ && index > ub)
+ || (VALUE_LVAL (array) != lval_memory
+ && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED))
+ {
+ if (type_not_associated (dim_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (dim_type))
+ error (_("no such vector element (vector not allocated)"));
+ else
+ error (_("no such vector element"));
+ }
- /* Now that we know we have a legal array subscript expression let us
- actually find out where this element exists in the array. */
+ /* Calculate using the type stride, not the target type size. */
+ LONGEST offset = sd * (index - lb);
+ total_offset += offset;
+ }
+ }
- /* Take array indices left to right. */
- for (int i = 0; i < nargs; i++)
+ if (noside == EVAL_SKIP)
+ return array;
+
+ /* Build a type that represents the new array slice in the target memory
+ of the original ARRAY, this type makes use of strides to correctly
+ find only those elements that are part of the new slice. */
+ struct type *array_slice_type = inner_element_type;
+ for (const auto &d : slice_dims)
{
- /* Evaluate each subscript; it must be a legal integer in F77. */
- value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (d.stride);
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ array_slice_type
+ = create_array_type (nullptr, array_slice_type, new_range);
+ }
- /* Fill in the subscript array. */
- subscript_array[i] = value_as_long (arg2);
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("'-> Final result:\n");
+ debug_printf (" |-> Type: %s\n",
+ type_to_string (array_slice_type).c_str ());
+ debug_printf (" |-> Total offset: %ld\n", total_offset);
+ debug_printf (" |-> Base address: %s\n",
+ core_addr_to_string (value_address (array)));
+ debug_printf (" '-> Contiguous = %s\n",
+ (is_all_contiguous ? "Yes" : "No"));
}
- /* Internal type of array is arranged right to left. */
- for (int i = nargs; i > 0; i--)
+ /* Should we repack this array slice? */
+ if (!is_all_contiguous && (repack_array_slices || is_string_p))
{
- struct type *array_type = check_typedef (value_type (array));
- LONGEST index = subscript_array[i - 1];
+ /* Build a type for the repacked slice. */
+ struct type *repacked_array_type = inner_element_type;
+ for (const auto &d : slice_dims)
+ {
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (TYPE_LENGTH (repacked_array_type));
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ repacked_array_type
+ = create_array_type (nullptr, repacked_array_type, new_range);
+ }
- array = value_subscripted_rvalue (array, index,
- f77_get_lowerbound (array_type));
+ /* Now copy the elements from the original ARRAY into the packed
+ array value DEST. */
+ struct value *dest = allocate_value (repacked_array_type);
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ {
+ fortran_array_walker<fortran_lazy_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset, dest);
+ p.walk ();
+ }
+ else
+ {
+ fortran_array_walker<fortran_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset,
+ total_offset, array, dest);
+ p.walk ();
+ }
+ array = dest;
+ }
+ else
+ {
+ if (VALUE_LVAL (array) == lval_memory)
+ {
+ /* If the value we're taking a slice from is not yet loaded, or
+ the requested slice is outside the values content range then
+ just create a new lazy value pointing at the memory where the
+ contents we're looking for exist. */
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ array = value_at_lazy (array_slice_type,
+ value_address (array) + total_offset);
+ else
+ array = value_from_contents_and_address (array_slice_type,
+ (value_contents (array)
+ + total_offset),
+ (value_address (array)
+ + total_offset));
+ }
+ else if (!value_lazy (array))
+ {
+ const void *valaddr = value_contents (array) + total_offset;
+ array = allocate_value (array_slice_type);
+ memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type));
+ }
+ else
+ error (_("cannot subscript arrays that are not in memory"));
}
return array;
@@ -1050,11 +1516,50 @@ builtin_f_type (struct gdbarch *gdbarch)
return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
}
+/* Command-list for the "set/show fortran" prefix command. */
+static struct cmd_list_element *set_fortran_list;
+static struct cmd_list_element *show_fortran_list;
+
void _initialize_f_language ();
void
_initialize_f_language ()
{
f_type_data = gdbarch_data_register_post_init (build_fortran_types);
+
+ add_basic_prefix_cmd ("fortran", no_class,
+ _("Prefix command for changing Fortran-specific settings."),
+ &set_fortran_list, "set fortran ", 0, &setlist);
+
+ add_show_prefix_cmd ("fortran", no_class,
+ _("Generic command for showing Fortran-specific settings."),
+ &show_fortran_list, "show fortran ", 0, &showlist);
+
+ add_setshow_boolean_cmd ("repack-array-slices", class_vars,
+ &repack_array_slices, _("\
+Enable or disable repacking of non-contiguous array slices."), _("\
+Show whether non-contiguous array slices are repacked."), _("\
+When the user requests a slice of a Fortran array then we can either return\n\
+a descriptor that describes the array in place (using the original array data\n\
+in its existing location) or the original data can be repacked (copied) to a\n\
+new location.\n\
+\n\
+When the content of the array slice is contiguous within the original array\n\
+then the result will never be repacked, but when the data for the new array\n\
+is non-contiguous within the original array repacking will only be performed\n\
+when this setting is on."),
+ NULL,
+ show_repack_array_slices,
+ &set_fortran_list, &show_fortran_list);
+
+ /* Debug Fortran's array slicing logic. */
+ add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance,
+ &fortran_array_slicing_debug, _("\
+Set debugging of Fortran array slicing."), _("\
+Show debugging of Fortran array slicing."), _("\
+When on, debugging of Fortran array slicing is enabled."),
+ NULL,
+ show_fortran_array_slicing_debug,
+ &setdebuglist, &showdebuglist);
}
/* See f-lang.h. */
@@ -1093,3 +1598,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type)
return value_type (arg);
return type;
}
+
+/* See f-lang.h. */
+
+CORE_ADDR
+fortran_adjust_dynamic_array_base_address_hack (struct type *type,
+ CORE_ADDR address)
+{
+ gdb_assert (type->code () == TYPE_CODE_ARRAY);
+
+ int ndimensions = calc_f77_array_dims (type);
+ LONGEST total_offset = 0;
+
+ /* Walk through each of the dimensions of this array type and figure out
+ if any of the dimensions are "backwards", that is the base address
+ for this dimension points to the element at the highest memory
+ address and the stride is negative. */
+ struct type *tmp_type = type;
+ for (int i = 0 ; i < ndimensions; ++i)
+ {
+ /* Grab the range for this dimension and extract the lower and upper
+ bounds. */
+ tmp_type = check_typedef (tmp_type);
+ struct type *range_type = tmp_type->index_type ();
+ LONGEST lowerbound, upperbound, stride;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* Figure out the stride for this dimension. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
+ stride = tmp_type->index_type ()->bounds ()->bit_stride ();
+ if (stride == 0)
+ stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ stride /= (unit_size * 8);
+ }
+
+ /* If this dimension is "backward" then figure out the offset
+ adjustment required to point to the element at the lowest memory
+ address, and add this to the total offset. */
+ LONGEST offset = 0;
+ if (stride < 0 && lowerbound < upperbound)
+ offset = (upperbound - lowerbound) * stride;
+ total_offset += offset;
+ tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ }
+
+ /* Adjust the address of this object and return it. */
+ address += total_offset;
+ return address;
+}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 4710b14aa62..dee63158ff4 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -64,7 +64,6 @@ extern void f77_get_dynamic_array_length (struct type *);
extern int calc_f77_array_dims (struct type *);
-
/* Fortran (F77) types */
struct builtin_f_type
@@ -122,4 +121,22 @@ extern struct value *fortran_argument_convert (struct value *value,
extern struct type *fortran_preserve_arg_pointer (struct value *arg,
struct type *type);
+/* Fortran arrays can have a negative stride. When this happens it is
+ often the case that the base address for an object is not the lowest
+ address occupied by that object. For example, an array slice (10:1:-1)
+ will be encoded with lower bound 1, upper bound 10, a stride of
+ -ELEMENT_SIZE, and have a base address pointer that points at the
+ element with the highest address in memory.
+
+ This really doesn't play well with our current model of value contents,
+ but could easily require a significant update in order to be supported
+ "correctly".
+
+ For now, we manually force the base address to be the lowest addressed
+ element here. Yes, this will break some things, but it fixes other
+ things. The hope is that it fixes more than it breaks. */
+
+extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
+ (struct type *type, CORE_ADDR address);
+
#endif /* F_LANG_H */
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index e7dc20d0ea5..f742057d897 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -35,6 +35,7 @@
#include "dictionary.h"
#include "cli/cli-style.h"
#include "gdbarch.h"
+#include "f-array-walker.h"
static void f77_get_dynamic_length_of_aggregate (struct type *);
@@ -100,100 +101,110 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
* TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
}
-/* Actual function which prints out F77 arrays, Valaddr == address in
- the superior. Address == the address in the inferior. */
+/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array
+ walking template. This specialisation prints Fortran arrays. */
-static void
-f77_print_array_1 (int nss, int ndimensions, struct type *type,
- const gdb_byte *valaddr,
- int embedded_offset, CORE_ADDR address,
- struct ui_file *stream, int recurse,
- const struct value *val,
- const struct value_print_options *options,
- int *elts)
+class fortran_array_printer_impl : public fortran_array_walker_base_impl
{
- struct type *range_type = check_typedef (type)->index_type ();
- CORE_ADDR addr = address + embedded_offset;
- LONGEST lowerbound, upperbound;
- LONGEST i;
-
- get_discrete_bounds (range_type, &lowerbound, &upperbound);
-
- if (nss != ndimensions)
- {
- struct gdbarch *gdbarch = get_type_arch (type);
- size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type));
- int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
- size_t byte_stride = type->bit_stride () / (unit_size * 8);
- if (byte_stride == 0)
- byte_stride = dim_size;
- size_t offs = 0;
-
- for (i = lowerbound;
- (i < upperbound + 1 && (*elts) < options->print_max);
- i++)
- {
- struct value *subarray = value_from_contents_and_address
- (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
- + offs, addr + offs);
-
- fprintf_filtered (stream, "(");
- f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
- value_contents_for_printing (subarray),
- value_embedded_offset (subarray),
- value_address (subarray),
- stream, recurse, subarray, options, elts);
- offs += byte_stride;
- fprintf_filtered (stream, ")");
-
- if (i < upperbound)
- fprintf_filtered (stream, " ");
- }
- if (*elts >= options->print_max && i < upperbound)
- fprintf_filtered (stream, "...");
- }
- else
- {
- for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
- i++, (*elts)++)
- {
- struct value *elt = value_subscript ((struct value *)val, i);
-
- common_val_print (elt, stream, recurse, options, current_language);
-
- if (i != upperbound)
- fprintf_filtered (stream, ", ");
-
- if ((*elts == options->print_max - 1)
- && (i != upperbound))
- fprintf_filtered (stream, "...");
- }
- }
-}
+public:
+ /* Constructor. TYPE is the array type being printed, ADDRESS is the
+ address in target memory for the object of TYPE being printed. VAL is
+ the GDB value (of TYPE) being printed. STREAM is where to print to,
+ RECOURSE is passed through (and prevents infinite recursion), and
+ OPTIONS are the printing control options. */
+ explicit fortran_array_printer_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *val,
+ struct ui_file *stream,
+ int recurse,
+ const struct value_print_options *options)
+ : m_elts (0),
+ m_val (val),
+ m_stream (stream),
+ m_recurse (recurse),
+ m_options (options)
+ { /* Nothing. */ }
+
+ /* Called while iterating over the array bounds. When SHOULD_CONTINUE is
+ false then we must return false, as we have reached the end of the
+ array bounds for this dimension. However, we also return false if we
+ have printed too many elements (after printing '...'). In all other
+ cases, return true. */
+ bool continue_walking (bool should_continue)
+ {
+ bool cont = should_continue && (m_elts < m_options->print_max);
+ if (!cont && should_continue)
+ fprintf_filtered (m_stream, "...");
+ return cont;
+ }
+
+ /* Called when we start iterating over a dimension. If it's not the
+ inner most dimension then print an opening '(' character. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ {
+ if (dim != ndim)
+ fprintf_filtered (m_stream, "(");
+ }
+
+ /* Called when we finish processing a batch of items within a dimension
+ of the array. Depending on whether this is the inner most dimension
+ or not we print different things, but this is all about adding
+ separators between elements, and dimensions of the array. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ {
+ if (dim != ndim)
+ {
+ fprintf_filtered (m_stream, ")");
+ if (!last_p)
+ fprintf_filtered (m_stream, " ");
+ }
+ else
+ {
+ if (!last_p)
+ fprintf_filtered (m_stream, ", ");
+ }
+ }
+
+ /* Called to process an element of ELT_TYPE at offset ELT_OFF from the
+ start of the parent object. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ /* Extract the element value from the parent value. */
+ struct value *e_val
+ = value_from_component (m_val, elt_type, elt_off);
+ common_val_print (e_val, m_stream, m_recurse, m_options, current_language);
+ ++m_elts;
+ }
+
+private:
+ /* The number of elements printed so far. */
+ int m_elts;
+
+ /* The value from which we are printing elements. */
+ struct value *m_val;
+
+ /* The stream we should print too. */
+ struct ui_file *m_stream;
+
+ /* The recursion counter, passed through when we print each element. */
+ int m_recurse;
+
+ /* The print control options. Gives us the maximum number of elements to
+ print, and is passed through to each element that we print. */
+ const struct value_print_options *m_options = nullptr;
+};
-/* This function gets called to print an F77 array, we set up some
- stuff and then immediately call f77_print_array_1(). */
+/* This function gets called to print a Fortran array. */
static void
-f77_print_array (struct type *type, const gdb_byte *valaddr,
- int embedded_offset,
- CORE_ADDR address, struct ui_file *stream,
- int recurse,
- const struct value *val,
- const struct value_print_options *options)
+fortran_print_array (struct type *type, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ const struct value *val,
+ const struct value_print_options *options)
{
- int ndimensions;
- int elts = 0;
-
- ndimensions = calc_f77_array_dims (type);
-
- if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
- error (_("\
-Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
- ndimensions, MAX_FORTRAN_DIMS);
-
- f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
- address, stream, recurse, val, options, &elts);
+ fortran_array_walker<fortran_array_printer_impl> p
+ (type, address, (struct value *) val, stream, recurse, options);
+ p.walk ();
}
\f
@@ -238,8 +249,7 @@ f_value_print_inner (struct value *val, struct ui_file *stream, int recurse,
if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR)
{
fprintf_filtered (stream, "(");
- f77_print_array (type, valaddr, 0,
- address, stream, recurse, val, options);
+ fortran_print_array (type, address, stream, recurse, val, options);
fprintf_filtered (stream, ")");
}
else
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 43c05d344d0..ae7de7baf29 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -39,6 +39,7 @@
#include "dwarf2/loc.h"
#include "gdbcore.h"
#include "floatformat.h"
+#include "f-lang.h"
#include <algorithm>
/* Initialize BADNESS constants. */
@@ -2621,7 +2622,16 @@ resolve_dynamic_type_internal (struct type *type,
prop = TYPE_DATA_LOCATION (resolved_type);
if (prop != NULL
&& dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
- prop->set_const_val (value);
+ {
+ /* Start of Fortran hack. See comment in f-lang.h for what is going
+ on here.*/
+ if (current_language->la_language == language_fortran
+ && resolved_type->code () == TYPE_CODE_ARRAY)
+ value = fortran_adjust_dynamic_array_base_address_hack (resolved_type,
+ value);
+ /* End of Fortran hack. */
+ prop->set_const_val (value);
+ }
return resolved_type;
}
diff --git a/gdb/parse.c b/gdb/parse.c
index 4a15de8a499..359ab6211aa 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -924,6 +924,8 @@ operator_length_standard (const struct expression *expr, int endpos,
/* Assume the range has 2 arguments (low bound and high bound), then
reduce the argument count if any bounds are set to default. */
args = 2;
+ if (range_flag & RANGE_HAS_STRIDE)
+ ++args;
if (range_flag & RANGE_LOW_BOUND_DEFAULT)
--args;
if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
new file mode 100644
index 00000000000..2583cdecc94
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
@@ -0,0 +1,69 @@
+# Copyright 2020 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/> .
+
+# Test invalid element and slice array accesses.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "First Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Second Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+gdb_continue_to_breakpoint "First Breakpoint"
+
+# Access not yet allocated array.
+gdb_test "print other" " = <not allocated>"
+gdb_test "print other(0:4,2:3)" "array not allocated"
+gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)"
+
+# Access not yet associated pointer.
+gdb_test "print pointer2d" " = <not associated>"
+gdb_test "print pointer2d(1:2,1:2)" "array not associated"
+gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)"
+
+gdb_continue_to_breakpoint "Second Breakpoint"
+
+# Accessing just outside the arrays.
+foreach name {array pointer2d other} {
+ gdb_test "print $name (0:,:)" "array subscript out of bounds"
+ gdb_test "print $name (:11,:)" "array subscript out of bounds"
+ gdb_test "print $name (:,0:)" "array subscript out of bounds"
+ gdb_test "print $name (:,:11)" "array subscript out of bounds"
+
+ gdb_test "print $name (0,:)" "no such vector element"
+ gdb_test "print $name (11,:)" "no such vector element"
+ gdb_test "print $name (:,0)" "no such vector element"
+ gdb_test "print $name (:,11)" "no such vector element"
+}
+
+# Stride in the wrong direction.
+gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination"
+gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
new file mode 100644
index 00000000000..0f3d45ab8cd
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
@@ -0,0 +1,42 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Declare variables used in this test.
+ integer, dimension (1:10,1:10) :: array
+ integer, allocatable :: other (:, :)
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(1:10,1:10), target :: tarray
+
+ print *, "" ! First Breakpoint.
+
+ ! Allocate or associate any variables as needed.
+ allocate (other (1:10, 1:10))
+ pointer2d => tarray
+ array = 0
+
+ print *, "" ! Second Breakpoint.
+
+ ! All done. Deallocate.
+ deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
new file mode 100644
index 00000000000..05b4802c678
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
@@ -0,0 +1,111 @@
+# Copyright 2020 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/> .
+
+# Create a slice of an array, then take a slice of that slice.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Stop Here"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We're going to print some reasonably large arrays.
+gdb_test_no_output "set print elements unlimited"
+
+gdb_continue_to_breakpoint "Stop Here"
+
+# Print a slice, capture the convenience variable name created.
+set cmd "print array (1:10:2, 1:10:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ }
+}
+
+# Now check that we can correctly extract all the elements from this
+# slice.
+for { set j 1 } { $j < 6 } { incr j } {
+ for { set i 1 } { $i < 6 } { incr i } {
+ set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1]
+ gdb_test "print ${varname} ($i,$j)" " = $val"
+ }
+}
+
+# Now take a slice of the slice.
+gdb_test "print ${varname} (3:5, 3:5)" \
+ " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)"
+
+# Now take a different slice of a slice.
+set cmd "print ${varname} (1:5:2, 1:5:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Now take a slice from the slice, of a slice!
+set cmd "print ${varname} (1:3:2, 1:3:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# And again!
+set cmd "print ${varname} (1:2:2, 1:2:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Test taking a slice with stride of a string. This isn't actually
+# supported within gfortran (at least), but naturally drops out of how
+# GDB models arrays and strings in a similar way, so we may as well
+# test that this is still working.
+gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'"
+gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'"
+gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'"
+
+# Now test the memory requirements of taking a slice from an array.
+# The idea is that we shouldn't require more memory to extract a slice
+# than the size of the slice.
+#
+# This will only work if array repacking is turned on, otherwise GDB
+# will create the slice by generating a new type that sits over the
+# existing value in memory.
+gdb_test_no_output "set fortran repack-array-slices on"
+set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"]
+set slice_size [expr $element_size * 4]
+gdb_test_no_output "set max-value-size $slice_size"
+gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)"
+gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)"
+gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
new file mode 100644
index 00000000000..c3530f567d4
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
@@ -0,0 +1,96 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+ integer, dimension (1:10,1:11) :: array
+ character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz"
+
+ call fill_array_2d (array)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Stop Here
+
+ print *, array
+ print *, str
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index 31f95a3668d..ff00fae886f 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -18,6 +18,21 @@
# the subroutine. This should exercise GDB's ability to handle
# different strides for the different dimensions.
+# Testing GDB's ability to print array (and string) slices, including
+# slices that make use of array strides.
+#
+# In the Fortran code various arrays of different ranks are filled
+# with data, and slices are passed to a series of show functions.
+#
+# In this test script we break in each of the show functions, print
+# the array slice that was passed in, and then move up the stack to
+# the parent frame and check GDB can manually extract the same slice.
+#
+# This test also checks that the size of the array slice passed to the
+# function (so as extracted and described by the compiler and the
+# debug information) matches the size of the slice manually extracted
+# by GDB.
+
if {[skip_fortran_tests]} { return -1 }
standard_testfile ".f90"
@@ -28,44 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
return -1
}
-if ![fortran_runto_main] {
- untested "could not run to main"
- return -1
+# Takes the name of an array slice as used in the test source, and extracts
+# the base array name. For example: 'array (1,2)' becomes 'array'.
+proc array_slice_to_var { slice_str } {
+ regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname
+ return $varname
}
-gdb_breakpoint "show"
-gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
-
-set array_contents \
- [list \
- " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
- " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
- " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
- " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
- " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
- " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
-
-set message_strings \
- [list \
- " = 'array'" \
- " = 'array \\(1:5,1:5\\)'" \
- " = 'array \\(1:10:2,1:10:2\\)'" \
- " = 'array \\(1:10:3,1:10:2\\)'" \
- " = 'array \\(1:10:5,1:10:3\\)'" \
- " = 'other'" \
- " = 'other \\(-5:0, -2:0\\)'" \
- " = 'other \\(-5:4:2, -2:7:3\\)'" ]
-
-set i 0
-foreach result $array_contents msg $message_strings {
- incr i
- with_test_prefix "test $i" {
- gdb_continue_to_breakpoint "show"
- gdb_test "p array" $result
- gdb_test "p message" "$msg"
+proc run_test { repack } {
+ global binfile gdb_prompt
+
+ clean_restart ${binfile}
+
+ if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
}
+
+ gdb_test_no_output "set fortran repack-array-slices $repack"
+
+ # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+ gdb_breakpoint [gdb_get_line_number "Display Element"]
+ gdb_breakpoint [gdb_get_line_number "Display String"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"]
+ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+ # We're going to print some reasonably large arrays.
+ gdb_test_no_output "set print elements unlimited"
+
+ set found_final_breakpoint false
+
+ # We place a limit on the number of tests that can be run, just in
+ # case something goes wrong, and GDB gets stuck in an loop here.
+ set test_count 0
+ while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ set found_final_breakpoint false
+ set expected_result ""
+ set func_name ""
+ gdb_test_multiple "continue" "continue" {
+ -re ".*GDB = (\[^\r\n\]+)\r\n" {
+ set expected_result $expect_out(1,string)
+ exp_continue
+ }
+ -re "! Display Element" {
+ set func_name "show_elem"
+ exp_continue
+ }
+ -re "! Display String" {
+ set func_name "show_str"
+ exp_continue
+ }
+ -re "! Display Array Slice (.)D" {
+ set func_name "show_$expect_out(1,string)d"
+ exp_continue
+ }
+ -re "! Final Breakpoint" {
+ set found_final_breakpoint true
+ exp_continue
+ }
+ -re "$gdb_prompt $" {
+ # We're done.
+ }
+ }
+
+ if ($found_final_breakpoint) {
+ break
+ }
+
+ # We want to take a look at the line in the previous frame that
+ # called the current function. I couldn't find a better way of
+ # doing this than 'up', which will print the line, then 'down'
+ # again.
+ #
+ # I don't want to fill the log with passes for these up/down
+ # commands, so we don't report any. If something goes wrong then we
+ # should get a fail from gdb_test_multiple.
+ set array_slice_name ""
+ set unique_id ""
+ array unset replacement_vars
+ array set replacement_vars {}
+ gdb_test_multiple "up" "up" {
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ }
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ set unique_id $expect_out(2,string)
+ }
+ }
+ if {$unique_id != ""} {
+ set str ""
+ foreach v [split $unique_id ,] {
+ set val [get_integer_valueof "${v}" "??"\
+ "get variable '$v' for '$array_slice_name'"]
+ set replacement_vars($v) $val
+ if {$str != ""} {
+ set str "Str,"
+ }
+ set str "$str$v=$val"
+ }
+ set unique_id " $str"
+ }
+ gdb_test_multiple "down" "down" {
+ -re "\r\n$gdb_prompt $" {
+ # Don't issue a pass here.
+ }
+ }
+
+ # Check we have all the information we need to successfully run one
+ # of these tests.
+ if { $expected_result == "" } {
+ perror "failed to extract expected results"
+ return 0
+ }
+ if { $array_slice_name == "" } {
+ perror "failed to extract array slice name"
+ return 0
+ }
+
+ # Check GDB can correctly print the array slice that was passed into
+ # the current frame.
+ set pattern [string_to_regexp " = $expected_result"]
+ gdb_test "p array" "$pattern" \
+ "check value of '$array_slice_name'$unique_id"
+
+ # Get the size of the slice.
+ set size_in_show \
+ [get_integer_valueof "sizeof (array)" "show_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in show"]
+ set addr_in_show \
+ [get_hexadecimal_valueof "&array" "show_unknown" \
+ "get address '$array_slice_name'$unique_id in show"]
+
+ # Now move into the previous frame, and see if GDB can extract the
+ # array slice from the original parent object. Again, use of
+ # gdb_test_multiple to avoid filling the logs with unnecessary
+ # passes.
+ gdb_test_multiple "up" "up" {
+ -re "\r\n$gdb_prompt $" {
+ # Do nothing.
+ }
+ }
+
+ # Print the array slice, this will force GDB to manually extract the
+ # slice from the parent array.
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted"
+
+ # Get the size of the slice in the calling frame.
+ set size_in_parent \
+ [get_integer_valueof "sizeof ($array_slice_name)" \
+ "parent_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in parent"]
+
+ # Figure out the start and end addresses of the full array in the
+ # parent frame.
+ set full_var_name [array_slice_to_var $array_slice_name]
+ set start_addr [get_hexadecimal_valueof "&${full_var_name}" \
+ "start unknown"]
+ set end_addr [get_hexadecimal_valueof \
+ "(&${full_var_name}) + sizeof (${full_var_name})" \
+ "end unknown"]
+
+ # The Fortran compiler can choose to either send a descriptor that
+ # describes the array slice to the subroutine, or it can repack the
+ # slice into an array section and send that.
+ #
+ # We find the address range of the original array in the parent,
+ # and the address of the slice in the show function, if the
+ # address of the slice (from show) is in the range of the original
+ # array then repacking has not occurred, otherwise, the slice is
+ # outside of the parent, and repacking must have occurred.
+ #
+ # The goal here is to compare the sizes of the slice in show with
+ # the size of the slice extracted by GDB. So we can only compare
+ # sizes when GDB's repacking setting matches the repacking
+ # behaviour we got from the compiler.
+ if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \
+ == ($repack == "on") } {
+ gdb_assert {$size_in_show == $size_in_parent} \
+ "check sizes match"
+ } elseif { $repack == "off" } {
+ # GDB's repacking is off (so slices are left unpacked), but
+ # the compiler did pack this one. As a result we can't
+ # compare the sizes between the compiler's slice and GDB's
+ # slice.
+ verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared"
+ } else {
+ # Like the above, but the reverse, GDB's repacking is on, but
+ # the compiler didn't repack this slice.
+ verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared"
+ }
+
+ # If the array name we just tested included variable names, then
+ # test again with all the variables expanded.
+ if {$unique_id != ""} {
+ foreach v [array names replacement_vars] {
+ set val $replacement_vars($v)
+ set array_slice_name \
+ [regsub "\\y${v}\\y" $array_slice_name $val]
+ }
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded"
+ }
+ }
+ }
+
+ # Ensure we reached the final breakpoint. If more tests have been added
+ # to the test script, and this starts failing, then the safety 'while'
+ # loop above might need to be increased.
+ gdb_assert {$found_final_breakpoint} "ran all tests"
}
-gdb_continue_to_breakpoint "continue to Final Breakpoint"
+foreach_with_prefix repack { on off } {
+ run_test $repack
+}
diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
index a66fa6ba784..6d75a385699 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.f90
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -13,58 +13,368 @@
! 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 show (message, array)
- character (len=*) :: message
+subroutine show_elem (array)
+ integer :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = "
+ write(*, fmt="(I0)", advance="no") array
+ write(*, fmt="(A)", advance="yes") ""
+
+ print *, "" ! Display Element
+end subroutine show_elem
+
+subroutine show_str (array)
+ character (len=*) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+ write (*, fmt="(A)", advance="no") "GDB = '"
+ write (*, fmt="(A)", advance="no") array
+ write (*, fmt="(A)", advance="yes") "'"
+
+ print *, "" ! Display String
+end subroutine show_str
+
+subroutine show_1d (array)
+ integer, dimension (:) :: array
+
+ print *, "Array Contents:"
+ print *, ""
+
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ write(*, fmt="(i4)", advance="no") array (i)
+ end do
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (i > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+
+ print *, "" ! Display Array Slice 1D
+end subroutine show_1d
+
+subroutine show_2d (array)
integer, dimension (:,:) :: array
- print *, message
+ print *, "Array Contents:"
+ print *, ""
+
do i=LBOUND (array, 2), UBOUND (array, 2), 1
do j=LBOUND (array, 1), UBOUND (array, 1), 1
write(*, fmt="(i4)", advance="no") array (j, i)
end do
print *, ""
- end do
- print *, array
- print *, ""
+ end do
-end subroutine show
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
-program test
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (i > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (j > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 2D
+end subroutine show_2d
+
+subroutine show_3d (array)
+ integer, dimension (:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (i > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (j > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (k > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 3D
+end subroutine show_3d
+
+subroutine show_4d (array)
+ integer, dimension (:,:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ if (i > LBOUND (array, 4)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (j > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (k > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (l > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (l, k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 4D
+end subroutine show_4d
+!
+! Start of test program.
+!
+program test
interface
- subroutine show (message, array)
- character (len=*) :: message
+ subroutine show_str (array)
+ character (len=*) :: array
+ end subroutine show_str
+
+ subroutine show_1d (array)
+ integer, dimension (:) :: array
+ end subroutine show_1d
+
+ subroutine show_2d (array)
integer, dimension(:,:) :: array
- end subroutine show
+ end subroutine show_2d
+
+ subroutine show_3d (array)
+ integer, dimension(:,:,:) :: array
+ end subroutine show_3d
+
+ subroutine show_4d (array)
+ integer, dimension(:,:,:,:) :: array
+ end subroutine show_4d
end interface
+ ! Declare variables used in this test.
+ integer, dimension (-10:-1,-10:-2) :: neg_array
integer, dimension (1:10,1:10) :: array
integer, allocatable :: other (:, :)
+ character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz"
+ integer, dimension (-2:2,-2:2,-2:2) :: array3d
+ integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d
+ integer, dimension (10:20) :: array1d
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(-1:9,-1:9), target :: tarray
+ ! Allocate or associate any variables as needed.
allocate (other (-5:4, -2:7))
+ pointer2d => tarray
- do i=LBOUND (array, 2), UBOUND (array, 2), 1
- do j=LBOUND (array, 1), UBOUND (array, 1), 1
- array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
- end do
- end do
+ ! Fill arrays with contents ready for testing.
+ call fill_array_1d (array1d)
+
+ call fill_array_2d (neg_array)
+ call fill_array_2d (array)
+ call fill_array_2d (other)
+ call fill_array_2d (tarray)
+
+ call fill_array_3d (array3d)
+ call fill_array_4d (array4d)
+
+ ! The tests. Each call to a show_* function must have a unique set
+ ! of arguments as GDB uses the arguments are part of the test name
+ ! string, so duplicate arguments will result in duplicate test
+ ! names.
+ !
+ ! If a show_* line ends with VARS=... where '...' is a comma
+ ! separated list of variable names, these variables are assumed to
+ ! be part of the call line, and will be expanded by the test script,
+ ! for example:
+ !
+ ! do x=1,9,1
+ ! do y=x,10,1
+ ! call show_1d (some_array (x,y)) ! VARS=x,y
+ ! end do
+ ! end do
+ !
+ ! In this example the test script will automatically expand 'x' and
+ ! 'y' in order to better test different aspects of GDB. Do take
+ ! care, the expansion is not very "smart", so try to avoid clashing
+ ! with other text on the line, in the example above, avoid variables
+ ! named 'some' or 'array', as these will likely clash with
+ ! 'some_array'.
+ call show_str (str_1)
+ call show_str (str_1 (1:20))
+ call show_str (str_1 (10:20))
- do i=LBOUND (other, 2), UBOUND (other, 2), 1
- do j=LBOUND (other, 1), UBOUND (other, 1), 1
- other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
+ call show_elem (array1d (11))
+ call show_elem (pointer2d (2,3))
+
+ call show_1d (array1d)
+ call show_1d (array1d (13:17))
+ call show_1d (array1d (17:13:-1))
+ call show_1d (array (1:5,1))
+ call show_1d (array4d (1,7,3,:))
+ call show_1d (pointer2d (-1:3, 2))
+ call show_1d (pointer2d (-1, 2:4))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_1d ((array (1:5,1)))
+
+ call show_2d (pointer2d)
+ call show_2d (array)
+ call show_2d (array (1:5,1:5))
+ do i=1,10,2
+ do j=1,10,3
+ call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j
+ call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j
end do
end do
+ call show_2d (array (6:2:-1,3:9))
+ call show_2d (array (1:10:2, 1:10:2))
+ call show_2d (other)
+ call show_2d (other (-5:0, -2:0))
+ call show_2d (other (-5:4:2, -2:7:3))
+ call show_2d (neg_array)
+ call show_2d (neg_array (-10:-3,-8:-4:2))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_2d ((array (1:10:3, 1:10:2)))
+ call show_2d ((neg_array (-10:-3,-8:-4:2)))
- call show ("array", array)
- call show ("array (1:5,1:5)", array (1:5,1:5))
- call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
- call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
- call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
+ call show_3d (array3d)
+ call show_3d (array3d(-1:1,-1:1,-1:1))
+ call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1))
- call show ("other", other)
- call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
- call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1)))
+ call show_4d (array4d)
+ call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1))
+ call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1)))
+
+ ! All done. Deallocate.
deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
end program test
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
index 04296ac80c9..0ab74fbbe90 100644
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -44,7 +44,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
gdb_test "print sizeof(vla1(3,2,1))" "4" \
"print sizeof element from allocated vla1"
-gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
+gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
"print sizeof sliced vla1"
# Try to access values in undefined pointer to VLA (dangling)
@@ -61,7 +61,7 @@ gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
gdb_test "print sizeof(pvla(3,2,1))" "4" \
"print sizeof element from associated pvla"
-gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
+gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv4 3/3] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-09-28 9:40 ` [PATCHv4 3/3] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
@ 2020-09-28 9:52 ` Eli Zaretskii
0 siblings, 0 replies; 62+ messages in thread
From: Eli Zaretskii @ 2020-09-28 9:52 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
> From: Andrew Burgess <andrew.burgess@embecosm.com>
> Date: Mon, 28 Sep 2020 10:40:49 +0100
>
> gdb/ChangeLog:
>
> * Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
> * NEWS: Mention new options.
> * expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE.
> * expression.h (enum range_type): Add RANGE_HAS_STRIDE.
> * f-array-walker.h: New file.
> * f-exp.y (arglist): Allow for a series of subranges.
> (subrange): Add cases for subranges with strides.
> * f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
> (repack_array_slices): New static global.
> (show_repack_array_slices): New function.
> (fortran_array_slicing_debug): New static global.
> (show_fortran_array_slicing_debug): New function.
> (value_f90_subarray): Delete.
> (skip_undetermined_arglist): Delete.
> (class fortran_array_repacker_base_impl): New class.
> (class fortran_lazy_array_repacker_impl): New class.
> (class fortran_array_repacker_impl): New class.
> (fortran_value_subarray): Complete rewrite.
> (set_fortran_list): New static global.
> (show_fortran_list): Likewise.
> (_initialize_f_language): Register new commands.
> (fortran_adjust_dynamic_array_base_address_hack): New function.
> * f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
> Declare.
> * f-valprint.c: Include 'f-array-walker.h'.
> (class fortran_array_printer_impl): New class.
> (f77_print_array_1): Delete.
> (f77_print_array): Delete.
> (fortran_print_array): New.
> (f_value_print_inner): Update to call fortran_print_array.
> * gdbtypes.c: Include 'f-lang.h'.
> (resolve_dynamic_type_internal): Call
> fortran_adjust_dynamic_array_base_address_hack.
> * parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE.
>
> gdb/testsuite/ChangeLog:
>
> * gdb.fortran/array-slices-bad.exp: New file.
> * gdb.fortran/array-slices-bad.f90: New file.
> * gdb.fortran/array-slices-sub-slices.exp: New file.
> * gdb.fortran/array-slices-sub-slices.f90: New file.
> * gdb.fortran/array-slices.exp: Rewrite tests.
> * gdb.fortran/array-slices.f90: Rewrite tests.
> * gdb.fortran/vla-sizeof.exp: Correct expected results.
>
> gdb/doc/ChangeLog:
>
> * gdb.texinfo (Debugging Output): Document 'set/show debug
> fotran-array-slicing'.
> (Special Fortran Commands): Document 'set/show fortran
> repack-array-slices'.
OK for the documentation parts.
Thanks.
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv5 0/4] Fortran Array Slicing and Striding Support
2020-09-28 9:40 ` [PATCHv4 0/3] Fortran Array Slicing and Striding Support Andrew Burgess
` (2 preceding siblings ...)
2020-09-28 9:40 ` [PATCHv4 3/3] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
@ 2020-10-11 18:12 ` Andrew Burgess
2020-10-11 18:12 ` [PATCHv5 1/4] gdb: Convert enum range_type to a bit field enum Andrew Burgess
` (3 more replies)
3 siblings, 4 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-10-11 18:12 UTC (permalink / raw)
To: gdb-patches
Ping!
Since v4:
- No documentation changes!
- No changes in patches #1 and #2.
- Patch #3 is now a small patch containing only the changes to the
Fortan array parsing code, and updates to the expression dumping
code to match. I'm hoping that splitting this small piece of work
out might get it reviewed, in which case I think I can justify
merging patches #1, #2, and #3.
- Patch #4 contains the bulk of the interesting work, this is the
patch that really needs review, especially the change in
gdbtypes.c.
All feedback welcome.
Thanks,
Andrew
---
Andrew Burgess (4):
gdb: Convert enum range_type to a bit field enum
gdb: rename 'enum range_type' to 'enum range_flag'
gdb/fortran: add support for parsing array strides in expressions
gdb/fortran: Add support for Fortran array slices at the GDB prompt
gdb/ChangeLog | 77 ++
gdb/Makefile.in | 1 +
gdb/NEWS | 13 +
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 32 +
gdb/expprint.c | 61 +-
gdb/expression.h | 33 +-
gdb/f-array-walker.h | 255 +++++++
gdb/f-exp.y | 52 +-
gdb/f-lang.c | 704 ++++++++++++++++--
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 190 ++---
gdb/gdbtypes.c | 12 +-
gdb/parse.c | 28 +-
gdb/rust-exp.y | 21 +-
gdb/rust-lang.c | 29 +-
gdb/testsuite/ChangeLog | 14 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 ++
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 267 ++++++-
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
24 files changed, 2171 insertions(+), 330 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv5 1/4] gdb: Convert enum range_type to a bit field enum
2020-10-11 18:12 ` [PATCHv5 0/4] Fortran Array Slicing and Striding Support Andrew Burgess
@ 2020-10-11 18:12 ` Andrew Burgess
2020-10-20 20:16 ` Tom Tromey
2020-10-11 18:12 ` [PATCHv5 2/4] gdb: rename 'enum range_type' to 'enum range_flag' Andrew Burgess
` (2 subsequent siblings)
3 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-10-11 18:12 UTC (permalink / raw)
To: gdb-patches
The expression range_type enum represents the following ideas:
- Lower bound is set to default,
- Upper bound is set to default,
- Upper bound is exclusive.
There are currently 6 entries in the enum to represent the combination
of all those ideas.
In a future commit I'd like to add stride information to the range,
this could in theory appear with any of the existing enum entries, so
this would take us to 12 enum entries.
This feels like its getting a little out of hand, so in this commit I
switch the range_type enum over to being a flags style enum. There's
one entry to represent no flags being set, then 3 flags to represent
the 3 ideas above. Adding stride information will require adding only
one more enum flag.
I've then gone through and updated the code to handle this change.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* expprint.c (print_subexp_standard): Update to reflect changes to
enum range_type.
(dump_subexp_body_standard): Likewise.
* expression.h (enum range_type): Convert to a bit field enum, and
make the enum unsigned.
* f-exp.y (subrange): Update to reflect changes to enum
range_type.
* f-lang.c (value_f90_subarray): Likewise.
* parse.c (operator_length_standard): Likewise.
* rust-exp.y (rust_parser::convert_ast_to_expression): Likewise.
* rust-lang.c (rust_range): Likewise.
(rust_compute_range): Likewise.
(rust_subscript): Likewise.
---
gdb/ChangeLog | 16 ++++++++++++++++
gdb/expprint.c | 49 ++++++++++++++----------------------------------
gdb/expression.h | 30 ++++++++++++++---------------
gdb/f-exp.y | 14 +++++++++-----
gdb/f-lang.c | 4 ++--
gdb/parse.c | 22 +++++++---------------
gdb/rust-exp.y | 21 +++++++++++++--------
gdb/rust-lang.c | 25 +++++++++++-------------
8 files changed, 87 insertions(+), 94 deletions(-)
diff --git a/gdb/expprint.c b/gdb/expprint.c
index d7d7c871bdd..bdb69a92f75 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -585,17 +585,13 @@ print_subexp_standard (struct expression *exp, int *pos,
longest_to_int (exp->elts[pc + 1].longconst);
*pos += 2;
- if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE
- || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)
+ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
fputs_filtered ("EXCLUSIVE_", stream);
fputs_filtered ("RANGE(", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
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 & RANGE_HIGH_BOUND_DEFAULT))
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
@@ -1116,36 +1112,19 @@ dump_subexp_body_standard (struct expression *exp,
longest_to_int (exp->elts[elt].longconst);
elt += 2;
- switch (range_type)
- {
- case BOTH_BOUND_DEFAULT:
- fputs_filtered ("Range '..'", stream);
- break;
- case LOW_BOUND_DEFAULT:
- fputs_filtered ("Range '..EXP'", stream);
- break;
- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- fputs_filtered ("ExclusiveRange '..EXP'", stream);
- break;
- case HIGH_BOUND_DEFAULT:
- fputs_filtered ("Range 'EXP..'", stream);
- break;
- case NONE_BOUND_DEFAULT:
- fputs_filtered ("Range 'EXP..EXP'", stream);
- break;
- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
- break;
- default:
- fputs_filtered ("Invalid Range!", stream);
- break;
- }
+ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
+ fputs_filtered ("Exclusive", stream);
+ fputs_filtered ("Range '", stream);
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ fputs_filtered ("EXP", stream);
+ fputs_filtered ("..", stream);
+ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ fputs_filtered ("EXP", stream);
+ fputs_filtered ("'", stream);
- if (range_type == HIGH_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
- if (range_type == LOW_BOUND_DEFAULT
- || range_type == NONE_BOUND_DEFAULT)
+ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 5af10f05db1..6bd3fc0c3c5 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -185,22 +185,22 @@ extern void dump_prefix_expression (struct expression *, struct ui_file *);
or inclusive. So we have six sorts of subrange. This enumeration
type is to identify this. */
-enum range_type
+enum range_type : unsigned
{
- /* Neither the low nor the high bound was given -- so this refers to
- the entire available range. */
- BOTH_BOUND_DEFAULT,
- /* The low bound was not given and the high bound is inclusive. */
- LOW_BOUND_DEFAULT,
- /* The high bound was not given and the low bound in inclusive. */
- HIGH_BOUND_DEFAULT,
- /* Both bounds were given and both are inclusive. */
- NONE_BOUND_DEFAULT,
- /* The low bound was not given and the high bound is exclusive. */
- NONE_BOUND_DEFAULT_EXCLUSIVE,
- /* Both bounds were given. The low bound is inclusive and the high
- bound is exclusive. */
- LOW_BOUND_DEFAULT_EXCLUSIVE,
+ /* This is a standard range. Both the lower and upper bounds are
+ defined, and the bounds are inclusive. */
+ RANGE_STANDARD = 0,
+
+ /* The low bound was not given. */
+ RANGE_LOW_BOUND_DEFAULT = 1 << 0,
+
+ /* The high bound was not given. */
+ RANGE_HIGH_BOUND_DEFAULT = 1 << 1,
+
+ /* The high bound of this range is exclusive. */
+ RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
};
+DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
+
#endif /* !defined (EXPRESSION_H) */
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 0ccb3c68d3e..a3314082d90 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -287,26 +287,30 @@ 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, RANGE_STANDARD);
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,
+ RANGE_HIGH_BOUND_DEFAULT);
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,
+ RANGE_LOW_BOUND_DEFAULT);
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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HIGH_BOUND_DEFAULT));
write_exp_elt_opcode (pstate, OP_RANGE); }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index e13097baee4..fcab973f874 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -131,12 +131,12 @@ value_f90_subarray (struct value *array,
*pos += 3;
- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ if (range_type & RANGE_LOW_BOUND_DEFAULT)
low_bound = range->bounds ()->low.const_val ();
else
low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+ if (range_type & RANGE_HIGH_BOUND_DEFAULT)
high_bound = range->bounds ()->high.const_val ();
else
high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
diff --git a/gdb/parse.c b/gdb/parse.c
index 6b9541bfdc2..6661fba81d7 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -921,21 +921,13 @@ operator_length_standard (const struct expression *expr, int endpos,
range_type = (enum range_type)
longest_to_int (expr->elts[endpos - 2].longconst);
- switch (range_type)
- {
- case LOW_BOUND_DEFAULT:
- case LOW_BOUND_DEFAULT_EXCLUSIVE:
- case HIGH_BOUND_DEFAULT:
- args = 1;
- break;
- case BOTH_BOUND_DEFAULT:
- args = 0;
- break;
- case NONE_BOUND_DEFAULT:
- case NONE_BOUND_DEFAULT_EXCLUSIVE:
- args = 2;
- break;
- }
+ /* Assume the range has 2 arguments (low bound and high bound), then
+ reduce the argument count if any bounds are set to default. */
+ args = 2;
+ if (range_type & RANGE_LOW_BOUND_DEFAULT)
+ --args;
+ if (range_type & RANGE_HIGH_BOUND_DEFAULT)
+ --args;
break;
diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
index db888098c4a..ea9fbdc25fb 100644
--- a/gdb/rust-exp.y
+++ b/gdb/rust-exp.y
@@ -2492,24 +2492,29 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
case OP_RANGE:
{
- enum range_type kind = BOTH_BOUND_DEFAULT;
+ enum range_type kind = (RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_LOW_BOUND_DEFAULT);
if (operation->left.op != NULL)
{
convert_ast_to_expression (operation->left.op, top);
- kind = HIGH_BOUND_DEFAULT;
+ kind &= ~RANGE_LOW_BOUND_DEFAULT;
}
if (operation->right.op != NULL)
{
convert_ast_to_expression (operation->right.op, top);
- if (kind == BOTH_BOUND_DEFAULT)
- kind = (operation->inclusive
- ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE);
+ if (kind == (RANGE_HIGH_BOUND_DEFAULT | RANGE_LOW_BOUND_DEFAULT))
+ {
+ kind = RANGE_LOW_BOUND_DEFAULT;
+ if (!operation->inclusive)
+ kind |= RANGE_HIGH_BOUND_EXCLUSIVE;
+ }
else
{
- gdb_assert (kind == HIGH_BOUND_DEFAULT);
- kind = (operation->inclusive
- ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE);
+ gdb_assert (kind == RANGE_HIGH_BOUND_DEFAULT);
+ kind = RANGE_STANDARD;
+ if (!operation->inclusive)
+ kind |= RANGE_HIGH_BOUND_EXCLUSIVE;
}
}
else
diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
index f7c762eb640..820ebb92c43 100644
--- a/gdb/rust-lang.c
+++ b/gdb/rust-lang.c
@@ -1077,13 +1077,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
*pos += 3;
- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT
- || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(kind & RANGE_LOW_BOUND_DEFAULT))
low = evaluate_subexp (nullptr, exp, pos, noside);
- if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE
- || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
+ if (!(kind & RANGE_HIGH_BOUND_DEFAULT))
high = evaluate_subexp (nullptr, exp, pos, noside);
- bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT);
+ bool inclusive = !(kind & RANGE_HIGH_BOUND_EXCLUSIVE);
if (noside == EVAL_SKIP)
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
@@ -1166,13 +1164,13 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
static void
rust_compute_range (struct type *type, struct value *range,
LONGEST *low, LONGEST *high,
- enum range_type *kind)
+ range_types *kind)
{
int i;
*low = 0;
*high = 0;
- *kind = BOTH_BOUND_DEFAULT;
+ *kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
if (type->num_fields () == 0)
return;
@@ -1180,15 +1178,15 @@ 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 = RANGE_HIGH_BOUND_DEFAULT;
*low = value_as_long (value_field (range, 0));
++i;
}
if (type->num_fields () > i
&& strcmp (TYPE_FIELD_NAME (type, i), "end") == 0)
{
- *kind = (*kind == BOTH_BOUND_DEFAULT
- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
+ *kind = (*kind == (RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT)
+ ? RANGE_LOW_BOUND_DEFAULT : RANGE_STANDARD);
*high = value_as_long (value_field (range, i));
if (rust_inclusive_range_type_p (type))
@@ -1206,7 +1204,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;
+ range_types kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
LONGEST high = 0;
int want_slice = 0;
@@ -1303,8 +1301,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
else
error (_("Cannot subscript non-array type"));
- if (want_slice
- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT))
+ if (want_slice && (kind & RANGE_LOW_BOUND_DEFAULT))
low = low_bound;
if (low < 0)
error (_("Index less than zero"));
@@ -1322,7 +1319,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 & RANGE_HIGH_BOUND_DEFAULT)
high = high_bound;
if (high < 0)
error (_("High index less than zero"));
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv5 2/4] gdb: rename 'enum range_type' to 'enum range_flag'
2020-10-11 18:12 ` [PATCHv5 0/4] Fortran Array Slicing and Striding Support Andrew Burgess
2020-10-11 18:12 ` [PATCHv5 1/4] gdb: Convert enum range_type to a bit field enum Andrew Burgess
@ 2020-10-11 18:12 ` Andrew Burgess
2020-10-20 20:16 ` Tom Tromey
2020-10-11 18:12 ` [PATCHv5 3/4] gdb/fortran: add support for parsing array strides in expressions Andrew Burgess
2020-10-11 18:12 ` [PATCHv5 4/4] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
3 siblings, 1 reply; 62+ messages in thread
From: Andrew Burgess @ 2020-10-11 18:12 UTC (permalink / raw)
To: gdb-patches
To avoid confusion with other parts of GDB relating to types and
ranges, rename this enum to make it clearer that it is a set of
individual flags rather than an enumeration of different types of
range.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* expprint.c (print_subexp_standard): Change enum range_type to
range_flag and rename variables to match.
(dump_subexp_body_standard): Likewise.
* expression.h (enum range_type): Rename to...
(enum range_flag): ...this.
(range_types): Rename to...
(range_flags): ...this.
* f-lang.c (value_f90_subarray): Change enum range_type to
range_flag and rename variables to match.
* parse.c (operator_length_standard): Likewise.
* rust-exp.y (rust_parser::convert_ast_to_expression): Change enum
range_type to range_flag.
* rust-lang.c (rust_evaluate_funcall): Likewise.
(rust_range): Likewise.
(rust_compute_range): Likewise.
(rust_subscript): Likewise.
---
gdb/ChangeLog | 19 +++++++++++++++++++
gdb/expprint.c | 24 ++++++++++++------------
gdb/expression.h | 4 ++--
gdb/f-lang.c | 8 ++++----
gdb/parse.c | 8 ++++----
gdb/rust-exp.y | 2 +-
gdb/rust-lang.c | 8 ++++----
7 files changed, 46 insertions(+), 27 deletions(-)
diff --git a/gdb/expprint.c b/gdb/expprint.c
index bdb69a92f75..2dee2bb1932 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -579,19 +579,19 @@ print_subexp_standard (struct expression *exp, int *pos,
case OP_RANGE:
{
- enum range_type range_type;
+ enum range_flag range_flag;
- range_type = (enum range_type)
+ range_flag = (enum range_flag)
longest_to_int (exp->elts[pc + 1].longconst);
*pos += 2;
- if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
+ if (range_flag & RANGE_HIGH_BOUND_EXCLUSIVE)
fputs_filtered ("EXCLUSIVE_", stream);
fputs_filtered ("RANGE(", stream);
- if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_LOW_BOUND_DEFAULT))
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered ("..", stream);
- if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
@@ -1106,25 +1106,25 @@ dump_subexp_body_standard (struct expression *exp,
break;
case OP_RANGE:
{
- enum range_type range_type;
+ enum range_flag range_flag;
- range_type = (enum range_type)
+ range_flag = (enum range_flag)
longest_to_int (exp->elts[elt].longconst);
elt += 2;
- if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE)
+ if (range_flag & RANGE_HIGH_BOUND_EXCLUSIVE)
fputs_filtered ("Exclusive", stream);
fputs_filtered ("Range '", stream);
- if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_LOW_BOUND_DEFAULT))
fputs_filtered ("EXP", stream);
fputs_filtered ("..", stream);
- if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
fputs_filtered ("EXP", stream);
fputs_filtered ("'", stream);
- if (!(range_type & RANGE_LOW_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
- if (!(range_type & RANGE_HIGH_BOUND_DEFAULT))
+ if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index 6bd3fc0c3c5..fd483e5f277 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -185,7 +185,7 @@ extern void dump_prefix_expression (struct expression *, struct ui_file *);
or inclusive. So we have six sorts of subrange. This enumeration
type is to identify this. */
-enum range_type : unsigned
+enum range_flag : unsigned
{
/* This is a standard range. Both the lower and upper bounds are
defined, and the bounds are inclusive. */
@@ -201,6 +201,6 @@ enum range_type : unsigned
RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
};
-DEF_ENUM_FLAGS_TYPE (enum range_type, range_types);
+DEF_ENUM_FLAGS_TYPE (enum range_flag, range_flags);
#endif /* !defined (EXPRESSION_H) */
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index fcab973f874..37d05b27653 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -126,17 +126,17 @@ value_f90_subarray (struct value *array,
int pc = (*pos) + 1;
LONGEST low_bound, high_bound;
struct type *range = check_typedef (value_type (array)->index_type ());
- enum range_type range_type
- = (enum range_type) longest_to_int (exp->elts[pc].longconst);
+ enum range_flag range_flag
+ = (enum range_flag) longest_to_int (exp->elts[pc].longconst);
*pos += 3;
- if (range_type & RANGE_LOW_BOUND_DEFAULT)
+ if (range_flag & RANGE_LOW_BOUND_DEFAULT)
low_bound = range->bounds ()->low.const_val ();
else
low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
- if (range_type & RANGE_HIGH_BOUND_DEFAULT)
+ if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
high_bound = range->bounds ()->high.const_val ();
else
high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
diff --git a/gdb/parse.c b/gdb/parse.c
index 6661fba81d7..4a15de8a499 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -774,7 +774,7 @@ operator_length_standard (const struct expression *expr, int endpos,
{
int oplen = 1;
int args = 0;
- enum range_type range_type;
+ enum range_flag range_flag;
int i;
if (endpos < 1)
@@ -918,15 +918,15 @@ operator_length_standard (const struct expression *expr, int endpos,
case OP_RANGE:
oplen = 3;
- range_type = (enum range_type)
+ range_flag = (enum range_flag)
longest_to_int (expr->elts[endpos - 2].longconst);
/* Assume the range has 2 arguments (low bound and high bound), then
reduce the argument count if any bounds are set to default. */
args = 2;
- if (range_type & RANGE_LOW_BOUND_DEFAULT)
+ if (range_flag & RANGE_LOW_BOUND_DEFAULT)
--args;
- if (range_type & RANGE_HIGH_BOUND_DEFAULT)
+ if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
--args;
break;
diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
index ea9fbdc25fb..802ccc0a7f6 100644
--- a/gdb/rust-exp.y
+++ b/gdb/rust-exp.y
@@ -2492,7 +2492,7 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
case OP_RANGE:
{
- enum range_type kind = (RANGE_HIGH_BOUND_DEFAULT
+ enum range_flag kind = (RANGE_HIGH_BOUND_DEFAULT
| RANGE_LOW_BOUND_DEFAULT);
if (operation->left.op != NULL)
diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
index 820ebb92c43..86e7289c5e6 100644
--- a/gdb/rust-lang.c
+++ b/gdb/rust-lang.c
@@ -1065,7 +1065,6 @@ rust_evaluate_funcall (struct expression *exp, int *pos, enum noside noside)
static struct value *
rust_range (struct expression *exp, int *pos, enum noside noside)
{
- enum range_type kind;
struct value *low = NULL, *high = NULL;
struct value *addrval, *result;
CORE_ADDR addr;
@@ -1074,7 +1073,8 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
struct type *temp_type;
const char *name;
- kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
+ auto kind
+ = (enum range_flag) longest_to_int (exp->elts[*pos + 1].longconst);
*pos += 3;
if (!(kind & RANGE_LOW_BOUND_DEFAULT))
@@ -1164,7 +1164,7 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
static void
rust_compute_range (struct type *type, struct value *range,
LONGEST *low, LONGEST *high,
- range_types *kind)
+ range_flags *kind)
{
int i;
@@ -1204,7 +1204,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
struct type *rhstype;
LONGEST low, high_bound;
/* Initialized to appease the compiler. */
- range_types kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
+ range_flags kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT;
LONGEST high = 0;
int want_slice = 0;
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv5 3/4] gdb/fortran: add support for parsing array strides in expressions
2020-10-11 18:12 ` [PATCHv5 0/4] Fortran Array Slicing and Striding Support Andrew Burgess
2020-10-11 18:12 ` [PATCHv5 1/4] gdb: Convert enum range_type to a bit field enum Andrew Burgess
2020-10-11 18:12 ` [PATCHv5 2/4] gdb: rename 'enum range_type' to 'enum range_flag' Andrew Burgess
@ 2020-10-11 18:12 ` Andrew Burgess
2020-10-12 13:21 ` Simon Marchi
` (2 more replies)
2020-10-11 18:12 ` [PATCHv5 4/4] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
3 siblings, 3 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-10-11 18:12 UTC (permalink / raw)
To: gdb-patches
With this commit GDB now understands the syntax of Fortran array
strides, a user can type an expression including an array stride, but
they will only get an error informing them that array strides are not
supported.
This alone is an improvement on what we had before in GDB, better to
give the user a helpful message that a particular feature is not
supported than to just claim a syntax error.
Before:
(gdb) p array (1:10:2, 2:10:2)
A syntax error in expression, near `:2, 2:10:2)'.
Now:
(gdb) p array (1:10:2, 2:10:2)
Fortran array strides are not currently supported
Later commits will allow GDB to handle array strides correctly.
gdb/ChangeLog:
* expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE.
* expression.h (enum range_type): Add RANGE_HAS_STRIDE.
* f-exp.y (arglist): Allow for a series of subranges.
(subrange): Add cases for subranges with strides.
* f-lang.c (value_f90_subarray): Catch use of array strides and
throw an error.
* parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE.
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices.exp: Add a new test.
---
gdb/ChangeLog | 10 ++++++
gdb/expprint.c | 4 +++
gdb/expression.h | 3 ++
gdb/f-exp.y | 38 ++++++++++++++++++++++
gdb/f-lang.c | 10 +++++-
gdb/parse.c | 2 ++
gdb/testsuite/ChangeLog | 4 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 15 +++++++++
8 files changed, 85 insertions(+), 1 deletion(-)
diff --git a/gdb/expprint.c b/gdb/expprint.c
index 2dee2bb1932..a14eeb00f19 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -1120,12 +1120,16 @@ dump_subexp_body_standard (struct expression *exp,
fputs_filtered ("..", stream);
if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
fputs_filtered ("EXP", stream);
+ if (range_flag & RANGE_HAS_STRIDE)
+ fputs_filtered (":EXP", stream);
fputs_filtered ("'", stream);
if (!(range_flag & RANGE_LOW_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
elt = dump_subexp (exp, stream, elt);
+ if (range_flag & RANGE_HAS_STRIDE)
+ elt = dump_subexp (exp, stream, elt);
}
break;
diff --git a/gdb/expression.h b/gdb/expression.h
index fd483e5f277..8de712310ec 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -199,6 +199,9 @@ enum range_flag : unsigned
/* The high bound of this range is exclusive. */
RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
+
+ /* The range has a stride. */
+ RANGE_HAS_STRIDE = 1 << 3,
};
DEF_ENUM_FLAGS_TYPE (enum range_flag, range_flags);
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index a3314082d90..f227690cea6 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -284,6 +284,10 @@ arglist : arglist ',' exp %prec ABOVE_COMMA
{ pstate->arglist_len++; }
;
+arglist : arglist ',' subrange %prec ABOVE_COMMA
+ { pstate->arglist_len++; }
+ ;
+
/* There are four sorts of subrange types in F90. */
subrange: exp ':' exp %prec ABOVE_COMMA
@@ -314,6 +318,40 @@ subrange: ':' %prec ABOVE_COMMA
write_exp_elt_opcode (pstate, OP_RANGE); }
;
+/* And each of the four subrange types can also have a stride. */
+subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (pstate, OP_RANGE);
+ write_exp_elt_longcst (pstate,
+ (RANGE_STANDARD
+ | RANGE_HAS_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,
+ (RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_HAS_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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HAS_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,
+ (RANGE_LOW_BOUND_DEFAULT
+ | RANGE_HIGH_BOUND_DEFAULT
+ | RANGE_HAS_STRIDE));
+ write_exp_elt_opcode (pstate, OP_RANGE); }
+ ;
+
complexnum: exp ',' exp
{ }
;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 37d05b27653..b888e3d4122 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -124,7 +124,7 @@ value_f90_subarray (struct value *array,
struct expression *exp, int *pos, enum noside noside)
{
int pc = (*pos) + 1;
- LONGEST low_bound, high_bound;
+ LONGEST low_bound, high_bound, stride;
struct type *range = check_typedef (value_type (array)->index_type ());
enum range_flag range_flag
= (enum range_flag) longest_to_int (exp->elts[pc].longconst);
@@ -141,6 +141,14 @@ value_f90_subarray (struct value *array,
else
high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
+ stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ stride = 1;
+
+ if (stride != 1)
+ error (_("Fortran array strides are not currently supported"));
+
return value_slice (array, low_bound, high_bound - low_bound + 1);
}
diff --git a/gdb/parse.c b/gdb/parse.c
index 4a15de8a499..359ab6211aa 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -924,6 +924,8 @@ operator_length_standard (const struct expression *expr, int endpos,
/* Assume the range has 2 arguments (low bound and high bound), then
reduce the argument count if any bounds are set to default. */
args = 2;
+ if (range_flag & RANGE_HAS_STRIDE)
+ ++args;
if (range_flag & RANGE_LOW_BOUND_DEFAULT)
--args;
if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index 31f95a3668d..a0e1d1fe8fc 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -69,3 +69,18 @@ foreach result $array_contents msg $message_strings {
}
gdb_continue_to_breakpoint "continue to Final Breakpoint"
+
+# Next test that asking for an array with stride at the CLI gives an
+# error.
+clean_restart ${testfile}
+
+if ![fortran_runto_main] then {
+ perror "couldn't run to main"
+ continue
+}
+
+gdb_breakpoint "show"
+gdb_continue_to_breakpoint "show"
+gdb_test "up" ".*"
+gdb_test "p array (1:10:2, 1:10:2)" \
+ "Fortran array strides are not currently supported"
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv5 4/4] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-10-11 18:12 ` [PATCHv5 0/4] Fortran Array Slicing and Striding Support Andrew Burgess
` (2 preceding siblings ...)
2020-10-11 18:12 ` [PATCHv5 3/4] gdb/fortran: add support for parsing array strides in expressions Andrew Burgess
@ 2020-10-11 18:12 ` Andrew Burgess
2020-10-12 14:10 ` Simon Marchi
` (2 more replies)
3 siblings, 3 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-10-11 18:12 UTC (permalink / raw)
To: gdb-patches
This commit brings array slice support to GDB.
WARNING: This patch contains a rather big hack which is limited to
Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More
details on this below.
This patch rewrites two areas of GDB's Fortran support, the code to
extract an array slice, and the code to print an array.
After this commit a user can, from the GDB prompt, ask for a slice of
a Fortran array and should get the correct result back. Slices can
(optionally) have the lower bound, upper bound, and a stride
specified. Slices can also have a negative stride.
Fortran has the concept of repacking array slices. Within a compiled
Fortran program if a user passes a non-contiguous array slice to a
function then the compiler may have to repack the slice, this involves
copying the elements of the slice to a new area of memory before the
call, and copying the elements back to the original array after the
call. Whether repacking occurs will depend on which version of
Fortran is being used, and what type of function is being called.
This commit adds support for both packed, and unpacked array slicing,
with the default being unpacked.
With an unpacked array slice, when the user asks for a slice of an
array GDB creates a new type that accurately describes where the
elements of the slice can be found within the original array, a
value of this type is then returned to the user. The address of an
element within the slice will be equal to the address of an element
within the original array.
A user can choose to selected packed array slices instead using:
(gdb) set fortran repack-array-slices on|off
(gdb) show fortran repack-array-slices
With packed array slices GDB creates a new type that reflects how the
elements of the slice would look if they were laid out in contiguous
memory, allocates a value of this type, and then fetches the elements
from the original array and places then into the contents buffer of
the new value.
One benefit of using packed slices over unapacked slices is the memory
usage, taking a small slice of N elements from a large array will
require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked
array will also include all of the "padding" between the
non-contiguous elements. There are new tests added that highlight
this difference.
There is also a new debugging flag added with this commit that
introduces these commands:
(gdb) set debug fortran-array-slicing on|off
(gdb) show debug fortran-array-slicing
This prints information about how the array slices are being built.
As both the repacking, and the array printing requires GDB to walk
through a multi-dimensional Fortran array visiting each element, this
commit adds the file f-array-walk.h, which introduces some
infrastructure to support this process. This means the array printing
code in f-valprint.c is significantly reduced.
The only slight issue with this commit is the "rather big hack" that I
mentioned above. This hack allows us to handle one specific case,
array slices with negative strides. This is something that I don't
believe the current GDB value contents model will allow us to
correctly handle, and rather than rewrite the value contents code
right now, I'm hoping to slip this hack in as a work around.
The problem is that, as I see it, the current value contents model
assumes that an object base address will be the lowest address within
that object, and that the contents of the object start at this base
address and occupy the TYPE_LENGTH bytes after that.
( We do have the embedded_offset, which is used for C++ sub-classes,
such that an object can start at some offset from the content buffer,
however, the assumption that the object then occupies the next
TYPE_LENGTH bytes is still true within GDB. )
The problem is that Fortran arrays with a negative stride don't follow
this pattern. In this case the base address of the object points to
the element with the highest address, the contents of the array then
start at some offset _before_ the base address, and proceed for one
element _past_ the base address.
As the stride for such an array would be negative then, in theory the
TYPE_LENGTH for this type would also be negative. However, in many
places a value in GDB will degrade to a pointer + length, and the
length almost always comes from the TYPE_LENGTH.
It is my belief that in order to correctly model this case the value
content handling of GDB will need to be reworked to split apart the
value's content buffer (which is a block of memory with a length), and
the object's in memory base address and length, which could be
negative.
Things are further complicated because arrays with negative strides
like this are always dynamic types. When a value has a dynamic type
and its base address needs resolving we actually store the address of
the object within the resolved dynamic type, not within the value
object itself.
In short I don't currently see an easy path to cleanly support this
situation within GDB. And so I believe that leaves two options,
either add a work around, or catch cases where the user tries to make
use of a negative stride, or access an array with a negative stride,
and throw an error.
This patch currently goes with adding a work around, which is that
when we resolve a dynamic Fortran array type, if the stride is
negative, then we adjust the base address to point to the lowest
address required by the array. The printing and slicing code is aware
of this adjustment and will correctly slice and print Fortran arrays.
Where this hack will show through to the user is if they ask for the
address of an array in their program with a negative array stride, the
address they get from GDB will not match the address that would be
computed within the Fortran program.
gdb/ChangeLog:
* Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
* NEWS: Mention new options.
* f-array-walker.h: New file.
* f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
(repack_array_slices): New static global.
(show_repack_array_slices): New function.
(fortran_array_slicing_debug): New static global.
(show_fortran_array_slicing_debug): New function.
(value_f90_subarray): Delete.
(skip_undetermined_arglist): Delete.
(class fortran_array_repacker_base_impl): New class.
(class fortran_lazy_array_repacker_impl): New class.
(class fortran_array_repacker_impl): New class.
(fortran_value_subarray): Complete rewrite.
(set_fortran_list): New static global.
(show_fortran_list): Likewise.
(_initialize_f_language): Register new commands.
(fortran_adjust_dynamic_array_base_address_hack): New function.
* f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
Declare.
* f-valprint.c: Include 'f-array-walker.h'.
(class fortran_array_printer_impl): New class.
(f77_print_array_1): Delete.
(f77_print_array): Delete.
(fortran_print_array): New.
(f_value_print_inner): Update to call fortran_print_array.
* gdbtypes.c: Include 'f-lang.h'.
(resolve_dynamic_type_internal): Call
fortran_adjust_dynamic_array_base_address_hack.
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices-bad.exp: New file.
* gdb.fortran/array-slices-bad.f90: New file.
* gdb.fortran/array-slices-sub-slices.exp: New file.
* gdb.fortran/array-slices-sub-slices.f90: New file.
* gdb.fortran/array-slices.exp: Rewrite tests.
* gdb.fortran/array-slices.f90: Rewrite tests.
* gdb.fortran/vla-sizeof.exp: Correct expected results.
gdb/doc/ChangeLog:
* gdb.texinfo (Debugging Output): Document 'set/show debug
fotran-array-slicing'.
(Special Fortran Commands): Document 'set/show fortran
repack-array-slices'.
---
gdb/ChangeLog | 32 +
gdb/Makefile.in | 1 +
gdb/NEWS | 13 +
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 32 +
gdb/f-array-walker.h | 255 +++++++
gdb/f-lang.c | 712 ++++++++++++++++--
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 190 ++---
gdb/gdbtypes.c | 12 +-
gdb/testsuite/ChangeLog | 10 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 ++
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 276 +++++--
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
18 files changed, 1995 insertions(+), 250 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
diff --git a/gdb/Makefile.in b/gdb/Makefile.in
index 5f92e8781e7..3d12af8a5cc 100644
--- a/gdb/Makefile.in
+++ b/gdb/Makefile.in
@@ -1273,6 +1273,7 @@ HFILES_NO_SRCDIR = \
expression.h \
extension.h \
extension-priv.h \
+ f-array-walker.h \
f-lang.h \
fbsd-nat.h \
fbsd-tdep.h \
diff --git a/gdb/NEWS b/gdb/NEWS
index 1789cf31356..d55ed350a91 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -131,6 +131,19 @@ maintenance print core-file-backed-mappings
Prints file-backed mappings loaded from a core file's note section.
Output is expected to be similar to that of "info proc mappings".
+set debug fortran-array-slicing on|off
+show debug fortran-array-slicing
+ Print debugging when taking slices of Fortran arrays.
+
+set fortran repack-array-slices on|off
+show fortran repack-array-slices
+ When taking slices from Fortran arrays and strings, if the slice is
+ non-contiguous within the original value then, when this option is
+ on, the new value will be repacked into a single contiguous value.
+ When this option is off, then the value returned will consist of a
+ descriptor that describes the slice within the memory of the
+ original parent value.
+
* Changed commands
alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...]
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index 2636b6f9903..d728c5252d6 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -16919,6 +16919,29 @@
block whose name is @var{common-name}. With no argument, the names of
all @code{COMMON} blocks visible at the current program location are
printed.
+@cindex arrays slices (Fortran)
+@kindex set fortran repack-array-slices
+@kindex show fortran repack-array-slices
+@item set fortran repack-array-slices [on|off]
+@item show fortran repack-array-slices
+When taking a slice from an array, a Fortran compiler can choose to
+either produce an array descriptor that describes the slice in place,
+or it may repack the slice, copying the elements of the slice into a
+new region of memory.
+
+When this setting is on, then @value{GDBN} will also repack array
+slices in some situations. When this setting is off, then
+@value{GDBN} will create array descriptors for slices that reference
+the original data in place.
+
+@value{GDBN} will never repack an array slice if the data for the
+slice is contiguous within the original array.
+
+@value{GDBN} will always repack string slices if the data for the
+slice is non-contiguous within the original string as @value{GDBN}
+does not support printing non-contiguous strings.
+
+The default for this setting is @code{off}.
@end table
@node Pascal
@@ -26511,6 +26534,15 @@
@item show debug fbsd-nat
Show the current state of FreeBSD native target debugging messages.
+@item set debug fortran-array-slicing
+@cindex fortran array slicing debugging info
+Turns on or off display of @value{GDBN} Fortran array slicing
+debugging info. The default is off.
+
+@item show debug fortran-array-slicing
+Displays the current state of displaying @value{GDBN} Fortran array
+slicing debugging info.
+
@item set debug frame
@cindex frame debugging info
Turns on or off display of @value{GDBN} frame debugging info. The
diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h
new file mode 100644
index 00000000000..395c26e5350
--- /dev/null
+++ b/gdb/f-array-walker.h
@@ -0,0 +1,255 @@
+/* Copyright (C) 2020 Free Software Foundation, Inc.
+
+ This file is part of GDB.
+
+ 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/>. */
+
+/* Support classes to wrap up the process of iterating over a
+ multi-dimensional Fortran array. */
+
+#ifndef F_ARRAY_WALKER_H
+#define F_ARRAY_WALKER_H
+
+#include "defs.h"
+#include "gdbtypes.h"
+#include "f-lang.h"
+
+/* Class for calculating the byte offset for elements within a single
+ dimension of a Fortran array. */
+class fortran_array_offset_calculator
+{
+public:
+ /* Create a new offset calculator for TYPE, which is either an array or a
+ string. */
+ fortran_array_offset_calculator (struct type *type)
+ {
+ /* Validate the type. */
+ type = check_typedef (type);
+ if (type->code () != TYPE_CODE_ARRAY
+ && (type->code () != TYPE_CODE_STRING))
+ error (_("can only compute offsets for arrays and strings"));
+
+ /* Get the range, and extract the bounds. */
+ struct type *range_type = type->index_type ();
+ if (get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound) < 0)
+ error ("unable to read array bounds");
+
+ /* Figure out the stride for this array. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ m_stride = type->index_type ()->bounds ()->bit_stride ();
+ if (m_stride == 0)
+ m_stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ m_stride /= (unit_size * 8);
+ }
+ };
+
+ /* Get the byte offset for element INDEX within the type we are working
+ on. There is no bounds checking done on INDEX. If the stride is
+ negative then we still assume that the base address (for the array
+ object) points to the element with the lowest memory address, we then
+ calculate an offset assuming that index 0 will be the element at the
+ highest address, index 1 the next highest, and so on. This is not
+ quite how Fortran works in reality; in reality the base address of
+ the object would point at the element with the highest address, and
+ we would index backwards from there in the "normal" way, however,
+ GDB's current value contents model doesn't support having the base
+ address be near to the end of the value contents, so we currently
+ adjust the base address of Fortran arrays with negative strides so
+ their base address points at the lowest memory address. This code
+ here is part of working around this weirdness. */
+ LONGEST index_offset (LONGEST index)
+ {
+ LONGEST offset;
+ if (m_stride < 0)
+ offset = std::abs (m_stride) * (m_upperbound - index);
+ else
+ offset = std::abs (m_stride) * (index - m_lowerbound);
+ return offset;
+ }
+
+private:
+
+ /* The stride for the type we are working with. */
+ LONGEST m_stride;
+
+ /* The upper bound for the type we are working with. */
+ LONGEST m_upperbound;
+
+ /* The lower bound for the type we are working with. */
+ LONGEST m_lowerbound;
+};
+
+/* A base class used by fortran_array_walker. */
+class fortran_array_walker_base_impl
+{
+public:
+ /* Constructor. */
+ explicit fortran_array_walker_base_impl ()
+ { /* Nothing. */ }
+
+ /* Called when iterating between the lower and upper bounds of each
+ dimension of the array. Return true if GDB should continue iterating,
+ otherwise, return false.
+
+ SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
+ be taken into consideration when deciding what to return. If
+ SHOULD_CONTINUE is false then this function must also return false,
+ the function is still called though in case extra work needs to be
+ done as part of the stopping process. */
+ bool continue_walking (bool should_continue)
+ { return should_continue; }
+
+ /* Called when GDB starts iterating over a dimension of the array. This
+ function will be called once for each of the bounds in this dimension.
+ DIM is the current dimension number, NDIM is the total number of
+ dimensions, and FIRST_P is true for the first bound of this
+ dimension, and false in all other cases. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ { /* Nothing. */ }
+
+ /* Called when GDB finishes iterating over a dimension of the array.
+ This function will be called once for each of the bounds in this
+ dimension. DIM is the current dimension number, NDIM is the total
+ number of dimensions, and LAST_P is true for the last bound of this
+ dimension, and false in all other cases. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ { /* Nothing. */ }
+
+ /* Called when processing the inner most dimension of the array, for
+ every element in the array. PARENT_VALUE is the value from which
+ elements are being extracted, ELT_TYPE is the type of the element
+ being extracted, and ELT_OFF is the offset of the element from the
+ start of PARENT_VALUE. */
+ void process_element (struct value *parent_value, struct type *elt_type,
+ LONGEST elt_off)
+ { /* Nothing. */ }
+};
+
+/* A class to wrap up the process of iterating over a multi-dimensional
+ Fortran array. IMPL is used to specialise what happens as we walk over
+ the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
+ methods than can be used to customise the array walk. */
+template<typename Impl>
+class fortran_array_walker
+{
+ /* Ensure that Impl is derived from the required base class. This just
+ ensures that all of the required API methods are available and have a
+ sensible default implementation. */
+ gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
+
+public:
+ /* Create a new array walker. TYPE is the type of the array being walked
+ over, and ADDRESS is the base address for the object of TYPE in
+ memory. All other arguments are forwarded to the constructor of the
+ template parameter class IMPL. */
+ template <typename ...Args>
+ fortran_array_walker (struct type *type, CORE_ADDR address,
+ Args... args)
+ : m_type (type),
+ m_address (address),
+ m_impl (type, address, args...)
+ {
+ m_ndimensions = calc_f77_array_dims (m_type);
+ }
+
+ /* Walk the array. */
+ void
+ walk ()
+ {
+ walk_1 (1, m_type, 0);
+ }
+
+private:
+ /* The core of the array walking algorithm. NSS is the current
+ dimension number being processed, TYPE is the type of this dimension,
+ and OFFSET is the offset (in bytes) for the start of this dimension. */
+ void
+ walk_1 (int nss, struct type *type, int offset)
+ {
+ /* Extract the range, and get lower and upper bounds. */
+ struct type *range_type = check_typedef (type)->index_type ();
+ LONGEST lowerbound, upperbound;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* CALC is used to calculate the offsets for each element in this
+ dimension. */
+ fortran_array_offset_calculator calc (type);
+
+ if (nss != m_ndimensions)
+ {
+ /* For dimensions other than the inner most, walk each element and
+ recurse while peeling off one more dimension of the array. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ m_impl.start_dimension (nss, m_ndimensions, (i == lowerbound));
+
+ /* Use the index and the stride to work out a new offset. */
+ LONGEST new_offset = offset + calc.index_offset (i);
+
+ /* Now print the lower dimension. */
+ struct type *subarray_type
+ = TYPE_TARGET_TYPE (check_typedef (type));
+ walk_1 (nss + 1, subarray_type, new_offset);
+
+ m_impl.finish_dimension (nss, m_ndimensions, (i == upperbound));
+ }
+ }
+ else
+ {
+ /* For the inner most dimension of the array, process each element
+ within this dimension. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ m_impl.start_dimension (nss, m_ndimensions, (i == lowerbound));
+
+ LONGEST elt_off = offset + calc.index_offset (i);
+
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ if (is_dynamic_type (elt_type))
+ {
+ CORE_ADDR e_address = m_address + elt_off;
+ elt_type = resolve_dynamic_type (elt_type, {}, e_address);
+ }
+
+ m_impl.process_element (elt_type, elt_off);
+
+ m_impl.finish_dimension (nss, m_ndimensions, (i == upperbound));
+ }
+ }
+ }
+
+ /* The array type being processed. */
+ struct type *m_type;
+
+ /* The address in target memory for the object of M_TYPE being
+ processed. This is required in order to resolve dynamic types. */
+ CORE_ADDR m_address;
+
+ /* An instance of the template specialisation class. */
+ Impl m_impl;
+
+ /* The total number of dimensions in M_TYPE. */
+ int m_ndimensions;
+};
+
+#endif /* F_ARRAY_WALKER_H */
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index b888e3d4122..202170e3c25 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -36,9 +36,36 @@
#include "c-lang.h"
#include "target-float.h"
#include "gdbarch.h"
+#include "gdbcmd.h"
+#include "f-array-walker.h"
#include <math.h>
+/* Whether GDB should repack array slices created by the user. */
+static bool repack_array_slices = false;
+
+/* Implement 'show fortran repack-array-slices'. */
+static void
+show_repack_array_slices (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c, const char *value)
+{
+ fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"),
+ value);
+}
+
+/* Debugging of Fortran's array slicing. */
+static bool fortran_array_slicing_debug = false;
+
+/* Implement 'show debug fortran-array-slicing'. */
+static void
+show_fortran_array_slicing_debug (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c,
+ const char *value)
+{
+ fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"),
+ value);
+}
+
/* Local functions */
/* Return the encoding that should be used for the character type
@@ -114,57 +141,6 @@ enum f_primitive_types {
nr_f_primitive_types
};
-/* Called from fortran_value_subarray to take a slice of an array or a
- string. ARRAY is the array or string to be accessed. EXP, POS, and
- NOSIDE are as for evaluate_subexp_standard. Return a value that is a
- slice of the array. */
-
-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, stride;
- struct type *range = check_typedef (value_type (array)->index_type ());
- enum range_flag range_flag
- = (enum range_flag) longest_to_int (exp->elts[pc].longconst);
-
- *pos += 3;
-
- if (range_flag & RANGE_LOW_BOUND_DEFAULT)
- low_bound = range->bounds ()->low.const_val ();
- else
- low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
-
- if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
- high_bound = range->bounds ()->high.const_val ();
- else
- high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
-
- if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
- stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
- else
- stride = 1;
-
- if (stride != 1)
- error (_("Fortran array strides are not currently supported"));
-
- return value_slice (array, low_bound, high_bound - low_bound + 1);
-}
-
-/* Helper for skipping all the arguments in an undetermined argument list.
- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
- case of evaluate_subexp_standard as multiple, but not all, code paths
- require a generic skip. */
-
-static void
-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
- enum noside noside)
-{
- for (int i = 0; i < nargs; ++i)
- evaluate_subexp (nullptr, exp, pos, noside);
-}
-
/* Return the number of dimensions for a Fortran array or string. */
int
@@ -189,6 +165,145 @@ calc_f77_array_dims (struct type *array_type)
return ndimen;
}
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This is a base class for two alternative repacking mechanisms,
+ one for when repacking from a lazy value, and one for repacking from a
+ non-lazy (already loaded) value. */
+class fortran_array_repacker_base_impl
+ : public fortran_array_walker_base_impl
+{
+public:
+ /* Constructor, DEST is the value we are repacking into. */
+ fortran_array_repacker_base_impl (struct value *dest)
+ : m_dest (dest),
+ m_dest_offset (0)
+ { /* Nothing. */ }
+
+ /* When we start processing the inner most dimension, this is where we
+ will be creating values for each element as we load them and then copy
+ them into the M_DEST value. Set a value mark so we can free these
+ temporary values. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ {
+ if (dim == ndim && first_p)
+ {
+ gdb_assert (m_mark == nullptr);
+ m_mark = value_mark ();
+ }
+ }
+
+ /* When we finish processing the inner most dimension free all temporary
+ value that were created. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ {
+ if (dim == ndim && last_p)
+ {
+ gdb_assert (m_mark != nullptr);
+ value_free_to_mark (m_mark);
+ m_mark = nullptr;
+ }
+ }
+
+protected:
+ /* Copy the contents of array element ELT into M_DEST at the next
+ available offset. */
+ void copy_element_to_dest (struct value *elt)
+ {
+ value_contents_copy (m_dest, m_dest_offset, elt, 0,
+ TYPE_LENGTH (value_type (elt)));
+ m_dest_offset += TYPE_LENGTH (value_type (elt));
+ }
+
+ /* The value being written to. */
+ struct value *m_dest;
+
+ /* The byte offset in M_DEST at which the next element should be
+ written. */
+ LONGEST m_dest_offset;
+
+ /* Set with a call to VALUE_MARK, and then reset after calling
+ VALUE_FREE_TO_MARK. */
+ struct value *m_mark = nullptr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ lazy array value, as such it does not require the parent array value to
+ be loaded into GDB's memory; the parent value could be huge, while the
+ slice could be tiny. */
+class fortran_lazy_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type of the slice being loaded from the
+ parent value, so this type will correctly reflect the strides required
+ to find all of the elements from the parent value. ADDRESS is the
+ address in target memory of value matching TYPE, and DEST is the value
+ we are repacking into. */
+ explicit fortran_lazy_array_repacker_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_addr (address)
+ { /* Nothing. */ }
+
+ /* Create a lazy value in target memory representing a single element,
+ then load the element into GDB's memory and copy the contents into the
+ destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off));
+ }
+
+private:
+ /* The address in target memory where the parent value starts. */
+ CORE_ADDR m_addr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ previously loaded (non-lazy) array value, as such it fetches the
+ element values from the contents of the parent value. */
+class fortran_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type for the array slice within the parent
+ value, as such it has stride values as required to find the elements
+ within the original parent value. ADDRESS is the address in target
+ memory of the value matching TYPE. BASE_OFFSET is the offset from
+ the start of VAL's content buffer to the start of the object of TYPE,
+ VAL is the parent object from which we are loading the value, and
+ DEST is the value into which we are repacking. */
+ explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address,
+ LONGEST base_offset,
+ struct value *val, struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_base_offset (base_offset),
+ m_val (val)
+ {
+ gdb_assert (!value_lazy (val));
+ }
+
+ /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF)
+ from the content buffer of M_VAL then copy this extracted value into
+ the repacked destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ struct value *elt
+ = value_from_component (m_val, elt_type, (elt_off + m_base_offset));
+ copy_element_to_dest (elt);
+ }
+
+private:
+ /* The offset into the content buffer of M_VAL to the start of the slice
+ being extracted. */
+ LONGEST m_base_offset;
+
+ /* The parent value from which we are extracting a slice. */
+ struct value *m_val;
+};
+
/* Called from evaluate_subexp_standard to perform array indexing, and
sub-range extraction, for Fortran. As well as arrays this function
also handles strings as they can be treated like arrays of characters.
@@ -200,51 +315,394 @@ static struct value *
fortran_value_subarray (struct value *array, struct expression *exp,
int *pos, int nargs, enum noside noside)
{
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (array, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
+ type *original_array_type = check_typedef (value_type (array));
+ bool is_string_p = original_array_type->code () == TYPE_CODE_STRING;
+
+ /* Perform checks for ARRAY not being available. The somewhat overly
+ complex logic here is just to keep backward compatibility with the
+ errors that we used to get before FORTRAN_VALUE_SUBARRAY was
+ rewritten. Maybe a future task would streamline the error messages we
+ get here, and update all the expected test results. */
+ if (exp->elts[*pos].opcode != OP_RANGE)
{
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return array;
+ if (type_not_associated (original_array_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (original_array_type))
+ error (_("no such vector element (vector not allocated)"));
+ }
+ else
+ {
+ if (type_not_associated (original_array_type))
+ error (_("array not associated"));
+ else if (type_not_allocated (original_array_type))
+ error (_("array not allocated"));
}
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1;
- struct type *type = check_typedef (value_type (array));
+ /* First check that the number of dimensions in the type we are slicing
+ matches the number of arguments we were passed. */
+ int ndimensions = calc_f77_array_dims (original_array_type);
+ if (nargs != ndimensions)
+ error (_("Wrong number of subscripts"));
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+ /* This will be initialised below with the type of the elements held in
+ ARRAY. */
+ struct type *inner_element_type;
- ndimensions = calc_f77_array_dims (type);
+ /* Extract the types of each array dimension from the original array
+ type. We need these available so we can fill in the default upper and
+ lower bounds if the user requested slice doesn't provide that
+ information. Additionally unpacking the dimensions like this gives us
+ the inner element type. */
+ std::vector<struct type *> dim_types;
+ {
+ dim_types.reserve (ndimensions);
+ struct type *type = original_array_type;
+ for (int i = 0; i < ndimensions; ++i)
+ {
+ dim_types.push_back (type);
+ type = TYPE_TARGET_TYPE (type);
+ }
+ /* TYPE is now the inner element type of the array, we start the new
+ array slice off as this type, then as we process the requested slice
+ (from the user) we wrap new types around this to build up the final
+ slice type. */
+ inner_element_type = type;
+ }
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
+ /* As we analyse the new slice type we need to understand if the data
+ being referenced is contiguous. Do decide this we must track the size
+ of an element at each dimension of the new slice array. Initially the
+ elements of the inner most dimension of the array are the same inner
+ most elements as the original ARRAY. */
+ LONGEST slice_element_size = TYPE_LENGTH (inner_element_type);
+
+ /* Start off assuming all data is contiguous, this will be set to false
+ if access to any dimension results in non-contiguous data. */
+ bool is_all_contiguous = true;
+
+ /* The TOTAL_OFFSET is the distance in bytes from the start of the
+ original ARRAY to the start of the new slice. This is calculated as
+ we process the information from the user. */
+ LONGEST total_offset = 0;
+
+ /* A structure representing information about each dimension of the
+ resulting slice. */
+ struct slice_dim
+ {
+ /* Constructor. */
+ slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx)
+ : low (l),
+ high (h),
+ stride (s),
+ index (idx)
+ { /* Nothing. */ }
+
+ /* The low bound for this dimension of the slice. */
+ LONGEST low;
+
+ /* The high bound for this dimension of the slice. */
+ LONGEST high;
+
+ /* The byte stride for this dimension of the slice. */
+ LONGEST stride;
+
+ struct type *index;
+ };
+
+ /* The dimensions of the resulting slice. */
+ std::vector<slice_dim> slice_dims;
+
+ /* Process the incoming arguments. These arguments are in the reverse
+ order to the array dimensions, that is the first argument refers to
+ the last array dimension. */
+ if (fortran_array_slicing_debug)
+ debug_printf ("Processing array access:\n");
+ for (int i = 0; i < nargs; ++i)
+ {
+ /* For each dimension of the array the user will have either provided
+ a ranged access with optional lower bound, upper bound, and
+ stride, or the user will have supplied a single index. */
+ struct type *dim_type = dim_types[ndimensions - (i + 1)];
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ {
+ int pc = (*pos) + 1;
+ enum range_flag range_flag = (enum range_flag) exp->elts[pc].longconst;
+ *pos += 3;
+
+ LONGEST low, high, stride;
+ low = high = stride = 0;
+
+ if ((range_flag & RANGE_LOW_BOUND_DEFAULT) == 0)
+ low = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ low = f77_get_lowerbound (dim_type);
+ if ((range_flag & RANGE_HIGH_BOUND_DEFAULT) == 0)
+ high = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ high = f77_get_upperbound (dim_type);
+ if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
+ stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ stride = 1;
+
+ if (stride == 0)
+ error (_("stride must not be 0"));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride ();
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type) * 8;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Range access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Bit stride: %ld\n", sd);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd / 8);
+ debug_printf ("| | |-> Type size: %ld\n",
+ TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| |-> Accessing:\n");
+ debug_printf ("| | |-> Low bound: %ld\n",
+ low);
+ debug_printf ("| | |-> High bound: %ld\n",
+ high);
+ debug_printf ("| | '-> Element stride: %ld\n",
+ stride);
+ }
+
+ /* Check the user hasn't asked for something invalid. */
+ if (high > ub || low < lb)
+ error (_("array subscript out of bounds"));
+
+ /* Calculate what this dimension of the new slice array will look
+ like. OFFSET is the byte offset from the start of the
+ previous (more outer) dimension to the start of this
+ dimension. E_COUNT is the number of elements in this
+ dimension. REMAINDER is the number of elements remaining
+ between the last included element and the upper bound. For
+ example an access '1:6:2' will include elements 1, 3, 5 and
+ have a remainder of 1 (element #6). */
+ LONGEST lowest = std::min (low, high);
+ LONGEST offset = (sd / 8) * (lowest - lb);
+ LONGEST e_count = std::abs (high - low) + 1;
+ e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride);
+ LONGEST new_low = 1;
+ LONGEST new_high = new_low + e_count - 1;
+ LONGEST new_stride = (sd * stride) / 8;
+ LONGEST last_elem = low + ((e_count - 1) * stride);
+ LONGEST remainder = high - last_elem;
+ if (low > high)
+ {
+ offset += std::abs (remainder) * TYPE_LENGTH (target_type);
+ if (stride > 0)
+ error (_("incorrect stride and boundary combination"));
+ }
+ else if (stride < 0)
+ error (_("incorrect stride and boundary combination"));
+
+ /* Is the data within this dimension contiguous? It is if the
+ newly computed stride is the same size as a single element of
+ this dimension. */
+ bool is_dim_contiguous = (new_stride == slice_element_size);
+ is_all_contiguous &= is_dim_contiguous;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("| '-> Results:\n");
+ debug_printf ("| |-> Offset = %ld\n", offset);
+ debug_printf ("| |-> Elements = %ld\n", e_count);
+ debug_printf ("| |-> Low bound = %ld\n", new_low);
+ debug_printf ("| |-> High bound = %ld\n", new_high);
+ debug_printf ("| |-> Byte stride = %ld\n", new_stride);
+ debug_printf ("| |-> Last element = %ld\n", last_elem);
+ debug_printf ("| |-> Remainder = %ld\n", remainder);
+ debug_printf ("| '-> Contiguous = %s\n",
+ (is_dim_contiguous ? "Yes" : "No"));
+ }
+
+ /* Figure out how big (in bytes) an element of this dimension of
+ the new array slice will be. */
+ slice_element_size = std::abs (new_stride * e_count);
+
+ slice_dims.emplace_back (new_low, new_high, new_stride,
+ index_type);
+
+ /* Update the total offset. */
+ total_offset += offset;
+ }
+ else
+ {
+ /* There is a single index for this dimension. */
+ LONGEST index
+ = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride () / 8;
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type);
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Index access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd);
+ debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| '-> Accessing:\n");
+ debug_printf ("| '-> Index: %ld\n", index);
+ }
+
+ /* If the array has actual content then check the index is in
+ bounds. An array without content (an unbound array) doesn't
+ have a known upper bound, so don't error check in that
+ situation. */
+ if (index < lb
+ || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED
+ && index > ub)
+ || (VALUE_LVAL (array) != lval_memory
+ && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED))
+ {
+ if (type_not_associated (dim_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (dim_type))
+ error (_("no such vector element (vector not allocated)"));
+ else
+ error (_("no such vector element"));
+ }
- gdb_assert (nargs > 0);
+ /* Calculate using the type stride, not the target type size. */
+ LONGEST offset = sd * (index - lb);
+ total_offset += offset;
+ }
+ }
- /* Now that we know we have a legal array subscript expression let us
- actually find out where this element exists in the array. */
+ if (noside == EVAL_SKIP)
+ return array;
- /* Take array indices left to right. */
- for (int i = 0; i < nargs; i++)
+ /* Build a type that represents the new array slice in the target memory
+ of the original ARRAY, this type makes use of strides to correctly
+ find only those elements that are part of the new slice. */
+ struct type *array_slice_type = inner_element_type;
+ for (const auto &d : slice_dims)
{
- /* Evaluate each subscript; it must be a legal integer in F77. */
- value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (d.stride);
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ array_slice_type
+ = create_array_type (nullptr, array_slice_type, new_range);
+ }
- /* Fill in the subscript array. */
- subscript_array[i] = value_as_long (arg2);
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("'-> Final result:\n");
+ debug_printf (" |-> Type: %s\n",
+ type_to_string (array_slice_type).c_str ());
+ debug_printf (" |-> Total offset: %ld\n", total_offset);
+ debug_printf (" |-> Base address: %s\n",
+ core_addr_to_string (value_address (array)));
+ debug_printf (" '-> Contiguous = %s\n",
+ (is_all_contiguous ? "Yes" : "No"));
}
- /* Internal type of array is arranged right to left. */
- for (int i = nargs; i > 0; i--)
+ /* Should we repack this array slice? */
+ if (!is_all_contiguous && (repack_array_slices || is_string_p))
{
- struct type *array_type = check_typedef (value_type (array));
- LONGEST index = subscript_array[i - 1];
+ /* Build a type for the repacked slice. */
+ struct type *repacked_array_type = inner_element_type;
+ for (const auto &d : slice_dims)
+ {
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (TYPE_LENGTH (repacked_array_type));
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ repacked_array_type
+ = create_array_type (nullptr, repacked_array_type, new_range);
+ }
- array = value_subscripted_rvalue (array, index,
- f77_get_lowerbound (array_type));
+ /* Now copy the elements from the original ARRAY into the packed
+ array value DEST. */
+ struct value *dest = allocate_value (repacked_array_type);
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ {
+ fortran_array_walker<fortran_lazy_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset, dest);
+ p.walk ();
+ }
+ else
+ {
+ fortran_array_walker<fortran_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset,
+ total_offset, array, dest);
+ p.walk ();
+ }
+ array = dest;
+ }
+ else
+ {
+ if (VALUE_LVAL (array) == lval_memory)
+ {
+ /* If the value we're taking a slice from is not yet loaded, or
+ the requested slice is outside the values content range then
+ just create a new lazy value pointing at the memory where the
+ contents we're looking for exist. */
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ array = value_at_lazy (array_slice_type,
+ value_address (array) + total_offset);
+ else
+ array = value_from_contents_and_address (array_slice_type,
+ (value_contents (array)
+ + total_offset),
+ (value_address (array)
+ + total_offset));
+ }
+ else if (!value_lazy (array))
+ {
+ const void *valaddr = value_contents (array) + total_offset;
+ array = allocate_value (array_slice_type);
+ memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type));
+ }
+ else
+ error (_("cannot subscript arrays that are not in memory"));
}
return array;
@@ -1058,11 +1516,50 @@ builtin_f_type (struct gdbarch *gdbarch)
return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
}
+/* Command-list for the "set/show fortran" prefix command. */
+static struct cmd_list_element *set_fortran_list;
+static struct cmd_list_element *show_fortran_list;
+
void _initialize_f_language ();
void
_initialize_f_language ()
{
f_type_data = gdbarch_data_register_post_init (build_fortran_types);
+
+ add_basic_prefix_cmd ("fortran", no_class,
+ _("Prefix command for changing Fortran-specific settings."),
+ &set_fortran_list, "set fortran ", 0, &setlist);
+
+ add_show_prefix_cmd ("fortran", no_class,
+ _("Generic command for showing Fortran-specific settings."),
+ &show_fortran_list, "show fortran ", 0, &showlist);
+
+ add_setshow_boolean_cmd ("repack-array-slices", class_vars,
+ &repack_array_slices, _("\
+Enable or disable repacking of non-contiguous array slices."), _("\
+Show whether non-contiguous array slices are repacked."), _("\
+When the user requests a slice of a Fortran array then we can either return\n\
+a descriptor that describes the array in place (using the original array data\n\
+in its existing location) or the original data can be repacked (copied) to a\n\
+new location.\n\
+\n\
+When the content of the array slice is contiguous within the original array\n\
+then the result will never be repacked, but when the data for the new array\n\
+is non-contiguous within the original array repacking will only be performed\n\
+when this setting is on."),
+ NULL,
+ show_repack_array_slices,
+ &set_fortran_list, &show_fortran_list);
+
+ /* Debug Fortran's array slicing logic. */
+ add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance,
+ &fortran_array_slicing_debug, _("\
+Set debugging of Fortran array slicing."), _("\
+Show debugging of Fortran array slicing."), _("\
+When on, debugging of Fortran array slicing is enabled."),
+ NULL,
+ show_fortran_array_slicing_debug,
+ &setdebuglist, &showdebuglist);
}
/* See f-lang.h. */
@@ -1101,3 +1598,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type)
return value_type (arg);
return type;
}
+
+/* See f-lang.h. */
+
+CORE_ADDR
+fortran_adjust_dynamic_array_base_address_hack (struct type *type,
+ CORE_ADDR address)
+{
+ gdb_assert (type->code () == TYPE_CODE_ARRAY);
+
+ int ndimensions = calc_f77_array_dims (type);
+ LONGEST total_offset = 0;
+
+ /* Walk through each of the dimensions of this array type and figure out
+ if any of the dimensions are "backwards", that is the base address
+ for this dimension points to the element at the highest memory
+ address and the stride is negative. */
+ struct type *tmp_type = type;
+ for (int i = 0 ; i < ndimensions; ++i)
+ {
+ /* Grab the range for this dimension and extract the lower and upper
+ bounds. */
+ tmp_type = check_typedef (tmp_type);
+ struct type *range_type = tmp_type->index_type ();
+ LONGEST lowerbound, upperbound, stride;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* Figure out the stride for this dimension. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
+ stride = tmp_type->index_type ()->bounds ()->bit_stride ();
+ if (stride == 0)
+ stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ stride /= (unit_size * 8);
+ }
+
+ /* If this dimension is "backward" then figure out the offset
+ adjustment required to point to the element at the lowest memory
+ address, and add this to the total offset. */
+ LONGEST offset = 0;
+ if (stride < 0 && lowerbound < upperbound)
+ offset = (upperbound - lowerbound) * stride;
+ total_offset += offset;
+ tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ }
+
+ /* Adjust the address of this object and return it. */
+ address += total_offset;
+ return address;
+}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 4710b14aa62..dee63158ff4 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -64,7 +64,6 @@ extern void f77_get_dynamic_array_length (struct type *);
extern int calc_f77_array_dims (struct type *);
-
/* Fortran (F77) types */
struct builtin_f_type
@@ -122,4 +121,22 @@ extern struct value *fortran_argument_convert (struct value *value,
extern struct type *fortran_preserve_arg_pointer (struct value *arg,
struct type *type);
+/* Fortran arrays can have a negative stride. When this happens it is
+ often the case that the base address for an object is not the lowest
+ address occupied by that object. For example, an array slice (10:1:-1)
+ will be encoded with lower bound 1, upper bound 10, a stride of
+ -ELEMENT_SIZE, and have a base address pointer that points at the
+ element with the highest address in memory.
+
+ This really doesn't play well with our current model of value contents,
+ but could easily require a significant update in order to be supported
+ "correctly".
+
+ For now, we manually force the base address to be the lowest addressed
+ element here. Yes, this will break some things, but it fixes other
+ things. The hope is that it fixes more than it breaks. */
+
+extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
+ (struct type *type, CORE_ADDR address);
+
#endif /* F_LANG_H */
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index e7dc20d0ea5..f742057d897 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -35,6 +35,7 @@
#include "dictionary.h"
#include "cli/cli-style.h"
#include "gdbarch.h"
+#include "f-array-walker.h"
static void f77_get_dynamic_length_of_aggregate (struct type *);
@@ -100,100 +101,110 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
* TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
}
-/* Actual function which prints out F77 arrays, Valaddr == address in
- the superior. Address == the address in the inferior. */
+/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array
+ walking template. This specialisation prints Fortran arrays. */
-static void
-f77_print_array_1 (int nss, int ndimensions, struct type *type,
- const gdb_byte *valaddr,
- int embedded_offset, CORE_ADDR address,
- struct ui_file *stream, int recurse,
- const struct value *val,
- const struct value_print_options *options,
- int *elts)
+class fortran_array_printer_impl : public fortran_array_walker_base_impl
{
- struct type *range_type = check_typedef (type)->index_type ();
- CORE_ADDR addr = address + embedded_offset;
- LONGEST lowerbound, upperbound;
- LONGEST i;
-
- get_discrete_bounds (range_type, &lowerbound, &upperbound);
-
- if (nss != ndimensions)
- {
- struct gdbarch *gdbarch = get_type_arch (type);
- size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type));
- int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
- size_t byte_stride = type->bit_stride () / (unit_size * 8);
- if (byte_stride == 0)
- byte_stride = dim_size;
- size_t offs = 0;
-
- for (i = lowerbound;
- (i < upperbound + 1 && (*elts) < options->print_max);
- i++)
- {
- struct value *subarray = value_from_contents_and_address
- (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
- + offs, addr + offs);
-
- fprintf_filtered (stream, "(");
- f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
- value_contents_for_printing (subarray),
- value_embedded_offset (subarray),
- value_address (subarray),
- stream, recurse, subarray, options, elts);
- offs += byte_stride;
- fprintf_filtered (stream, ")");
-
- if (i < upperbound)
- fprintf_filtered (stream, " ");
- }
- if (*elts >= options->print_max && i < upperbound)
- fprintf_filtered (stream, "...");
- }
- else
- {
- for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
- i++, (*elts)++)
- {
- struct value *elt = value_subscript ((struct value *)val, i);
-
- common_val_print (elt, stream, recurse, options, current_language);
-
- if (i != upperbound)
- fprintf_filtered (stream, ", ");
-
- if ((*elts == options->print_max - 1)
- && (i != upperbound))
- fprintf_filtered (stream, "...");
- }
- }
-}
+public:
+ /* Constructor. TYPE is the array type being printed, ADDRESS is the
+ address in target memory for the object of TYPE being printed. VAL is
+ the GDB value (of TYPE) being printed. STREAM is where to print to,
+ RECOURSE is passed through (and prevents infinite recursion), and
+ OPTIONS are the printing control options. */
+ explicit fortran_array_printer_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *val,
+ struct ui_file *stream,
+ int recurse,
+ const struct value_print_options *options)
+ : m_elts (0),
+ m_val (val),
+ m_stream (stream),
+ m_recurse (recurse),
+ m_options (options)
+ { /* Nothing. */ }
+
+ /* Called while iterating over the array bounds. When SHOULD_CONTINUE is
+ false then we must return false, as we have reached the end of the
+ array bounds for this dimension. However, we also return false if we
+ have printed too many elements (after printing '...'). In all other
+ cases, return true. */
+ bool continue_walking (bool should_continue)
+ {
+ bool cont = should_continue && (m_elts < m_options->print_max);
+ if (!cont && should_continue)
+ fprintf_filtered (m_stream, "...");
+ return cont;
+ }
+
+ /* Called when we start iterating over a dimension. If it's not the
+ inner most dimension then print an opening '(' character. */
+ void start_dimension (int dim, int ndim, bool first_p)
+ {
+ if (dim != ndim)
+ fprintf_filtered (m_stream, "(");
+ }
+
+ /* Called when we finish processing a batch of items within a dimension
+ of the array. Depending on whether this is the inner most dimension
+ or not we print different things, but this is all about adding
+ separators between elements, and dimensions of the array. */
+ void finish_dimension (int dim, int ndim, bool last_p)
+ {
+ if (dim != ndim)
+ {
+ fprintf_filtered (m_stream, ")");
+ if (!last_p)
+ fprintf_filtered (m_stream, " ");
+ }
+ else
+ {
+ if (!last_p)
+ fprintf_filtered (m_stream, ", ");
+ }
+ }
+
+ /* Called to process an element of ELT_TYPE at offset ELT_OFF from the
+ start of the parent object. */
+ void process_element (struct type *elt_type, LONGEST elt_off)
+ {
+ /* Extract the element value from the parent value. */
+ struct value *e_val
+ = value_from_component (m_val, elt_type, elt_off);
+ common_val_print (e_val, m_stream, m_recurse, m_options, current_language);
+ ++m_elts;
+ }
+
+private:
+ /* The number of elements printed so far. */
+ int m_elts;
+
+ /* The value from which we are printing elements. */
+ struct value *m_val;
+
+ /* The stream we should print too. */
+ struct ui_file *m_stream;
+
+ /* The recursion counter, passed through when we print each element. */
+ int m_recurse;
+
+ /* The print control options. Gives us the maximum number of elements to
+ print, and is passed through to each element that we print. */
+ const struct value_print_options *m_options = nullptr;
+};
-/* This function gets called to print an F77 array, we set up some
- stuff and then immediately call f77_print_array_1(). */
+/* This function gets called to print a Fortran array. */
static void
-f77_print_array (struct type *type, const gdb_byte *valaddr,
- int embedded_offset,
- CORE_ADDR address, struct ui_file *stream,
- int recurse,
- const struct value *val,
- const struct value_print_options *options)
+fortran_print_array (struct type *type, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ const struct value *val,
+ const struct value_print_options *options)
{
- int ndimensions;
- int elts = 0;
-
- ndimensions = calc_f77_array_dims (type);
-
- if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
- error (_("\
-Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
- ndimensions, MAX_FORTRAN_DIMS);
-
- f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
- address, stream, recurse, val, options, &elts);
+ fortran_array_walker<fortran_array_printer_impl> p
+ (type, address, (struct value *) val, stream, recurse, options);
+ p.walk ();
}
\f
@@ -238,8 +249,7 @@ f_value_print_inner (struct value *val, struct ui_file *stream, int recurse,
if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR)
{
fprintf_filtered (stream, "(");
- f77_print_array (type, valaddr, 0,
- address, stream, recurse, val, options);
+ fortran_print_array (type, address, stream, recurse, val, options);
fprintf_filtered (stream, ")");
}
else
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 43c05d344d0..ae7de7baf29 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -39,6 +39,7 @@
#include "dwarf2/loc.h"
#include "gdbcore.h"
#include "floatformat.h"
+#include "f-lang.h"
#include <algorithm>
/* Initialize BADNESS constants. */
@@ -2621,7 +2622,16 @@ resolve_dynamic_type_internal (struct type *type,
prop = TYPE_DATA_LOCATION (resolved_type);
if (prop != NULL
&& dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
- prop->set_const_val (value);
+ {
+ /* Start of Fortran hack. See comment in f-lang.h for what is going
+ on here.*/
+ if (current_language->la_language == language_fortran
+ && resolved_type->code () == TYPE_CODE_ARRAY)
+ value = fortran_adjust_dynamic_array_base_address_hack (resolved_type,
+ value);
+ /* End of Fortran hack. */
+ prop->set_const_val (value);
+ }
return resolved_type;
}
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
new file mode 100644
index 00000000000..2583cdecc94
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
@@ -0,0 +1,69 @@
+# Copyright 2020 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/> .
+
+# Test invalid element and slice array accesses.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "First Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Second Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+gdb_continue_to_breakpoint "First Breakpoint"
+
+# Access not yet allocated array.
+gdb_test "print other" " = <not allocated>"
+gdb_test "print other(0:4,2:3)" "array not allocated"
+gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)"
+
+# Access not yet associated pointer.
+gdb_test "print pointer2d" " = <not associated>"
+gdb_test "print pointer2d(1:2,1:2)" "array not associated"
+gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)"
+
+gdb_continue_to_breakpoint "Second Breakpoint"
+
+# Accessing just outside the arrays.
+foreach name {array pointer2d other} {
+ gdb_test "print $name (0:,:)" "array subscript out of bounds"
+ gdb_test "print $name (:11,:)" "array subscript out of bounds"
+ gdb_test "print $name (:,0:)" "array subscript out of bounds"
+ gdb_test "print $name (:,:11)" "array subscript out of bounds"
+
+ gdb_test "print $name (0,:)" "no such vector element"
+ gdb_test "print $name (11,:)" "no such vector element"
+ gdb_test "print $name (:,0)" "no such vector element"
+ gdb_test "print $name (:,11)" "no such vector element"
+}
+
+# Stride in the wrong direction.
+gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination"
+gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
new file mode 100644
index 00000000000..0f3d45ab8cd
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
@@ -0,0 +1,42 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Declare variables used in this test.
+ integer, dimension (1:10,1:10) :: array
+ integer, allocatable :: other (:, :)
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(1:10,1:10), target :: tarray
+
+ print *, "" ! First Breakpoint.
+
+ ! Allocate or associate any variables as needed.
+ allocate (other (1:10, 1:10))
+ pointer2d => tarray
+ array = 0
+
+ print *, "" ! Second Breakpoint.
+
+ ! All done. Deallocate.
+ deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
new file mode 100644
index 00000000000..05b4802c678
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
@@ -0,0 +1,111 @@
+# Copyright 2020 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/> .
+
+# Create a slice of an array, then take a slice of that slice.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Stop Here"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We're going to print some reasonably large arrays.
+gdb_test_no_output "set print elements unlimited"
+
+gdb_continue_to_breakpoint "Stop Here"
+
+# Print a slice, capture the convenience variable name created.
+set cmd "print array (1:10:2, 1:10:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ }
+}
+
+# Now check that we can correctly extract all the elements from this
+# slice.
+for { set j 1 } { $j < 6 } { incr j } {
+ for { set i 1 } { $i < 6 } { incr i } {
+ set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1]
+ gdb_test "print ${varname} ($i,$j)" " = $val"
+ }
+}
+
+# Now take a slice of the slice.
+gdb_test "print ${varname} (3:5, 3:5)" \
+ " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)"
+
+# Now take a different slice of a slice.
+set cmd "print ${varname} (1:5:2, 1:5:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Now take a slice from the slice, of a slice!
+set cmd "print ${varname} (1:3:2, 1:3:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# And again!
+set cmd "print ${varname} (1:2:2, 1:2:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Test taking a slice with stride of a string. This isn't actually
+# supported within gfortran (at least), but naturally drops out of how
+# GDB models arrays and strings in a similar way, so we may as well
+# test that this is still working.
+gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'"
+gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'"
+gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'"
+
+# Now test the memory requirements of taking a slice from an array.
+# The idea is that we shouldn't require more memory to extract a slice
+# than the size of the slice.
+#
+# This will only work if array repacking is turned on, otherwise GDB
+# will create the slice by generating a new type that sits over the
+# existing value in memory.
+gdb_test_no_output "set fortran repack-array-slices on"
+set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"]
+set slice_size [expr $element_size * 4]
+gdb_test_no_output "set max-value-size $slice_size"
+gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)"
+gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)"
+gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
new file mode 100644
index 00000000000..c3530f567d4
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
@@ -0,0 +1,96 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+ integer, dimension (1:10,1:11) :: array
+ character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz"
+
+ call fill_array_2d (array)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Stop Here
+
+ print *, array
+ print *, str
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index a0e1d1fe8fc..ff00fae886f 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -18,6 +18,21 @@
# the subroutine. This should exercise GDB's ability to handle
# different strides for the different dimensions.
+# Testing GDB's ability to print array (and string) slices, including
+# slices that make use of array strides.
+#
+# In the Fortran code various arrays of different ranks are filled
+# with data, and slices are passed to a series of show functions.
+#
+# In this test script we break in each of the show functions, print
+# the array slice that was passed in, and then move up the stack to
+# the parent frame and check GDB can manually extract the same slice.
+#
+# This test also checks that the size of the array slice passed to the
+# function (so as extracted and described by the compiler and the
+# debug information) matches the size of the slice manually extracted
+# by GDB.
+
if {[skip_fortran_tests]} { return -1 }
standard_testfile ".f90"
@@ -28,59 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
return -1
}
-if ![fortran_runto_main] {
- untested "could not run to main"
- return -1
+# Takes the name of an array slice as used in the test source, and extracts
+# the base array name. For example: 'array (1,2)' becomes 'array'.
+proc array_slice_to_var { slice_str } {
+ regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname
+ return $varname
}
-gdb_breakpoint "show"
-gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
-
-set array_contents \
- [list \
- " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
- " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
- " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
- " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
- " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
- " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
-
-set message_strings \
- [list \
- " = 'array'" \
- " = 'array \\(1:5,1:5\\)'" \
- " = 'array \\(1:10:2,1:10:2\\)'" \
- " = 'array \\(1:10:3,1:10:2\\)'" \
- " = 'array \\(1:10:5,1:10:3\\)'" \
- " = 'other'" \
- " = 'other \\(-5:0, -2:0\\)'" \
- " = 'other \\(-5:4:2, -2:7:3\\)'" ]
-
-set i 0
-foreach result $array_contents msg $message_strings {
- incr i
- with_test_prefix "test $i" {
- gdb_continue_to_breakpoint "show"
- gdb_test "p array" $result
- gdb_test "p message" "$msg"
+proc run_test { repack } {
+ global binfile gdb_prompt
+
+ clean_restart ${binfile}
+
+ if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
}
-}
-gdb_continue_to_breakpoint "continue to Final Breakpoint"
+ gdb_test_no_output "set fortran repack-array-slices $repack"
+
+ # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+ gdb_breakpoint [gdb_get_line_number "Display Element"]
+ gdb_breakpoint [gdb_get_line_number "Display String"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"]
+ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+ # We're going to print some reasonably large arrays.
+ gdb_test_no_output "set print elements unlimited"
+
+ set found_final_breakpoint false
+
+ # We place a limit on the number of tests that can be run, just in
+ # case something goes wrong, and GDB gets stuck in an loop here.
+ set test_count 0
+ while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ set found_final_breakpoint false
+ set expected_result ""
+ set func_name ""
+ gdb_test_multiple "continue" "continue" {
+ -re ".*GDB = (\[^\r\n\]+)\r\n" {
+ set expected_result $expect_out(1,string)
+ exp_continue
+ }
+ -re "! Display Element" {
+ set func_name "show_elem"
+ exp_continue
+ }
+ -re "! Display String" {
+ set func_name "show_str"
+ exp_continue
+ }
+ -re "! Display Array Slice (.)D" {
+ set func_name "show_$expect_out(1,string)d"
+ exp_continue
+ }
+ -re "! Final Breakpoint" {
+ set found_final_breakpoint true
+ exp_continue
+ }
+ -re "$gdb_prompt $" {
+ # We're done.
+ }
+ }
-# Next test that asking for an array with stride at the CLI gives an
-# error.
-clean_restart ${testfile}
+ if ($found_final_breakpoint) {
+ break
+ }
-if ![fortran_runto_main] then {
- perror "couldn't run to main"
- continue
+ # We want to take a look at the line in the previous frame that
+ # called the current function. I couldn't find a better way of
+ # doing this than 'up', which will print the line, then 'down'
+ # again.
+ #
+ # I don't want to fill the log with passes for these up/down
+ # commands, so we don't report any. If something goes wrong then we
+ # should get a fail from gdb_test_multiple.
+ set array_slice_name ""
+ set unique_id ""
+ array unset replacement_vars
+ array set replacement_vars {}
+ gdb_test_multiple "up" "up" {
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ }
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ set unique_id $expect_out(2,string)
+ }
+ }
+ if {$unique_id != ""} {
+ set str ""
+ foreach v [split $unique_id ,] {
+ set val [get_integer_valueof "${v}" "??"\
+ "get variable '$v' for '$array_slice_name'"]
+ set replacement_vars($v) $val
+ if {$str != ""} {
+ set str "Str,"
+ }
+ set str "$str$v=$val"
+ }
+ set unique_id " $str"
+ }
+ gdb_test_multiple "down" "down" {
+ -re "\r\n$gdb_prompt $" {
+ # Don't issue a pass here.
+ }
+ }
+
+ # Check we have all the information we need to successfully run one
+ # of these tests.
+ if { $expected_result == "" } {
+ perror "failed to extract expected results"
+ return 0
+ }
+ if { $array_slice_name == "" } {
+ perror "failed to extract array slice name"
+ return 0
+ }
+
+ # Check GDB can correctly print the array slice that was passed into
+ # the current frame.
+ set pattern [string_to_regexp " = $expected_result"]
+ gdb_test "p array" "$pattern" \
+ "check value of '$array_slice_name'$unique_id"
+
+ # Get the size of the slice.
+ set size_in_show \
+ [get_integer_valueof "sizeof (array)" "show_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in show"]
+ set addr_in_show \
+ [get_hexadecimal_valueof "&array" "show_unknown" \
+ "get address '$array_slice_name'$unique_id in show"]
+
+ # Now move into the previous frame, and see if GDB can extract the
+ # array slice from the original parent object. Again, use of
+ # gdb_test_multiple to avoid filling the logs with unnecessary
+ # passes.
+ gdb_test_multiple "up" "up" {
+ -re "\r\n$gdb_prompt $" {
+ # Do nothing.
+ }
+ }
+
+ # Print the array slice, this will force GDB to manually extract the
+ # slice from the parent array.
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted"
+
+ # Get the size of the slice in the calling frame.
+ set size_in_parent \
+ [get_integer_valueof "sizeof ($array_slice_name)" \
+ "parent_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in parent"]
+
+ # Figure out the start and end addresses of the full array in the
+ # parent frame.
+ set full_var_name [array_slice_to_var $array_slice_name]
+ set start_addr [get_hexadecimal_valueof "&${full_var_name}" \
+ "start unknown"]
+ set end_addr [get_hexadecimal_valueof \
+ "(&${full_var_name}) + sizeof (${full_var_name})" \
+ "end unknown"]
+
+ # The Fortran compiler can choose to either send a descriptor that
+ # describes the array slice to the subroutine, or it can repack the
+ # slice into an array section and send that.
+ #
+ # We find the address range of the original array in the parent,
+ # and the address of the slice in the show function, if the
+ # address of the slice (from show) is in the range of the original
+ # array then repacking has not occurred, otherwise, the slice is
+ # outside of the parent, and repacking must have occurred.
+ #
+ # The goal here is to compare the sizes of the slice in show with
+ # the size of the slice extracted by GDB. So we can only compare
+ # sizes when GDB's repacking setting matches the repacking
+ # behaviour we got from the compiler.
+ if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \
+ == ($repack == "on") } {
+ gdb_assert {$size_in_show == $size_in_parent} \
+ "check sizes match"
+ } elseif { $repack == "off" } {
+ # GDB's repacking is off (so slices are left unpacked), but
+ # the compiler did pack this one. As a result we can't
+ # compare the sizes between the compiler's slice and GDB's
+ # slice.
+ verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared"
+ } else {
+ # Like the above, but the reverse, GDB's repacking is on, but
+ # the compiler didn't repack this slice.
+ verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared"
+ }
+
+ # If the array name we just tested included variable names, then
+ # test again with all the variables expanded.
+ if {$unique_id != ""} {
+ foreach v [array names replacement_vars] {
+ set val $replacement_vars($v)
+ set array_slice_name \
+ [regsub "\\y${v}\\y" $array_slice_name $val]
+ }
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded"
+ }
+ }
+ }
+
+ # Ensure we reached the final breakpoint. If more tests have been added
+ # to the test script, and this starts failing, then the safety 'while'
+ # loop above might need to be increased.
+ gdb_assert {$found_final_breakpoint} "ran all tests"
}
-gdb_breakpoint "show"
-gdb_continue_to_breakpoint "show"
-gdb_test "up" ".*"
-gdb_test "p array (1:10:2, 1:10:2)" \
- "Fortran array strides are not currently supported"
+foreach_with_prefix repack { on off } {
+ run_test $repack
+}
diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
index a66fa6ba784..6d75a385699 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.f90
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -13,58 +13,368 @@
! 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 show (message, array)
- character (len=*) :: message
+subroutine show_elem (array)
+ integer :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = "
+ write(*, fmt="(I0)", advance="no") array
+ write(*, fmt="(A)", advance="yes") ""
+
+ print *, "" ! Display Element
+end subroutine show_elem
+
+subroutine show_str (array)
+ character (len=*) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+ write (*, fmt="(A)", advance="no") "GDB = '"
+ write (*, fmt="(A)", advance="no") array
+ write (*, fmt="(A)", advance="yes") "'"
+
+ print *, "" ! Display String
+end subroutine show_str
+
+subroutine show_1d (array)
+ integer, dimension (:) :: array
+
+ print *, "Array Contents:"
+ print *, ""
+
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ write(*, fmt="(i4)", advance="no") array (i)
+ end do
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (i > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+
+ print *, "" ! Display Array Slice 1D
+end subroutine show_1d
+
+subroutine show_2d (array)
integer, dimension (:,:) :: array
- print *, message
+ print *, "Array Contents:"
+ print *, ""
+
do i=LBOUND (array, 2), UBOUND (array, 2), 1
do j=LBOUND (array, 1), UBOUND (array, 1), 1
write(*, fmt="(i4)", advance="no") array (j, i)
end do
print *, ""
- end do
- print *, array
- print *, ""
+ end do
-end subroutine show
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
-program test
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (i > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (j > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 2D
+end subroutine show_2d
+
+subroutine show_3d (array)
+ integer, dimension (:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (i > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (j > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (k > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 3D
+end subroutine show_3d
+
+subroutine show_4d (array)
+ integer, dimension (:,:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ if (i > LBOUND (array, 4)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (j > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (k > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (l > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (l, k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 4D
+end subroutine show_4d
+!
+! Start of test program.
+!
+program test
interface
- subroutine show (message, array)
- character (len=*) :: message
+ subroutine show_str (array)
+ character (len=*) :: array
+ end subroutine show_str
+
+ subroutine show_1d (array)
+ integer, dimension (:) :: array
+ end subroutine show_1d
+
+ subroutine show_2d (array)
integer, dimension(:,:) :: array
- end subroutine show
+ end subroutine show_2d
+
+ subroutine show_3d (array)
+ integer, dimension(:,:,:) :: array
+ end subroutine show_3d
+
+ subroutine show_4d (array)
+ integer, dimension(:,:,:,:) :: array
+ end subroutine show_4d
end interface
+ ! Declare variables used in this test.
+ integer, dimension (-10:-1,-10:-2) :: neg_array
integer, dimension (1:10,1:10) :: array
integer, allocatable :: other (:, :)
+ character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz"
+ integer, dimension (-2:2,-2:2,-2:2) :: array3d
+ integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d
+ integer, dimension (10:20) :: array1d
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(-1:9,-1:9), target :: tarray
+ ! Allocate or associate any variables as needed.
allocate (other (-5:4, -2:7))
+ pointer2d => tarray
- do i=LBOUND (array, 2), UBOUND (array, 2), 1
- do j=LBOUND (array, 1), UBOUND (array, 1), 1
- array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
- end do
- end do
+ ! Fill arrays with contents ready for testing.
+ call fill_array_1d (array1d)
+
+ call fill_array_2d (neg_array)
+ call fill_array_2d (array)
+ call fill_array_2d (other)
+ call fill_array_2d (tarray)
+
+ call fill_array_3d (array3d)
+ call fill_array_4d (array4d)
+
+ ! The tests. Each call to a show_* function must have a unique set
+ ! of arguments as GDB uses the arguments are part of the test name
+ ! string, so duplicate arguments will result in duplicate test
+ ! names.
+ !
+ ! If a show_* line ends with VARS=... where '...' is a comma
+ ! separated list of variable names, these variables are assumed to
+ ! be part of the call line, and will be expanded by the test script,
+ ! for example:
+ !
+ ! do x=1,9,1
+ ! do y=x,10,1
+ ! call show_1d (some_array (x,y)) ! VARS=x,y
+ ! end do
+ ! end do
+ !
+ ! In this example the test script will automatically expand 'x' and
+ ! 'y' in order to better test different aspects of GDB. Do take
+ ! care, the expansion is not very "smart", so try to avoid clashing
+ ! with other text on the line, in the example above, avoid variables
+ ! named 'some' or 'array', as these will likely clash with
+ ! 'some_array'.
+ call show_str (str_1)
+ call show_str (str_1 (1:20))
+ call show_str (str_1 (10:20))
- do i=LBOUND (other, 2), UBOUND (other, 2), 1
- do j=LBOUND (other, 1), UBOUND (other, 1), 1
- other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
+ call show_elem (array1d (11))
+ call show_elem (pointer2d (2,3))
+
+ call show_1d (array1d)
+ call show_1d (array1d (13:17))
+ call show_1d (array1d (17:13:-1))
+ call show_1d (array (1:5,1))
+ call show_1d (array4d (1,7,3,:))
+ call show_1d (pointer2d (-1:3, 2))
+ call show_1d (pointer2d (-1, 2:4))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_1d ((array (1:5,1)))
+
+ call show_2d (pointer2d)
+ call show_2d (array)
+ call show_2d (array (1:5,1:5))
+ do i=1,10,2
+ do j=1,10,3
+ call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j
+ call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j
end do
end do
+ call show_2d (array (6:2:-1,3:9))
+ call show_2d (array (1:10:2, 1:10:2))
+ call show_2d (other)
+ call show_2d (other (-5:0, -2:0))
+ call show_2d (other (-5:4:2, -2:7:3))
+ call show_2d (neg_array)
+ call show_2d (neg_array (-10:-3,-8:-4:2))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_2d ((array (1:10:3, 1:10:2)))
+ call show_2d ((neg_array (-10:-3,-8:-4:2)))
- call show ("array", array)
- call show ("array (1:5,1:5)", array (1:5,1:5))
- call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
- call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
- call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
+ call show_3d (array3d)
+ call show_3d (array3d(-1:1,-1:1,-1:1))
+ call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1))
- call show ("other", other)
- call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
- call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1)))
+ call show_4d (array4d)
+ call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1))
+ call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1)))
+
+ ! All done. Deallocate.
deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
end program test
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
index 04296ac80c9..0ab74fbbe90 100644
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -44,7 +44,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
gdb_test "print sizeof(vla1(3,2,1))" "4" \
"print sizeof element from allocated vla1"
-gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
+gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
"print sizeof sliced vla1"
# Try to access values in undefined pointer to VLA (dangling)
@@ -61,7 +61,7 @@ gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
gdb_test "print sizeof(pvla(3,2,1))" "4" \
"print sizeof element from associated pvla"
-gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
+gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv5 3/4] gdb/fortran: add support for parsing array strides in expressions
2020-10-11 18:12 ` [PATCHv5 3/4] gdb/fortran: add support for parsing array strides in expressions Andrew Burgess
@ 2020-10-12 13:21 ` Simon Marchi
2020-10-20 20:17 ` Tom Tromey
2020-10-22 10:42 ` Andrew Burgess
2 siblings, 0 replies; 62+ messages in thread
From: Simon Marchi @ 2020-10-12 13:21 UTC (permalink / raw)
To: Andrew Burgess, gdb-patches
Just some nits:
On 2020-10-11 2:12 p.m., Andrew Burgess wrote:
> @@ -314,6 +318,40 @@ subrange: ':' %prec ABOVE_COMMA
> write_exp_elt_opcode (pstate, OP_RANGE); }
> ;
>
> +/* And each of the four subrange types can also have a stride. */
> +subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
> + { write_exp_elt_opcode (pstate, OP_RANGE);
> + write_exp_elt_longcst (pstate,
> + (RANGE_STANDARD
> + | RANGE_HAS_STRIDE));
It's no necessary to have "RANGE_STANDARD" here.
> @@ -141,6 +141,14 @@ value_f90_subarray (struct value *array,
> else
> high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
>
> + if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
For consistency with the code just above this, this could be just:
if (range_flag & RANGE_HAS_STRIDE)
> diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
> index 31f95a3668d..a0e1d1fe8fc 100644
> --- a/gdb/testsuite/gdb.fortran/array-slices.exp
> +++ b/gdb/testsuite/gdb.fortran/array-slices.exp
> @@ -69,3 +69,18 @@ foreach result $array_contents msg $message_strings {
> }
>
> gdb_continue_to_breakpoint "continue to Final Breakpoint"
> +
> +# Next test that asking for an array with stride at the CLI gives an
> +# error.
> +clean_restart ${testfile}
> +
> +if ![fortran_runto_main] then {
> + perror "couldn't run to main"
> + continue
> +}
> +
> +gdb_breakpoint "show"
> +gdb_continue_to_breakpoint "show"
> +gdb_test "up" ".*"
> +gdb_test "p array (1:10:2, 1:10:2)" \
> + "Fortran array strides are not currently supported"
It would be better to give an name to this test, since the command ends
with a parenthesis, or remove the space, as mentioned here:
https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Do_not_use_.22tail_parentheses.22_on_test_messages
Simon
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv5 4/4] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-10-11 18:12 ` [PATCHv5 4/4] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
@ 2020-10-12 14:10 ` Simon Marchi
2020-10-20 20:45 ` Tom Tromey
2020-10-31 22:16 ` [PATCHv6] " Andrew Burgess
2 siblings, 0 replies; 62+ messages in thread
From: Simon Marchi @ 2020-10-12 14:10 UTC (permalink / raw)
To: Andrew Burgess, gdb-patches
On 2020-10-11 2:12 p.m., Andrew Burgess wrote:
> This commit brings array slice support to GDB.
>
> WARNING: This patch contains a rather big hack which is limited to
> Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More
> details on this below.
>
> This patch rewrites two areas of GDB's Fortran support, the code to
> extract an array slice, and the code to print an array.
>
> After this commit a user can, from the GDB prompt, ask for a slice of
> a Fortran array and should get the correct result back. Slices can
> (optionally) have the lower bound, upper bound, and a stride
> specified. Slices can also have a negative stride.
>
> Fortran has the concept of repacking array slices. Within a compiled
> Fortran program if a user passes a non-contiguous array slice to a
> function then the compiler may have to repack the slice, this involves
> copying the elements of the slice to a new area of memory before the
> call, and copying the elements back to the original array after the
> call. Whether repacking occurs will depend on which version of
> Fortran is being used, and what type of function is being called.
>
> This commit adds support for both packed, and unpacked array slicing,
> with the default being unpacked.
>
> With an unpacked array slice, when the user asks for a slice of an
> array GDB creates a new type that accurately describes where the
> elements of the slice can be found within the original array, a
> value of this type is then returned to the user. The address of an
> element within the slice will be equal to the address of an element
> within the original array.
>
> A user can choose to selected packed array slices instead using:
"to selected"
>
> (gdb) set fortran repack-array-slices on|off
> (gdb) show fortran repack-array-slices
>
> With packed array slices GDB creates a new type that reflects how the
> elements of the slice would look if they were laid out in contiguous
> memory, allocates a value of this type, and then fetches the elements
> from the original array and places then into the contents buffer of
> the new value.
>
> One benefit of using packed slices over unapacked slices is the memory
"unapacked"
> diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h
> new file mode 100644
> index 00000000000..395c26e5350
> --- /dev/null
> +++ b/gdb/f-array-walker.h
> @@ -0,0 +1,255 @@
> +/* Copyright (C) 2020 Free Software Foundation, Inc.
> +
> + This file is part of GDB.
> +
> + 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/>. */
> +
> +/* Support classes to wrap up the process of iterating over a
> + multi-dimensional Fortran array. */
> +
> +#ifndef F_ARRAY_WALKER_H
> +#define F_ARRAY_WALKER_H
> +
> +#include "defs.h"
> +#include "gdbtypes.h"
> +#include "f-lang.h"
> +
> +/* Class for calculating the byte offset for elements within a single
> + dimension of a Fortran array. */
> +class fortran_array_offset_calculator
> +{
> +public:
> + /* Create a new offset calculator for TYPE, which is either an array or a
> + string. */
> + fortran_array_offset_calculator (struct type *type)
> + {
> + /* Validate the type. */
> + type = check_typedef (type);
> + if (type->code () != TYPE_CODE_ARRAY
> + && (type->code () != TYPE_CODE_STRING))
> + error (_("can only compute offsets for arrays and strings"));
> +
> + /* Get the range, and extract the bounds. */
> + struct type *range_type = type->index_type ();
> + if (get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound) < 0)
> + error ("unable to read array bounds");
> +
> + /* Figure out the stride for this array. */
> + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
> + m_stride = type->index_type ()->bounds ()->bit_stride ();
> + if (m_stride == 0)
> + m_stride = type_length_units (elt_type);
> + else
> + {
> + struct gdbarch *arch = get_type_arch (elt_type);
> + int unit_size = gdbarch_addressable_memory_unit_size (arch);
> + m_stride /= (unit_size * 8);
> + }
> + };
> +
> + /* Get the byte offset for element INDEX within the type we are working
> + on. There is no bounds checking done on INDEX. If the stride is
> + negative then we still assume that the base address (for the array
> + object) points to the element with the lowest memory address, we then
> + calculate an offset assuming that index 0 will be the element at the
> + highest address, index 1 the next highest, and so on. This is not
> + quite how Fortran works in reality; in reality the base address of
> + the object would point at the element with the highest address, and
> + we would index backwards from there in the "normal" way, however,
> + GDB's current value contents model doesn't support having the base
> + address be near to the end of the value contents, so we currently
> + adjust the base address of Fortran arrays with negative strides so
> + their base address points at the lowest memory address. This code
> + here is part of working around this weirdness. */
I didn't quite catch this, but I think it's just because I'm missing
some knowledge about how Fortran arrays work. But it looks well
explained enough that if I needed to fix something here, I could
understand what is happening.
> + LONGEST index_offset (LONGEST index)
> + {
> + LONGEST offset;
> + if (m_stride < 0)
> + offset = std::abs (m_stride) * (m_upperbound - index);
> + else
> + offset = std::abs (m_stride) * (index - m_lowerbound);
> + return offset;
> + }
> +
> +private:
> +
> + /* The stride for the type we are working with. */
> + LONGEST m_stride;
> +
> + /* The upper bound for the type we are working with. */
> + LONGEST m_upperbound;
> +
> + /* The lower bound for the type we are working with. */
> + LONGEST m_lowerbound;
> +};
> +
> +/* A base class used by fortran_array_walker. */
> +class fortran_array_walker_base_impl
> +{
> +public:
> + /* Constructor. */
> + explicit fortran_array_walker_base_impl ()
> + { /* Nothing. */ }
> +
> + /* Called when iterating between the lower and upper bounds of each
> + dimension of the array. Return true if GDB should continue iterating,
> + otherwise, return false.
> +
> + SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
> + be taken into consideration when deciding what to return. If
> + SHOULD_CONTINUE is false then this function must also return false,
> + the function is still called though in case extra work needs to be
> + done as part of the stopping process. */
> + bool continue_walking (bool should_continue)
> + { return should_continue; }
> +
> + /* Called when GDB starts iterating over a dimension of the array. This
> + function will be called once for each of the bounds in this dimension.
> + DIM is the current dimension number, NDIM is the total number of
> + dimensions, and FIRST_P is true for the first bound of this
> + dimension, and false in all other cases. */
> + void start_dimension (int dim, int ndim, bool first_p)
> + { /* Nothing. */ }
> +
> + /* Called when GDB finishes iterating over a dimension of the array.
> + This function will be called once for each of the bounds in this
> + dimension. DIM is the current dimension number, NDIM is the total
> + number of dimensions, and LAST_P is true for the last bound of this
> + dimension, and false in all other cases. */
> + void finish_dimension (int dim, int ndim, bool last_p)
> + { /* Nothing. */ }
> +
> + /* Called when processing the inner most dimension of the array, for
> + every element in the array. PARENT_VALUE is the value from which
> + elements are being extracted, ELT_TYPE is the type of the element
> + being extracted, and ELT_OFF is the offset of the element from the
> + start of PARENT_VALUE. */
> + void process_element (struct value *parent_value, struct type *elt_type,
> + LONGEST elt_off)
> + { /* Nothing. */ }
> +};
I don't understand when start_dimension and finish_dimension get called
exactly. Looking at the implementation, it looks like it will be
something like this:
start_dimension(1, 3, true)
start_dimension(2, 3, true)
start_dimension(3, 3, true)
process_element(element at (1,1,1))
finish_dimension(3, 3, false)
start_dimension(3, 3, false)
process_element(element (1,1,2))
finish_dimension(3, 3, true)
finish_dimension(2, 3, false)
start_dimension(2, 3, false)
start_dimension(3, 3, true)
process_element(element at (1,2,1))
finish_dimension(3, 3, false)
start_dimension(3, 3, false)
process_element(element (1,2,2))
finish_dimension(3, 3, true)
finish_dimension(2, 3, false)
finish_dimension(1, 3, false)
start_dimension(1, 3, false)
start_dimension(2, 3, true)
start_dimension(3, 3, true)
process_element(element at (2,1,1))
finish_dimension(3, 3, false)
start_dimension(3, 3, false)
process_element(element (2,1,2))
finish_dimension(3, 3, true)
finish_dimension(2, 3, false)
start_dimension(2, 3, false)
start_dimension(3, 3, true)
process_element(element at (2,2,1))
finish_dimension(3, 3, false)
start_dimension(3, 3, false)
process_element(element (2,2,2))
finish_dimension(3, 3, true)
finish_dimension(2, 3, false)
finish_dimension(1, 3, false)
Essentially for the inner dimention, walk_1 calls start_dimension and
finish_dimension around each single element. That's more than I
expected to given my understanding of start_dimension and
finish_dimension. I expected them to be called just once around once
"scan" of the inner dimension, so every two elements. For the outer
dimension, I would expect a single call to start and finish, as there is
a single "scan" in this dimension. I would expect basically this:
start_dimension(1, 3, ?)
start_dimension(2, 3, ?)
start_dimension(3, 3, ?)
process_element(element at (1,1,1))
process_element(element (1,1,2))
finish_dimension(3, 3, ?)
start_dimension(3, 3, ?)
process_element(element at (1,2,1))
process_element(element (1,2,2))
finish_dimension(3, 3, ?)
finish_dimension(2, 3, ?)
start_dimension(2, 3, ?)
start_dimension(3, 3, ?)
process_element(element at (2,1,1))
process_element(element (2,1,2))
finish_dimension(3, 3, ?)
start_dimension(3, 3, ?)
process_element(element at (2,2,1))
process_element(element (2,2,2))
finish_dimension(3, 3, ?)
finish_dimension(2, 3, ?)
finish_dimension(1, 3, ?)
I omitted the first_p/last_p values, because I am not sure what they
would be. Did I understand the meaning of
start_dimension/finish_dimension wrong?
I don't have time to look at the rest of the patch now, so that is all
for now :).
Simon
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv5 1/4] gdb: Convert enum range_type to a bit field enum
2020-10-11 18:12 ` [PATCHv5 1/4] gdb: Convert enum range_type to a bit field enum Andrew Burgess
@ 2020-10-20 20:16 ` Tom Tromey
0 siblings, 0 replies; 62+ messages in thread
From: Tom Tromey @ 2020-10-20 20:16 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> This feels like its getting a little out of hand, so in this commit I
Andrew> switch the range_type enum over to being a flags style enum. There's
Andrew> one entry to represent no flags being set, then 3 flags to represent
Andrew> the 3 ideas above. Adding stride information will require adding only
Andrew> one more enum flag.
This seems like a good idea to me.
Thank you.
Tom
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv5 2/4] gdb: rename 'enum range_type' to 'enum range_flag'
2020-10-11 18:12 ` [PATCHv5 2/4] gdb: rename 'enum range_type' to 'enum range_flag' Andrew Burgess
@ 2020-10-20 20:16 ` Tom Tromey
0 siblings, 0 replies; 62+ messages in thread
From: Tom Tromey @ 2020-10-20 20:16 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> To avoid confusion with other parts of GDB relating to types and
Andrew> ranges, rename this enum to make it clearer that it is a set of
Andrew> individual flags rather than an enumeration of different types of
Andrew> range.
Andrew> There should be no user visible changes after this commit.
Looks good.
Tom
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv5 3/4] gdb/fortran: add support for parsing array strides in expressions
2020-10-11 18:12 ` [PATCHv5 3/4] gdb/fortran: add support for parsing array strides in expressions Andrew Burgess
2020-10-12 13:21 ` Simon Marchi
@ 2020-10-20 20:17 ` Tom Tromey
2020-10-22 10:42 ` Andrew Burgess
2 siblings, 0 replies; 62+ messages in thread
From: Tom Tromey @ 2020-10-20 20:17 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> With this commit GDB now understands the syntax of Fortran array
Andrew> strides, a user can type an expression including an array stride, but
Andrew> they will only get an error informing them that array strides are not
Andrew> supported.
Andrew> This alone is an improvement on what we had before in GDB, better to
Andrew> give the user a helpful message that a particular feature is not
Andrew> supported than to just claim a syntax error.
Aside from the test suite nit that Simon pointed out, this looks good to
me.
Tom
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv5 4/4] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-10-11 18:12 ` [PATCHv5 4/4] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-10-12 14:10 ` Simon Marchi
@ 2020-10-20 20:45 ` Tom Tromey
2020-10-29 11:08 ` Andrew Burgess
2020-10-31 22:16 ` [PATCHv6] " Andrew Burgess
2 siblings, 1 reply; 62+ messages in thread
From: Tom Tromey @ 2020-10-20 20:45 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> The problem is that, as I see it, the current value contents model
Andrew> assumes that an object base address will be the lowest address within
Andrew> that object, and that the contents of the object start at this base
Andrew> address and occupy the TYPE_LENGTH bytes after that.
Andrew> ( We do have the embedded_offset, which is used for C++ sub-classes,
Andrew> such that an object can start at some offset from the content buffer,
Andrew> however, the assumption that the object then occupies the next
Andrew> TYPE_LENGTH bytes is still true within GDB. )
Relatedly, we had a bug for a while where the Python val-print code
could be given just a virtual base of an object, and it would then try
to examine memory outside this buffer.
I've also considered separating values from memory in some ways.
Here's something weird in gdb... debug this program:
#include <stdio.h>
char b[] = "hello";
struct x {
char *x;
};
int main()
{
struct x val; val.x = b;
printf("%s\n", val.x);
b[1] = 'q';
printf("%s\n", val.x);
return 0;
}
If you stop at the first printf and "print val" you get:
(gdb) p val
$1 = {
x = 0x40200c <b> "hello"
}
Then at the second you can see:
(gdb) p val
$2 = {
x = 0x40200c <b> "hqllo"
}
(gdb) p $1
$3 = {
x = 0x40200c <b> "hqllo"
}
That is, the apparent value of the string in "$1" changed. This happens
because the value only holds the pointer, the contents are read during
printing.
So, sometimes I've wondered if we want to fix that, by say attaching
more memory to the value, say as it is printed.
Another thing I've considered is maybe letting multiple values share
some memory (to avoid duplicating large arrays); or maybe going the
other way and lazily populating arrays when they are used purely as
intermediate values.
Kind of random thoughts, though I suppose the lazy array thing is
similar to something you've done in this patch.
Andrew> Where this hack will show through to the user is if they ask for the
Andrew> address of an array in their program with a negative array stride, the
Andrew> address they get from GDB will not match the address that would be
Andrew> computed within the Fortran program.
Calls for a second hack ;)
FWIW I don't think I really have a problem with your proposed hack.
Andrew> + /* Create a new offset calculator for TYPE, which is either an array or a
Andrew> + string. */
Andrew> + fortran_array_offset_calculator (struct type *type)
Single-argument constructors should normally be explicit.
Andrew> +/* A base class used by fortran_array_walker. */
Andrew> +class fortran_array_walker_base_impl
Andrew> +{
Andrew> +public:
A class with only public methods (and no data) can just be a "struct".
Andrew> + /* Constructor. */
Andrew> + explicit fortran_array_walker_base_impl ()
Andrew> + { /* Nothing. */ }
Doesn't need the constructor.
Andrew> +/* A class to wrap up the process of iterating over a multi-dimensional
Andrew> + Fortran array. IMPL is used to specialise what happens as we walk over
Andrew> + the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
Andrew> + methods than can be used to customise the array walk. */
Andrew> +template<typename Impl>
Andrew> +class fortran_array_walker
This seems to mix compile-time- and runtime- polymorphism.
Maybe the idea was not to have virtual methods? But in that case this:
Andrew> + /* Ensure that Impl is derived from the required base class. This just
Andrew> + ensures that all of the required API methods are available and have a
Andrew> + sensible default implementation. */
Andrew> + gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
... seems weird. I guess the idea is to use method hiding as a kind of
static overriding? But if any method is missing, compilation will just
fail anyway.
Tom
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv5 3/4] gdb/fortran: add support for parsing array strides in expressions
2020-10-11 18:12 ` [PATCHv5 3/4] gdb/fortran: add support for parsing array strides in expressions Andrew Burgess
2020-10-12 13:21 ` Simon Marchi
2020-10-20 20:17 ` Tom Tromey
@ 2020-10-22 10:42 ` Andrew Burgess
2 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-10-22 10:42 UTC (permalink / raw)
To: gdb-patches
I've pushed patches 1, 2, and 3 from this series (after addressing the
issues Simon pointed out in #3).
I'll review the feedback on patch #4 and repost this soon.
Thanks,
Andrew
* Andrew Burgess <andrew.burgess@embecosm.com> [2020-10-11 19:12:12 +0100]:
> With this commit GDB now understands the syntax of Fortran array
> strides, a user can type an expression including an array stride, but
> they will only get an error informing them that array strides are not
> supported.
>
> This alone is an improvement on what we had before in GDB, better to
> give the user a helpful message that a particular feature is not
> supported than to just claim a syntax error.
>
> Before:
>
> (gdb) p array (1:10:2, 2:10:2)
> A syntax error in expression, near `:2, 2:10:2)'.
>
> Now:
>
> (gdb) p array (1:10:2, 2:10:2)
> Fortran array strides are not currently supported
>
> Later commits will allow GDB to handle array strides correctly.
>
> gdb/ChangeLog:
>
> * expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE.
> * expression.h (enum range_type): Add RANGE_HAS_STRIDE.
> * f-exp.y (arglist): Allow for a series of subranges.
> (subrange): Add cases for subranges with strides.
> * f-lang.c (value_f90_subarray): Catch use of array strides and
> throw an error.
> * parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE.
>
> gdb/testsuite/ChangeLog:
>
> * gdb.fortran/array-slices.exp: Add a new test.
> ---
> gdb/ChangeLog | 10 ++++++
> gdb/expprint.c | 4 +++
> gdb/expression.h | 3 ++
> gdb/f-exp.y | 38 ++++++++++++++++++++++
> gdb/f-lang.c | 10 +++++-
> gdb/parse.c | 2 ++
> gdb/testsuite/ChangeLog | 4 +++
> gdb/testsuite/gdb.fortran/array-slices.exp | 15 +++++++++
> 8 files changed, 85 insertions(+), 1 deletion(-)
>
> diff --git a/gdb/expprint.c b/gdb/expprint.c
> index 2dee2bb1932..a14eeb00f19 100644
> --- a/gdb/expprint.c
> +++ b/gdb/expprint.c
> @@ -1120,12 +1120,16 @@ dump_subexp_body_standard (struct expression *exp,
> fputs_filtered ("..", stream);
> if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
> fputs_filtered ("EXP", stream);
> + if (range_flag & RANGE_HAS_STRIDE)
> + fputs_filtered (":EXP", stream);
> fputs_filtered ("'", stream);
>
> if (!(range_flag & RANGE_LOW_BOUND_DEFAULT))
> elt = dump_subexp (exp, stream, elt);
> if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT))
> elt = dump_subexp (exp, stream, elt);
> + if (range_flag & RANGE_HAS_STRIDE)
> + elt = dump_subexp (exp, stream, elt);
> }
> break;
>
> diff --git a/gdb/expression.h b/gdb/expression.h
> index fd483e5f277..8de712310ec 100644
> --- a/gdb/expression.h
> +++ b/gdb/expression.h
> @@ -199,6 +199,9 @@ enum range_flag : unsigned
>
> /* The high bound of this range is exclusive. */
> RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2,
> +
> + /* The range has a stride. */
> + RANGE_HAS_STRIDE = 1 << 3,
> };
>
> DEF_ENUM_FLAGS_TYPE (enum range_flag, range_flags);
> diff --git a/gdb/f-exp.y b/gdb/f-exp.y
> index a3314082d90..f227690cea6 100644
> --- a/gdb/f-exp.y
> +++ b/gdb/f-exp.y
> @@ -284,6 +284,10 @@ arglist : arglist ',' exp %prec ABOVE_COMMA
> { pstate->arglist_len++; }
> ;
>
> +arglist : arglist ',' subrange %prec ABOVE_COMMA
> + { pstate->arglist_len++; }
> + ;
> +
> /* There are four sorts of subrange types in F90. */
>
> subrange: exp ':' exp %prec ABOVE_COMMA
> @@ -314,6 +318,40 @@ subrange: ':' %prec ABOVE_COMMA
> write_exp_elt_opcode (pstate, OP_RANGE); }
> ;
>
> +/* And each of the four subrange types can also have a stride. */
> +subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
> + { write_exp_elt_opcode (pstate, OP_RANGE);
> + write_exp_elt_longcst (pstate,
> + (RANGE_STANDARD
> + | RANGE_HAS_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,
> + (RANGE_HIGH_BOUND_DEFAULT
> + | RANGE_HAS_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,
> + (RANGE_LOW_BOUND_DEFAULT
> + | RANGE_HAS_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,
> + (RANGE_LOW_BOUND_DEFAULT
> + | RANGE_HIGH_BOUND_DEFAULT
> + | RANGE_HAS_STRIDE));
> + write_exp_elt_opcode (pstate, OP_RANGE); }
> + ;
> +
> complexnum: exp ',' exp
> { }
> ;
> diff --git a/gdb/f-lang.c b/gdb/f-lang.c
> index 37d05b27653..b888e3d4122 100644
> --- a/gdb/f-lang.c
> +++ b/gdb/f-lang.c
> @@ -124,7 +124,7 @@ value_f90_subarray (struct value *array,
> struct expression *exp, int *pos, enum noside noside)
> {
> int pc = (*pos) + 1;
> - LONGEST low_bound, high_bound;
> + LONGEST low_bound, high_bound, stride;
> struct type *range = check_typedef (value_type (array)->index_type ());
> enum range_flag range_flag
> = (enum range_flag) longest_to_int (exp->elts[pc].longconst);
> @@ -141,6 +141,14 @@ value_f90_subarray (struct value *array,
> else
> high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
>
> + if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
> + stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> + else
> + stride = 1;
> +
> + if (stride != 1)
> + error (_("Fortran array strides are not currently supported"));
> +
> return value_slice (array, low_bound, high_bound - low_bound + 1);
> }
>
> diff --git a/gdb/parse.c b/gdb/parse.c
> index 4a15de8a499..359ab6211aa 100644
> --- a/gdb/parse.c
> +++ b/gdb/parse.c
> @@ -924,6 +924,8 @@ operator_length_standard (const struct expression *expr, int endpos,
> /* Assume the range has 2 arguments (low bound and high bound), then
> reduce the argument count if any bounds are set to default. */
> args = 2;
> + if (range_flag & RANGE_HAS_STRIDE)
> + ++args;
> if (range_flag & RANGE_LOW_BOUND_DEFAULT)
> --args;
> if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
> diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
> index 31f95a3668d..a0e1d1fe8fc 100644
> --- a/gdb/testsuite/gdb.fortran/array-slices.exp
> +++ b/gdb/testsuite/gdb.fortran/array-slices.exp
> @@ -69,3 +69,18 @@ foreach result $array_contents msg $message_strings {
> }
>
> gdb_continue_to_breakpoint "continue to Final Breakpoint"
> +
> +# Next test that asking for an array with stride at the CLI gives an
> +# error.
> +clean_restart ${testfile}
> +
> +if ![fortran_runto_main] then {
> + perror "couldn't run to main"
> + continue
> +}
> +
> +gdb_breakpoint "show"
> +gdb_continue_to_breakpoint "show"
> +gdb_test "up" ".*"
> +gdb_test "p array (1:10:2, 1:10:2)" \
> + "Fortran array strides are not currently supported"
> --
> 2.25.4
>
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv5 4/4] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-10-20 20:45 ` Tom Tromey
@ 2020-10-29 11:08 ` Andrew Burgess
0 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-10-29 11:08 UTC (permalink / raw)
To: Tom Tromey; +Cc: gdb-patches
* Tom Tromey <tom@tromey.com> [2020-10-20 14:45:49 -0600]:
> >>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
>
> Andrew> The problem is that, as I see it, the current value contents model
> Andrew> assumes that an object base address will be the lowest address within
> Andrew> that object, and that the contents of the object start at this base
> Andrew> address and occupy the TYPE_LENGTH bytes after that.
>
> Andrew> ( We do have the embedded_offset, which is used for C++ sub-classes,
> Andrew> such that an object can start at some offset from the content buffer,
> Andrew> however, the assumption that the object then occupies the next
> Andrew> TYPE_LENGTH bytes is still true within GDB. )
>
> Relatedly, we had a bug for a while where the Python val-print code
> could be given just a virtual base of an object, and it would then try
> to examine memory outside this buffer.
>
> I've also considered separating values from memory in some ways.
>
> Here's something weird in gdb... debug this program:
>
> #include <stdio.h>
> char b[] = "hello";
> struct x {
> char *x;
> };
> int main()
> {
> struct x val; val.x = b;
> printf("%s\n", val.x);
> b[1] = 'q';
> printf("%s\n", val.x);
> return 0;
> }
>
> If you stop at the first printf and "print val" you get:
>
> (gdb) p val
> $1 = {
> x = 0x40200c <b> "hello"
> }
>
> Then at the second you can see:
>
> (gdb) p val
> $2 = {
> x = 0x40200c <b> "hqllo"
> }
> (gdb) p $1
> $3 = {
> x = 0x40200c <b> "hqllo"
> }
>
> That is, the apparent value of the string in "$1" changed. This happens
> because the value only holds the pointer, the contents are read during
> printing.
>
> So, sometimes I've wondered if we want to fix that, by say attaching
> more memory to the value, say as it is printed.
I would like that too I think.
I've wondered whether a model where the value provides some kind of
data cache like behaviour would work. But we'd attach and detach
different value caches at different times.
So when we read the value of V1 we "attach" V1 as the current caching
value we'd then cache all memory that ends up being read within the
value - assuming of course that the content is not already cached.
After we've finished reading V1 and displayed it (or whatever) V1
would be "detached".
Later when we want to reread V1 we again "attach" V1, only this time
the content will already be cached on the value...
>
> Another thing I've considered is maybe letting multiple values share
> some memory (to avoid duplicating large arrays); or maybe going the
> other way and lazily populating arrays when they are used purely as
> intermediate values.
This, please, yes!
>
> Kind of random thoughts, though I suppose the lazy array thing is
> similar to something you've done in this patch.
>
> Andrew> Where this hack will show through to the user is if they ask for the
> Andrew> address of an array in their program with a negative array stride, the
> Andrew> address they get from GDB will not match the address that would be
> Andrew> computed within the Fortran program.
>
> Calls for a second hack ;)
Yes. Or to maybe fix the value base address, content address issue
properly, which is what I'd like to do.
Getting this in first is good (I think) as (1) it adds some useful
functionality to GDB, even if it does have at least one known rough
edge, and (2) it provides more things to test a real fix for the base
address / content address issue against.
>
> FWIW I don't think I really have a problem with your proposed hack.
Thanks.
>
> Andrew> + /* Create a new offset calculator for TYPE, which is either an array or a
> Andrew> + string. */
> Andrew> + fortran_array_offset_calculator (struct type *type)
>
> Single-argument constructors should normally be explicit.
Fixed.
>
> Andrew> +/* A base class used by fortran_array_walker. */
> Andrew> +class fortran_array_walker_base_impl
> Andrew> +{
> Andrew> +public:
>
> A class with only public methods (and no data) can just be a "struct".
Fixed.
>
> Andrew> + /* Constructor. */
> Andrew> + explicit fortran_array_walker_base_impl ()
> Andrew> + { /* Nothing. */ }
>
> Doesn't need the constructor.
Fixed.
>
> Andrew> +/* A class to wrap up the process of iterating over a multi-dimensional
> Andrew> + Fortran array. IMPL is used to specialise what happens as we walk over
> Andrew> + the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
> Andrew> + methods than can be used to customise the array walk. */
> Andrew> +template<typename Impl>
> Andrew> +class fortran_array_walker
>
> This seems to mix compile-time- and runtime- polymorphism.
>
> Maybe the idea was not to have virtual methods? But in that case this:
Unless I've mucked up I don't think there _are_ any virtual methods.
>
> Andrew> + /* Ensure that Impl is derived from the required base class. This just
> Andrew> + ensures that all of the required API methods are available and have a
> Andrew> + sensible default implementation. */
> Andrew> + gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
>
> ... seems weird. I guess the idea is to use method hiding as a kind of
> static overriding? But if any method is missing, compilation will just
> fail anyway.
Your guess is exactly correct. I could delete this line, this would
have the benefit that, like you say if any methods are missing things
will just fail at compile time, and I could use _any_ class, not just
sub-classes of fortran_array_walker_base_impl.
The benefit of keeping the line (that I was aiming for) is it I didn't
imagine any sensible use of this class where we didn't specialise
using a sub-class of fortran_array_walker_base_impl. The static
assert has zero runtime cost, and, should a developer try using a
non-sub-class, they'll be told explicitly sub-class this thing.
Alternatively I can rewrite the comment to make things clearer. Do
you think there's a rewritten comment that you'd be happy with? I'm
really not that attached to this one line. If you really don't like
it, it's gone! Let me know your thoughts.
Thanks,
Andrew
^ permalink raw reply [flat|nested] 62+ messages in thread
* [PATCHv6] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-10-11 18:12 ` [PATCHv5 4/4] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-10-12 14:10 ` Simon Marchi
2020-10-20 20:45 ` Tom Tromey
@ 2020-10-31 22:16 ` Andrew Burgess
2020-11-12 12:09 ` Andrew Burgess
` (2 more replies)
2 siblings, 3 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-10-31 22:16 UTC (permalink / raw)
To: gdb-patches
The changes in v6 are:
- Rebase on current master,
- Have addressed the typos and minor issues pointed out by Simon and
Tom,
- The f-array-walker.h logic has been rewritten slightly after
Simon's feedback. Hopefully the logic is slightly clearer now.
This did actually improve the code a little, the outer parenthesis
are now printed as part of the fortran_print_array logic, rather
than being printed elsewhere.
There's still a pending question from Tom
w.r.t. fortran_array_walker_base_impl, but this is what I have for
now.
Thanks,
Andrew
---
[PATCH] gdb/fortran: Add support for Fortran array slices at the GDB prompt
This commit brings array slice support to GDB.
WARNING: This patch contains a rather big hack which is limited to
Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More
details on this below.
This patch rewrites two areas of GDB's Fortran support, the code to
extract an array slice, and the code to print an array.
After this commit a user can, from the GDB prompt, ask for a slice of
a Fortran array and should get the correct result back. Slices can
(optionally) have the lower bound, upper bound, and a stride
specified. Slices can also have a negative stride.
Fortran has the concept of repacking array slices. Within a compiled
Fortran program if a user passes a non-contiguous array slice to a
function then the compiler may have to repack the slice, this involves
copying the elements of the slice to a new area of memory before the
call, and copying the elements back to the original array after the
call. Whether repacking occurs will depend on which version of
Fortran is being used, and what type of function is being called.
This commit adds support for both packed, and unpacked array slicing,
with the default being unpacked.
With an unpacked array slice, when the user asks for a slice of an
array GDB creates a new type that accurately describes where the
elements of the slice can be found within the original array, a
value of this type is then returned to the user. The address of an
element within the slice will be equal to the address of an element
within the original array.
A user can choose to select packed array slices instead using:
(gdb) set fortran repack-array-slices on|off
(gdb) show fortran repack-array-slices
With packed array slices GDB creates a new type that reflects how the
elements of the slice would look if they were laid out in contiguous
memory, allocates a value of this type, and then fetches the elements
from the original array and places then into the contents buffer of
the new value.
One benefit of using packed slices over unpacked slices is the memory
usage, taking a small slice of N elements from a large array will
require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked
array will also include all of the "padding" between the
non-contiguous elements. There are new tests added that highlight
this difference.
There is also a new debugging flag added with this commit that
introduces these commands:
(gdb) set debug fortran-array-slicing on|off
(gdb) show debug fortran-array-slicing
This prints information about how the array slices are being built.
As both the repacking, and the array printing requires GDB to walk
through a multi-dimensional Fortran array visiting each element, this
commit adds the file f-array-walk.h, which introduces some
infrastructure to support this process. This means the array printing
code in f-valprint.c is significantly reduced.
The only slight issue with this commit is the "rather big hack" that I
mentioned above. This hack allows us to handle one specific case,
array slices with negative strides. This is something that I don't
believe the current GDB value contents model will allow us to
correctly handle, and rather than rewrite the value contents code
right now, I'm hoping to slip this hack in as a work around.
The problem is that, as I see it, the current value contents model
assumes that an object base address will be the lowest address within
that object, and that the contents of the object start at this base
address and occupy the TYPE_LENGTH bytes after that.
( We do have the embedded_offset, which is used for C++ sub-classes,
such that an object can start at some offset from the content buffer,
however, the assumption that the object then occupies the next
TYPE_LENGTH bytes is still true within GDB. )
The problem is that Fortran arrays with a negative stride don't follow
this pattern. In this case the base address of the object points to
the element with the highest address, the contents of the array then
start at some offset _before_ the base address, and proceed for one
element _past_ the base address.
As the stride for such an array would be negative then, in theory the
TYPE_LENGTH for this type would also be negative. However, in many
places a value in GDB will degrade to a pointer + length, and the
length almost always comes from the TYPE_LENGTH.
It is my belief that in order to correctly model this case the value
content handling of GDB will need to be reworked to split apart the
value's content buffer (which is a block of memory with a length), and
the object's in memory base address and length, which could be
negative.
Things are further complicated because arrays with negative strides
like this are always dynamic types. When a value has a dynamic type
and its base address needs resolving we actually store the address of
the object within the resolved dynamic type, not within the value
object itself.
In short I don't currently see an easy path to cleanly support this
situation within GDB. And so I believe that leaves two options,
either add a work around, or catch cases where the user tries to make
use of a negative stride, or access an array with a negative stride,
and throw an error.
This patch currently goes with adding a work around, which is that
when we resolve a dynamic Fortran array type, if the stride is
negative, then we adjust the base address to point to the lowest
address required by the array. The printing and slicing code is aware
of this adjustment and will correctly slice and print Fortran arrays.
Where this hack will show through to the user is if they ask for the
address of an array in their program with a negative array stride, the
address they get from GDB will not match the address that would be
computed within the Fortran program.
gdb/ChangeLog:
* Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
* NEWS: Mention new options.
* f-array-walker.h: New file.
* f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
(repack_array_slices): New static global.
(show_repack_array_slices): New function.
(fortran_array_slicing_debug): New static global.
(show_fortran_array_slicing_debug): New function.
(value_f90_subarray): Delete.
(skip_undetermined_arglist): Delete.
(class fortran_array_repacker_base_impl): New class.
(class fortran_lazy_array_repacker_impl): New class.
(class fortran_array_repacker_impl): New class.
(fortran_value_subarray): Complete rewrite.
(set_fortran_list): New static global.
(show_fortran_list): Likewise.
(_initialize_f_language): Register new commands.
(fortran_adjust_dynamic_array_base_address_hack): New function.
* f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
Declare.
* f-valprint.c: Include 'f-array-walker.h'.
(class fortran_array_printer_impl): New class.
(f77_print_array_1): Delete.
(f77_print_array): Delete.
(fortran_print_array): New.
(f_value_print_inner): Update to call fortran_print_array.
* gdbtypes.c: Include 'f-lang.h'.
(resolve_dynamic_type_internal): Call
fortran_adjust_dynamic_array_base_address_hack.
gdb/testsuite/ChangeLog:
* gdb.fortran/array-slices-bad.exp: New file.
* gdb.fortran/array-slices-bad.f90: New file.
* gdb.fortran/array-slices-sub-slices.exp: New file.
* gdb.fortran/array-slices-sub-slices.f90: New file.
* gdb.fortran/array-slices.exp: Rewrite tests.
* gdb.fortran/array-slices.f90: Rewrite tests.
* gdb.fortran/vla-sizeof.exp: Correct expected results.
gdb/doc/ChangeLog:
* gdb.texinfo (Debugging Output): Document 'set/show debug
fortran-array-slicing'.
(Special Fortran Commands): Document 'set/show fortran
repack-array-slices'.
---
gdb/ChangeLog | 32 +
gdb/Makefile.in | 1 +
gdb/NEWS | 13 +
gdb/doc/ChangeLog | 7 +
gdb/doc/gdb.texinfo | 32 +
gdb/f-array-walker.h | 265 +++++++
gdb/f-lang.c | 712 ++++++++++++++++--
gdb/f-lang.h | 19 +-
gdb/f-valprint.c | 187 +++--
gdb/gdbtypes.c | 12 +-
gdb/testsuite/ChangeLog | 10 +
.../gdb.fortran/array-slices-bad.exp | 69 ++
.../gdb.fortran/array-slices-bad.f90 | 42 ++
.../gdb.fortran/array-slices-sub-slices.exp | 111 +++
.../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
gdb/testsuite/gdb.fortran/array-slices.exp | 277 +++++--
gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
18 files changed, 1998 insertions(+), 255 deletions(-)
create mode 100644 gdb/f-array-walker.h
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
diff --git a/gdb/Makefile.in b/gdb/Makefile.in
index 8a160896e2c..1838743a883 100644
--- a/gdb/Makefile.in
+++ b/gdb/Makefile.in
@@ -1273,6 +1273,7 @@ HFILES_NO_SRCDIR = \
expression.h \
extension.h \
extension-priv.h \
+ f-array-walker.h \
f-lang.h \
fbsd-nat.h \
fbsd-tdep.h \
diff --git a/gdb/NEWS b/gdb/NEWS
index c99d3181a8b..be4b2956f17 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -153,6 +153,19 @@ maintenance print core-file-backed-mappings
Prints file-backed mappings loaded from a core file's note section.
Output is expected to be similar to that of "info proc mappings".
+set debug fortran-array-slicing on|off
+show debug fortran-array-slicing
+ Print debugging when taking slices of Fortran arrays.
+
+set fortran repack-array-slices on|off
+show fortran repack-array-slices
+ When taking slices from Fortran arrays and strings, if the slice is
+ non-contiguous within the original value then, when this option is
+ on, the new value will be repacked into a single contiguous value.
+ When this option is off, then the value returned will consist of a
+ descriptor that describes the slice within the memory of the
+ original parent value.
+
* Changed commands
alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...]
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index d779d4a84f1..9e21d65c650 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -16989,6 +16989,29 @@
block whose name is @var{common-name}. With no argument, the names of
all @code{COMMON} blocks visible at the current program location are
printed.
+@cindex arrays slices (Fortran)
+@kindex set fortran repack-array-slices
+@kindex show fortran repack-array-slices
+@item set fortran repack-array-slices [on|off]
+@item show fortran repack-array-slices
+When taking a slice from an array, a Fortran compiler can choose to
+either produce an array descriptor that describes the slice in place,
+or it may repack the slice, copying the elements of the slice into a
+new region of memory.
+
+When this setting is on, then @value{GDBN} will also repack array
+slices in some situations. When this setting is off, then
+@value{GDBN} will create array descriptors for slices that reference
+the original data in place.
+
+@value{GDBN} will never repack an array slice if the data for the
+slice is contiguous within the original array.
+
+@value{GDBN} will always repack string slices if the data for the
+slice is non-contiguous within the original string as @value{GDBN}
+does not support printing non-contiguous strings.
+
+The default for this setting is @code{off}.
@end table
@node Pascal
@@ -26581,6 +26604,15 @@
@item show debug fbsd-nat
Show the current state of FreeBSD native target debugging messages.
+@item set debug fortran-array-slicing
+@cindex fortran array slicing debugging info
+Turns on or off display of @value{GDBN} Fortran array slicing
+debugging info. The default is off.
+
+@item show debug fortran-array-slicing
+Displays the current state of displaying @value{GDBN} Fortran array
+slicing debugging info.
+
@item set debug frame
@cindex frame debugging info
Turns on or off display of @value{GDBN} frame debugging info. The
diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h
new file mode 100644
index 00000000000..417f9f07980
--- /dev/null
+++ b/gdb/f-array-walker.h
@@ -0,0 +1,265 @@
+/* Copyright (C) 2020 Free Software Foundation, Inc.
+
+ This file is part of GDB.
+
+ 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/>. */
+
+/* Support classes to wrap up the process of iterating over a
+ multi-dimensional Fortran array. */
+
+#ifndef F_ARRAY_WALKER_H
+#define F_ARRAY_WALKER_H
+
+#include "defs.h"
+#include "gdbtypes.h"
+#include "f-lang.h"
+
+/* Class for calculating the byte offset for elements within a single
+ dimension of a Fortran array. */
+class fortran_array_offset_calculator
+{
+public:
+ /* Create a new offset calculator for TYPE, which is either an array or a
+ string. */
+ explicit fortran_array_offset_calculator (struct type *type)
+ {
+ /* Validate the type. */
+ type = check_typedef (type);
+ if (type->code () != TYPE_CODE_ARRAY
+ && (type->code () != TYPE_CODE_STRING))
+ error (_("can only compute offsets for arrays and strings"));
+
+ /* Get the range, and extract the bounds. */
+ struct type *range_type = type->index_type ();
+ if (get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound) < 0)
+ error ("unable to read array bounds");
+
+ /* Figure out the stride for this array. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ m_stride = type->index_type ()->bounds ()->bit_stride ();
+ if (m_stride == 0)
+ m_stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ m_stride /= (unit_size * 8);
+ }
+ };
+
+ /* Get the byte offset for element INDEX within the type we are working
+ on. There is no bounds checking done on INDEX. If the stride is
+ negative then we still assume that the base address (for the array
+ object) points to the element with the lowest memory address, we then
+ calculate an offset assuming that index 0 will be the element at the
+ highest address, index 1 the next highest, and so on. This is not
+ quite how Fortran works in reality; in reality the base address of
+ the object would point at the element with the highest address, and
+ we would index backwards from there in the "normal" way, however,
+ GDB's current value contents model doesn't support having the base
+ address be near to the end of the value contents, so we currently
+ adjust the base address of Fortran arrays with negative strides so
+ their base address points at the lowest memory address. This code
+ here is part of working around this weirdness. */
+ LONGEST index_offset (LONGEST index)
+ {
+ LONGEST offset;
+ if (m_stride < 0)
+ offset = std::abs (m_stride) * (m_upperbound - index);
+ else
+ offset = std::abs (m_stride) * (index - m_lowerbound);
+ return offset;
+ }
+
+private:
+
+ /* The stride for the type we are working with. */
+ LONGEST m_stride;
+
+ /* The upper bound for the type we are working with. */
+ LONGEST m_upperbound;
+
+ /* The lower bound for the type we are working with. */
+ LONGEST m_lowerbound;
+};
+
+/* A base class used by fortran_array_walker. There's no virtual methods
+ here, sub-classes should just override the functions they want in order
+ to specialise the behaviour to their needs. The functionality
+ provided in these default implementations will visit every array
+ element, but do nothing for each element. */
+
+struct fortran_array_walker_base_impl
+{
+ /* Called when iterating between the lower and upper bounds of each
+ dimension of the array. Return true if GDB should continue iterating,
+ otherwise, return false.
+
+ SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
+ be taken into consideration when deciding what to return. If
+ SHOULD_CONTINUE is false then this function must also return false,
+ the function is still called though in case extra work needs to be
+ done as part of the stopping process. */
+ bool continue_walking (bool should_continue)
+ { return should_continue; }
+
+ /* Called when GDB starts iterating over a dimension of the array. The
+ argument INNER_P is true for the inner most dimension (the dimension
+ containing the actual elements of the array), and false for more outer
+ dimensions. For a concrete example of how this function is called
+ see the comment on process_element below. */
+ void start_dimension (bool inner_p)
+ { /* Nothing. */ }
+
+ /* Called when GDB finishes iterating over a dimension of the array. The
+ argument INNER_P is true for the inner most dimension (the dimension
+ containing the actual elements of the array), and false for more outer
+ dimensions. LAST_P is true for the last call at a particular
+ dimension. For a concrete example of how this function is called
+ see the comment on process_element below. */
+ void finish_dimension (bool inner_p, bool last_p)
+ { /* Nothing. */ }
+
+ /* Called when processing the inner most dimension of the array, for
+ every element in the array. ELT_TYPE is the type of the element being
+ extracted, and ELT_OFF is the offset of the element from the start of
+ array being walked, and LAST_P is true only when this is the last
+ element that will be processed in this dimension.
+
+ Given this two dimensional array ((1, 2) (3, 4)), the calls to
+ start_dimension, process_element, and finish_dimension look like this:
+
+ start_dimension (false);
+ start_dimension (true);
+ process_element (TYPE, OFFSET, false);
+ process_element (TYPE, OFFSET, true);
+ finish_dimension (true, false);
+ start_dimension (true);
+ process_element (TYPE, OFFSET, false);
+ process_element (TYPE, OFFSET, true);
+ finish_dimension (true, true);
+ finish_dimension (false, true); */
+ void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
+ { /* Nothing. */ }
+};
+
+/* A class to wrap up the process of iterating over a multi-dimensional
+ Fortran array. IMPL is used to specialise what happens as we walk over
+ the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
+ methods than can be used to customise the array walk. */
+template<typename Impl>
+class fortran_array_walker
+{
+ /* Ensure that Impl is derived from the required base class. This just
+ ensures that all of the required API methods are available and have a
+ sensible default implementation. */
+ gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
+
+public:
+ /* Create a new array walker. TYPE is the type of the array being walked
+ over, and ADDRESS is the base address for the object of TYPE in
+ memory. All other arguments are forwarded to the constructor of the
+ template parameter class IMPL. */
+ template <typename ...Args>
+ fortran_array_walker (struct type *type, CORE_ADDR address,
+ Args... args)
+ : m_type (type),
+ m_address (address),
+ m_impl (type, address, args...)
+ {
+ m_ndimensions = calc_f77_array_dims (m_type);
+ }
+
+ /* Walk the array. */
+ void
+ walk ()
+ {
+ walk_1 (1, m_type, 0, false);
+ }
+
+private:
+ /* The core of the array walking algorithm. NSS is the current
+ dimension number being processed, TYPE is the type of this dimension,
+ and OFFSET is the offset (in bytes) for the start of this dimension. */
+ void
+ walk_1 (int nss, struct type *type, int offset, bool last_p)
+ {
+ /* Extract the range, and get lower and upper bounds. */
+ struct type *range_type = check_typedef (type)->index_type ();
+ LONGEST lowerbound, upperbound;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* CALC is used to calculate the offsets for each element in this
+ dimension. */
+ fortran_array_offset_calculator calc (type);
+
+ m_impl.start_dimension (nss == m_ndimensions);
+
+ if (nss != m_ndimensions)
+ {
+ /* For dimensions other than the inner most, walk each element and
+ recurse while peeling off one more dimension of the array. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ /* Use the index and the stride to work out a new offset. */
+ LONGEST new_offset = offset + calc.index_offset (i);
+
+ /* Now print the lower dimension. */
+ struct type *subarray_type
+ = TYPE_TARGET_TYPE (check_typedef (type));
+ walk_1 (nss + 1, subarray_type, new_offset, (i == upperbound));
+ }
+ }
+ else
+ {
+ /* For the inner most dimension of the array, process each element
+ within this dimension. */
+ for (LONGEST i = lowerbound;
+ m_impl.continue_walking (i < upperbound + 1);
+ i++)
+ {
+ LONGEST elt_off = offset + calc.index_offset (i);
+
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
+ if (is_dynamic_type (elt_type))
+ {
+ CORE_ADDR e_address = m_address + elt_off;
+ elt_type = resolve_dynamic_type (elt_type, {}, e_address);
+ }
+
+ m_impl.process_element (elt_type, elt_off, (i == upperbound));
+ }
+ }
+
+ m_impl.finish_dimension (nss == m_ndimensions, last_p || nss == 1);
+ }
+
+ /* The array type being processed. */
+ struct type *m_type;
+
+ /* The address in target memory for the object of M_TYPE being
+ processed. This is required in order to resolve dynamic types. */
+ CORE_ADDR m_address;
+
+ /* An instance of the template specialisation class. */
+ Impl m_impl;
+
+ /* The total number of dimensions in M_TYPE. */
+ int m_ndimensions;
+};
+
+#endif /* F_ARRAY_WALKER_H */
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 52493743031..d9b2e715442 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -36,9 +36,36 @@
#include "c-lang.h"
#include "target-float.h"
#include "gdbarch.h"
+#include "gdbcmd.h"
+#include "f-array-walker.h"
#include <math.h>
+/* Whether GDB should repack array slices created by the user. */
+static bool repack_array_slices = false;
+
+/* Implement 'show fortran repack-array-slices'. */
+static void
+show_repack_array_slices (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c, const char *value)
+{
+ fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"),
+ value);
+}
+
+/* Debugging of Fortran's array slicing. */
+static bool fortran_array_slicing_debug = false;
+
+/* Implement 'show debug fortran-array-slicing'. */
+static void
+show_fortran_array_slicing_debug (struct ui_file *file, int from_tty,
+ struct cmd_list_element *c,
+ const char *value)
+{
+ fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"),
+ value);
+}
+
/* Local functions */
/* Return the encoding that should be used for the character type
@@ -114,57 +141,6 @@ enum f_primitive_types {
nr_f_primitive_types
};
-/* Called from fortran_value_subarray to take a slice of an array or a
- string. ARRAY is the array or string to be accessed. EXP, POS, and
- NOSIDE are as for evaluate_subexp_standard. Return a value that is a
- slice of the array. */
-
-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, stride;
- struct type *range = check_typedef (value_type (array)->index_type ());
- enum range_flag range_flag
- = (enum range_flag) longest_to_int (exp->elts[pc].longconst);
-
- *pos += 3;
-
- if (range_flag & RANGE_LOW_BOUND_DEFAULT)
- low_bound = range->bounds ()->low.const_val ();
- else
- low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
-
- if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
- high_bound = range->bounds ()->high.const_val ();
- else
- high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
-
- if (range_flag & RANGE_HAS_STRIDE)
- stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
- else
- stride = 1;
-
- if (stride != 1)
- error (_("Fortran array strides are not currently supported"));
-
- return value_slice (array, low_bound, high_bound - low_bound + 1);
-}
-
-/* Helper for skipping all the arguments in an undetermined argument list.
- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
- case of evaluate_subexp_standard as multiple, but not all, code paths
- require a generic skip. */
-
-static void
-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
- enum noside noside)
-{
- for (int i = 0; i < nargs; ++i)
- evaluate_subexp (nullptr, exp, pos, noside);
-}
-
/* Return the number of dimensions for a Fortran array or string. */
int
@@ -189,6 +165,145 @@ calc_f77_array_dims (struct type *array_type)
return ndimen;
}
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This is a base class for two alternative repacking mechanisms,
+ one for when repacking from a lazy value, and one for repacking from a
+ non-lazy (already loaded) value. */
+class fortran_array_repacker_base_impl
+ : public fortran_array_walker_base_impl
+{
+public:
+ /* Constructor, DEST is the value we are repacking into. */
+ fortran_array_repacker_base_impl (struct value *dest)
+ : m_dest (dest),
+ m_dest_offset (0)
+ { /* Nothing. */ }
+
+ /* When we start processing the inner most dimension, this is where we
+ will be creating values for each element as we load them and then copy
+ them into the M_DEST value. Set a value mark so we can free these
+ temporary values. */
+ void start_dimension (bool inner_p)
+ {
+ if (inner_p)
+ {
+ gdb_assert (m_mark == nullptr);
+ m_mark = value_mark ();
+ }
+ }
+
+ /* When we finish processing the inner most dimension free all temporary
+ value that were created. */
+ void finish_dimension (bool inner_p, bool last_p)
+ {
+ if (inner_p)
+ {
+ gdb_assert (m_mark != nullptr);
+ value_free_to_mark (m_mark);
+ m_mark = nullptr;
+ }
+ }
+
+protected:
+ /* Copy the contents of array element ELT into M_DEST at the next
+ available offset. */
+ void copy_element_to_dest (struct value *elt)
+ {
+ value_contents_copy (m_dest, m_dest_offset, elt, 0,
+ TYPE_LENGTH (value_type (elt)));
+ m_dest_offset += TYPE_LENGTH (value_type (elt));
+ }
+
+ /* The value being written to. */
+ struct value *m_dest;
+
+ /* The byte offset in M_DEST at which the next element should be
+ written. */
+ LONGEST m_dest_offset;
+
+ /* Set with a call to VALUE_MARK, and then reset after calling
+ VALUE_FREE_TO_MARK. */
+ struct value *m_mark = nullptr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ lazy array value, as such it does not require the parent array value to
+ be loaded into GDB's memory; the parent value could be huge, while the
+ slice could be tiny. */
+class fortran_lazy_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type of the slice being loaded from the
+ parent value, so this type will correctly reflect the strides required
+ to find all of the elements from the parent value. ADDRESS is the
+ address in target memory of value matching TYPE, and DEST is the value
+ we are repacking into. */
+ explicit fortran_lazy_array_repacker_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_addr (address)
+ { /* Nothing. */ }
+
+ /* Create a lazy value in target memory representing a single element,
+ then load the element into GDB's memory and copy the contents into the
+ destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
+ {
+ copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off));
+ }
+
+private:
+ /* The address in target memory where the parent value starts. */
+ CORE_ADDR m_addr;
+};
+
+/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
+ slices. This class is specialised for repacking an array slice from a
+ previously loaded (non-lazy) array value, as such it fetches the
+ element values from the contents of the parent value. */
+class fortran_array_repacker_impl
+ : public fortran_array_repacker_base_impl
+{
+public:
+ /* Constructor. TYPE is the type for the array slice within the parent
+ value, as such it has stride values as required to find the elements
+ within the original parent value. ADDRESS is the address in target
+ memory of the value matching TYPE. BASE_OFFSET is the offset from
+ the start of VAL's content buffer to the start of the object of TYPE,
+ VAL is the parent object from which we are loading the value, and
+ DEST is the value into which we are repacking. */
+ explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address,
+ LONGEST base_offset,
+ struct value *val, struct value *dest)
+ : fortran_array_repacker_base_impl (dest),
+ m_base_offset (base_offset),
+ m_val (val)
+ {
+ gdb_assert (!value_lazy (val));
+ }
+
+ /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF)
+ from the content buffer of M_VAL then copy this extracted value into
+ the repacked destination value. */
+ void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
+ {
+ struct value *elt
+ = value_from_component (m_val, elt_type, (elt_off + m_base_offset));
+ copy_element_to_dest (elt);
+ }
+
+private:
+ /* The offset into the content buffer of M_VAL to the start of the slice
+ being extracted. */
+ LONGEST m_base_offset;
+
+ /* The parent value from which we are extracting a slice. */
+ struct value *m_val;
+};
+
/* Called from evaluate_subexp_standard to perform array indexing, and
sub-range extraction, for Fortran. As well as arrays this function
also handles strings as they can be treated like arrays of characters.
@@ -200,51 +315,394 @@ static struct value *
fortran_value_subarray (struct value *array, struct expression *exp,
int *pos, int nargs, enum noside noside)
{
- if (exp->elts[*pos].opcode == OP_RANGE)
- return value_f90_subarray (array, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
+ type *original_array_type = check_typedef (value_type (array));
+ bool is_string_p = original_array_type->code () == TYPE_CODE_STRING;
+
+ /* Perform checks for ARRAY not being available. The somewhat overly
+ complex logic here is just to keep backward compatibility with the
+ errors that we used to get before FORTRAN_VALUE_SUBARRAY was
+ rewritten. Maybe a future task would streamline the error messages we
+ get here, and update all the expected test results. */
+ if (exp->elts[*pos].opcode != OP_RANGE)
+ {
+ if (type_not_associated (original_array_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (original_array_type))
+ error (_("no such vector element (vector not allocated)"));
+ }
+ else
{
- skip_undetermined_arglist (nargs, exp, pos, noside);
- /* Return the dummy value with the correct type. */
- return array;
+ if (type_not_associated (original_array_type))
+ error (_("array not associated"));
+ else if (type_not_allocated (original_array_type))
+ error (_("array not allocated"));
}
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1;
- struct type *type = check_typedef (value_type (array));
+ /* First check that the number of dimensions in the type we are slicing
+ matches the number of arguments we were passed. */
+ int ndimensions = calc_f77_array_dims (original_array_type);
+ if (nargs != ndimensions)
+ error (_("Wrong number of subscripts"));
+
+ /* This will be initialised below with the type of the elements held in
+ ARRAY. */
+ struct type *inner_element_type;
+
+ /* Extract the types of each array dimension from the original array
+ type. We need these available so we can fill in the default upper and
+ lower bounds if the user requested slice doesn't provide that
+ information. Additionally unpacking the dimensions like this gives us
+ the inner element type. */
+ std::vector<struct type *> dim_types;
+ {
+ dim_types.reserve (ndimensions);
+ struct type *type = original_array_type;
+ for (int i = 0; i < ndimensions; ++i)
+ {
+ dim_types.push_back (type);
+ type = TYPE_TARGET_TYPE (type);
+ }
+ /* TYPE is now the inner element type of the array, we start the new
+ array slice off as this type, then as we process the requested slice
+ (from the user) we wrap new types around this to build up the final
+ slice type. */
+ inner_element_type = type;
+ }
+
+ /* As we analyse the new slice type we need to understand if the data
+ being referenced is contiguous. Do decide this we must track the size
+ of an element at each dimension of the new slice array. Initially the
+ elements of the inner most dimension of the array are the same inner
+ most elements as the original ARRAY. */
+ LONGEST slice_element_size = TYPE_LENGTH (inner_element_type);
+
+ /* Start off assuming all data is contiguous, this will be set to false
+ if access to any dimension results in non-contiguous data. */
+ bool is_all_contiguous = true;
+
+ /* The TOTAL_OFFSET is the distance in bytes from the start of the
+ original ARRAY to the start of the new slice. This is calculated as
+ we process the information from the user. */
+ LONGEST total_offset = 0;
+
+ /* A structure representing information about each dimension of the
+ resulting slice. */
+ struct slice_dim
+ {
+ /* Constructor. */
+ slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx)
+ : low (l),
+ high (h),
+ stride (s),
+ index (idx)
+ { /* Nothing. */ }
+
+ /* The low bound for this dimension of the slice. */
+ LONGEST low;
+
+ /* The high bound for this dimension of the slice. */
+ LONGEST high;
+
+ /* The byte stride for this dimension of the slice. */
+ LONGEST stride;
+
+ struct type *index;
+ };
+
+ /* The dimensions of the resulting slice. */
+ std::vector<slice_dim> slice_dims;
+
+ /* Process the incoming arguments. These arguments are in the reverse
+ order to the array dimensions, that is the first argument refers to
+ the last array dimension. */
+ if (fortran_array_slicing_debug)
+ debug_printf ("Processing array access:\n");
+ for (int i = 0; i < nargs; ++i)
+ {
+ /* For each dimension of the array the user will have either provided
+ a ranged access with optional lower bound, upper bound, and
+ stride, or the user will have supplied a single index. */
+ struct type *dim_type = dim_types[ndimensions - (i + 1)];
+ if (exp->elts[*pos].opcode == OP_RANGE)
+ {
+ int pc = (*pos) + 1;
+ enum range_flag range_flag = (enum range_flag) exp->elts[pc].longconst;
+ *pos += 3;
+
+ LONGEST low, high, stride;
+ low = high = stride = 0;
+
+ if ((range_flag & RANGE_LOW_BOUND_DEFAULT) == 0)
+ low = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ low = f77_get_lowerbound (dim_type);
+ if ((range_flag & RANGE_HIGH_BOUND_DEFAULT) == 0)
+ high = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ high = f77_get_upperbound (dim_type);
+ if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
+ stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+ else
+ stride = 1;
+
+ if (stride == 0)
+ error (_("stride must not be 0"));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride ();
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type) * 8;
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Range access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Bit stride: %ld\n", sd);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd / 8);
+ debug_printf ("| | |-> Type size: %ld\n",
+ TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| |-> Accessing:\n");
+ debug_printf ("| | |-> Low bound: %ld\n",
+ low);
+ debug_printf ("| | |-> High bound: %ld\n",
+ high);
+ debug_printf ("| | '-> Element stride: %ld\n",
+ stride);
+ }
+
+ /* Check the user hasn't asked for something invalid. */
+ if (high > ub || low < lb)
+ error (_("array subscript out of bounds"));
+
+ /* Calculate what this dimension of the new slice array will look
+ like. OFFSET is the byte offset from the start of the
+ previous (more outer) dimension to the start of this
+ dimension. E_COUNT is the number of elements in this
+ dimension. REMAINDER is the number of elements remaining
+ between the last included element and the upper bound. For
+ example an access '1:6:2' will include elements 1, 3, 5 and
+ have a remainder of 1 (element #6). */
+ LONGEST lowest = std::min (low, high);
+ LONGEST offset = (sd / 8) * (lowest - lb);
+ LONGEST e_count = std::abs (high - low) + 1;
+ e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride);
+ LONGEST new_low = 1;
+ LONGEST new_high = new_low + e_count - 1;
+ LONGEST new_stride = (sd * stride) / 8;
+ LONGEST last_elem = low + ((e_count - 1) * stride);
+ LONGEST remainder = high - last_elem;
+ if (low > high)
+ {
+ offset += std::abs (remainder) * TYPE_LENGTH (target_type);
+ if (stride > 0)
+ error (_("incorrect stride and boundary combination"));
+ }
+ else if (stride < 0)
+ error (_("incorrect stride and boundary combination"));
+
+ /* Is the data within this dimension contiguous? It is if the
+ newly computed stride is the same size as a single element of
+ this dimension. */
+ bool is_dim_contiguous = (new_stride == slice_element_size);
+ is_all_contiguous &= is_dim_contiguous;
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("| '-> Results:\n");
+ debug_printf ("| |-> Offset = %ld\n", offset);
+ debug_printf ("| |-> Elements = %ld\n", e_count);
+ debug_printf ("| |-> Low bound = %ld\n", new_low);
+ debug_printf ("| |-> High bound = %ld\n", new_high);
+ debug_printf ("| |-> Byte stride = %ld\n", new_stride);
+ debug_printf ("| |-> Last element = %ld\n", last_elem);
+ debug_printf ("| |-> Remainder = %ld\n", remainder);
+ debug_printf ("| '-> Contiguous = %s\n",
+ (is_dim_contiguous ? "Yes" : "No"));
+ }
- ndimensions = calc_f77_array_dims (type);
+ /* Figure out how big (in bytes) an element of this dimension of
+ the new array slice will be. */
+ slice_element_size = std::abs (new_stride * e_count);
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
+ slice_dims.emplace_back (new_low, new_high, new_stride,
+ index_type);
+
+ /* Update the total offset. */
+ total_offset += offset;
+ }
+ else
+ {
+ /* There is a single index for this dimension. */
+ LONGEST index
+ = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside));
+
+ /* Get information about this dimension in the original ARRAY. */
+ struct type *target_type = TYPE_TARGET_TYPE (dim_type);
+ struct type *index_type = dim_type->index_type ();
+ LONGEST lb = f77_get_lowerbound (dim_type);
+ LONGEST ub = f77_get_upperbound (dim_type);
+ LONGEST sd = index_type->bit_stride () / 8;
+ if (sd == 0)
+ sd = TYPE_LENGTH (target_type);
+
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("|-> Index access\n");
+ std::string str = type_to_string (dim_type);
+ debug_printf ("| |-> Type: %s\n", str.c_str ());
+ debug_printf ("| |-> Array:\n");
+ debug_printf ("| | |-> Low bound: %ld\n", lb);
+ debug_printf ("| | |-> High bound: %ld\n", ub);
+ debug_printf ("| | |-> Byte stride: %ld\n", sd);
+ debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type));
+ debug_printf ("| | '-> Target type size: %ld\n",
+ TYPE_LENGTH (target_type));
+ debug_printf ("| '-> Accessing:\n");
+ debug_printf ("| '-> Index: %ld\n", index);
+ }
- gdb_assert (nargs > 0);
+ /* If the array has actual content then check the index is in
+ bounds. An array without content (an unbound array) doesn't
+ have a known upper bound, so don't error check in that
+ situation. */
+ if (index < lb
+ || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED
+ && index > ub)
+ || (VALUE_LVAL (array) != lval_memory
+ && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED))
+ {
+ if (type_not_associated (dim_type))
+ error (_("no such vector element (vector not associated)"));
+ else if (type_not_allocated (dim_type))
+ error (_("no such vector element (vector not allocated)"));
+ else
+ error (_("no such vector element"));
+ }
+
+ /* Calculate using the type stride, not the target type size. */
+ LONGEST offset = sd * (index - lb);
+ total_offset += offset;
+ }
+ }
- /* Now that we know we have a legal array subscript expression let us
- actually find out where this element exists in the array. */
+ if (noside == EVAL_SKIP)
+ return array;
- /* Take array indices left to right. */
- for (int i = 0; i < nargs; i++)
+ /* Build a type that represents the new array slice in the target memory
+ of the original ARRAY, this type makes use of strides to correctly
+ find only those elements that are part of the new slice. */
+ struct type *array_slice_type = inner_element_type;
+ for (const auto &d : slice_dims)
{
- /* Evaluate each subscript; it must be a legal integer in F77. */
- value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (d.stride);
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ array_slice_type
+ = create_array_type (nullptr, array_slice_type, new_range);
+ }
- /* Fill in the subscript array. */
- subscript_array[i] = value_as_long (arg2);
+ if (fortran_array_slicing_debug)
+ {
+ debug_printf ("'-> Final result:\n");
+ debug_printf (" |-> Type: %s\n",
+ type_to_string (array_slice_type).c_str ());
+ debug_printf (" |-> Total offset: %ld\n", total_offset);
+ debug_printf (" |-> Base address: %s\n",
+ core_addr_to_string (value_address (array)));
+ debug_printf (" '-> Contiguous = %s\n",
+ (is_all_contiguous ? "Yes" : "No"));
}
- /* Internal type of array is arranged right to left. */
- for (int i = nargs; i > 0; i--)
+ /* Should we repack this array slice? */
+ if (!is_all_contiguous && (repack_array_slices || is_string_p))
{
- struct type *array_type = check_typedef (value_type (array));
- LONGEST index = subscript_array[i - 1];
+ /* Build a type for the repacked slice. */
+ struct type *repacked_array_type = inner_element_type;
+ for (const auto &d : slice_dims)
+ {
+ /* Create the range. */
+ dynamic_prop p_low, p_high, p_stride;
+
+ p_low.set_const_val (d.low);
+ p_high.set_const_val (d.high);
+ p_stride.set_const_val (TYPE_LENGTH (repacked_array_type));
+
+ struct type *new_range
+ = create_range_type_with_stride ((struct type *) NULL,
+ TYPE_TARGET_TYPE (d.index),
+ &p_low, &p_high, 0, &p_stride,
+ true);
+ repacked_array_type
+ = create_array_type (nullptr, repacked_array_type, new_range);
+ }
- array = value_subscripted_rvalue (array, index,
- f77_get_lowerbound (array_type));
+ /* Now copy the elements from the original ARRAY into the packed
+ array value DEST. */
+ struct value *dest = allocate_value (repacked_array_type);
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ {
+ fortran_array_walker<fortran_lazy_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset, dest);
+ p.walk ();
+ }
+ else
+ {
+ fortran_array_walker<fortran_array_repacker_impl> p
+ (array_slice_type, value_address (array) + total_offset,
+ total_offset, array, dest);
+ p.walk ();
+ }
+ array = dest;
+ }
+ else
+ {
+ if (VALUE_LVAL (array) == lval_memory)
+ {
+ /* If the value we're taking a slice from is not yet loaded, or
+ the requested slice is outside the values content range then
+ just create a new lazy value pointing at the memory where the
+ contents we're looking for exist. */
+ if (value_lazy (array)
+ || (total_offset + TYPE_LENGTH (array_slice_type)
+ > TYPE_LENGTH (check_typedef (value_type (array)))))
+ array = value_at_lazy (array_slice_type,
+ value_address (array) + total_offset);
+ else
+ array = value_from_contents_and_address (array_slice_type,
+ (value_contents (array)
+ + total_offset),
+ (value_address (array)
+ + total_offset));
+ }
+ else if (!value_lazy (array))
+ {
+ const void *valaddr = value_contents (array) + total_offset;
+ array = allocate_value (array_slice_type);
+ memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type));
+ }
+ else
+ error (_("cannot subscript arrays that are not in memory"));
}
return array;
@@ -862,11 +1320,50 @@ builtin_f_type (struct gdbarch *gdbarch)
return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
}
+/* Command-list for the "set/show fortran" prefix command. */
+static struct cmd_list_element *set_fortran_list;
+static struct cmd_list_element *show_fortran_list;
+
void _initialize_f_language ();
void
_initialize_f_language ()
{
f_type_data = gdbarch_data_register_post_init (build_fortran_types);
+
+ add_basic_prefix_cmd ("fortran", no_class,
+ _("Prefix command for changing Fortran-specific settings."),
+ &set_fortran_list, "set fortran ", 0, &setlist);
+
+ add_show_prefix_cmd ("fortran", no_class,
+ _("Generic command for showing Fortran-specific settings."),
+ &show_fortran_list, "show fortran ", 0, &showlist);
+
+ add_setshow_boolean_cmd ("repack-array-slices", class_vars,
+ &repack_array_slices, _("\
+Enable or disable repacking of non-contiguous array slices."), _("\
+Show whether non-contiguous array slices are repacked."), _("\
+When the user requests a slice of a Fortran array then we can either return\n\
+a descriptor that describes the array in place (using the original array data\n\
+in its existing location) or the original data can be repacked (copied) to a\n\
+new location.\n\
+\n\
+When the content of the array slice is contiguous within the original array\n\
+then the result will never be repacked, but when the data for the new array\n\
+is non-contiguous within the original array repacking will only be performed\n\
+when this setting is on."),
+ NULL,
+ show_repack_array_slices,
+ &set_fortran_list, &show_fortran_list);
+
+ /* Debug Fortran's array slicing logic. */
+ add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance,
+ &fortran_array_slicing_debug, _("\
+Set debugging of Fortran array slicing."), _("\
+Show debugging of Fortran array slicing."), _("\
+When on, debugging of Fortran array slicing is enabled."),
+ NULL,
+ show_fortran_array_slicing_debug,
+ &setdebuglist, &showdebuglist);
}
/* See f-lang.h. */
@@ -905,3 +1402,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type)
return value_type (arg);
return type;
}
+
+/* See f-lang.h. */
+
+CORE_ADDR
+fortran_adjust_dynamic_array_base_address_hack (struct type *type,
+ CORE_ADDR address)
+{
+ gdb_assert (type->code () == TYPE_CODE_ARRAY);
+
+ int ndimensions = calc_f77_array_dims (type);
+ LONGEST total_offset = 0;
+
+ /* Walk through each of the dimensions of this array type and figure out
+ if any of the dimensions are "backwards", that is the base address
+ for this dimension points to the element at the highest memory
+ address and the stride is negative. */
+ struct type *tmp_type = type;
+ for (int i = 0 ; i < ndimensions; ++i)
+ {
+ /* Grab the range for this dimension and extract the lower and upper
+ bounds. */
+ tmp_type = check_typedef (tmp_type);
+ struct type *range_type = tmp_type->index_type ();
+ LONGEST lowerbound, upperbound, stride;
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("failed to get range bounds");
+
+ /* Figure out the stride for this dimension. */
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
+ stride = tmp_type->index_type ()->bounds ()->bit_stride ();
+ if (stride == 0)
+ stride = type_length_units (elt_type);
+ else
+ {
+ struct gdbarch *arch = get_type_arch (elt_type);
+ int unit_size = gdbarch_addressable_memory_unit_size (arch);
+ stride /= (unit_size * 8);
+ }
+
+ /* If this dimension is "backward" then figure out the offset
+ adjustment required to point to the element at the lowest memory
+ address, and add this to the total offset. */
+ LONGEST offset = 0;
+ if (stride < 0 && lowerbound < upperbound)
+ offset = (upperbound - lowerbound) * stride;
+ total_offset += offset;
+ tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ }
+
+ /* Adjust the address of this object and return it. */
+ address += total_offset;
+ return address;
+}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index e59fdef1b19..880c07e4473 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -316,7 +316,6 @@ extern void f77_get_dynamic_array_length (struct type *);
extern int calc_f77_array_dims (struct type *);
-
/* Fortran (F77) types */
struct builtin_f_type
@@ -374,4 +373,22 @@ extern struct value *fortran_argument_convert (struct value *value,
extern struct type *fortran_preserve_arg_pointer (struct value *arg,
struct type *type);
+/* Fortran arrays can have a negative stride. When this happens it is
+ often the case that the base address for an object is not the lowest
+ address occupied by that object. For example, an array slice (10:1:-1)
+ will be encoded with lower bound 1, upper bound 10, a stride of
+ -ELEMENT_SIZE, and have a base address pointer that points at the
+ element with the highest address in memory.
+
+ This really doesn't play well with our current model of value contents,
+ but could easily require a significant update in order to be supported
+ "correctly".
+
+ For now, we manually force the base address to be the lowest addressed
+ element here. Yes, this will break some things, but it fixes other
+ things. The hope is that it fixes more than it breaks. */
+
+extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
+ (struct type *type, CORE_ADDR address);
+
#endif /* F_LANG_H */
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 95630a76d7d..83242f5ed47 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -35,6 +35,7 @@
#include "dictionary.h"
#include "cli/cli-style.h"
#include "gdbarch.h"
+#include "f-array-walker.h"
static void f77_get_dynamic_length_of_aggregate (struct type *);
@@ -100,100 +101,103 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
* TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
}
-/* Actual function which prints out F77 arrays, Valaddr == address in
- the superior. Address == the address in the inferior. */
+/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array
+ walking template. This specialisation prints Fortran arrays. */
-static void
-f77_print_array_1 (int nss, int ndimensions, struct type *type,
- const gdb_byte *valaddr,
- int embedded_offset, CORE_ADDR address,
- struct ui_file *stream, int recurse,
- const struct value *val,
- const struct value_print_options *options,
- int *elts)
+class fortran_array_printer_impl : public fortran_array_walker_base_impl
{
- struct type *range_type = check_typedef (type)->index_type ();
- CORE_ADDR addr = address + embedded_offset;
- LONGEST lowerbound, upperbound;
- LONGEST i;
-
- get_discrete_bounds (range_type, &lowerbound, &upperbound);
-
- if (nss != ndimensions)
- {
- struct gdbarch *gdbarch = get_type_arch (type);
- size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type));
- int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
- size_t byte_stride = type->bit_stride () / (unit_size * 8);
- if (byte_stride == 0)
- byte_stride = dim_size;
- size_t offs = 0;
-
- for (i = lowerbound;
- (i < upperbound + 1 && (*elts) < options->print_max);
- i++)
- {
- struct value *subarray = value_from_contents_and_address
- (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
- + offs, addr + offs);
-
- fprintf_filtered (stream, "(");
- f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
- value_contents_for_printing (subarray),
- value_embedded_offset (subarray),
- value_address (subarray),
- stream, recurse, subarray, options, elts);
- offs += byte_stride;
- fprintf_filtered (stream, ")");
-
- if (i < upperbound)
- fprintf_filtered (stream, " ");
- }
- if (*elts >= options->print_max && i < upperbound)
- fprintf_filtered (stream, "...");
- }
- else
- {
- for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
- i++, (*elts)++)
- {
- struct value *elt = value_subscript ((struct value *)val, i);
-
- common_val_print (elt, stream, recurse, options, current_language);
-
- if (i != upperbound)
- fprintf_filtered (stream, ", ");
-
- if ((*elts == options->print_max - 1)
- && (i != upperbound))
- fprintf_filtered (stream, "...");
- }
- }
-}
+public:
+ /* Constructor. TYPE is the array type being printed, ADDRESS is the
+ address in target memory for the object of TYPE being printed. VAL is
+ the GDB value (of TYPE) being printed. STREAM is where to print to,
+ RECOURSE is passed through (and prevents infinite recursion), and
+ OPTIONS are the printing control options. */
+ explicit fortran_array_printer_impl (struct type *type,
+ CORE_ADDR address,
+ struct value *val,
+ struct ui_file *stream,
+ int recurse,
+ const struct value_print_options *options)
+ : m_elts (0),
+ m_val (val),
+ m_stream (stream),
+ m_recurse (recurse),
+ m_options (options)
+ { /* Nothing. */ }
+
+ /* Called while iterating over the array bounds. When SHOULD_CONTINUE is
+ false then we must return false, as we have reached the end of the
+ array bounds for this dimension. However, we also return false if we
+ have printed too many elements (after printing '...'). In all other
+ cases, return true. */
+ bool continue_walking (bool should_continue)
+ {
+ bool cont = should_continue && (m_elts < m_options->print_max);
+ if (!cont && should_continue)
+ fputs_filtered ("...", m_stream);
+ return cont;
+ }
+
+ /* Called when we start iterating over a dimension. If it's not the
+ inner most dimension then print an opening '(' character. */
+ void start_dimension (bool inner_p)
+ {
+ fputs_filtered ("(", m_stream);
+ }
+
+ /* Called when we finish processing a batch of items within a dimension
+ of the array. Depending on whether this is the inner most dimension
+ or not we print different things, but this is all about adding
+ separators between elements, and dimensions of the array. */
+ void finish_dimension (bool inner_p, bool last_p)
+ {
+ fputs_filtered (")", m_stream);
+ if (!last_p)
+ fputs_filtered (" ", m_stream);
+ }
+
+ /* Called to process an element of ELT_TYPE at offset ELT_OFF from the
+ start of the parent object. */
+ void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
+ {
+ /* Extract the element value from the parent value. */
+ struct value *e_val
+ = value_from_component (m_val, elt_type, elt_off);
+ common_val_print (e_val, m_stream, m_recurse, m_options, current_language);
+ if (!last_p)
+ fputs_filtered (", ", m_stream);
+ ++m_elts;
+ }
+
+private:
+ /* The number of elements printed so far. */
+ int m_elts;
+
+ /* The value from which we are printing elements. */
+ struct value *m_val;
+
+ /* The stream we should print too. */
+ struct ui_file *m_stream;
+
+ /* The recursion counter, passed through when we print each element. */
+ int m_recurse;
+
+ /* The print control options. Gives us the maximum number of elements to
+ print, and is passed through to each element that we print. */
+ const struct value_print_options *m_options = nullptr;
+};
-/* This function gets called to print an F77 array, we set up some
- stuff and then immediately call f77_print_array_1(). */
+/* This function gets called to print a Fortran array. */
static void
-f77_print_array (struct type *type, const gdb_byte *valaddr,
- int embedded_offset,
- CORE_ADDR address, struct ui_file *stream,
- int recurse,
- const struct value *val,
- const struct value_print_options *options)
+fortran_print_array (struct type *type, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ const struct value *val,
+ const struct value_print_options *options)
{
- int ndimensions;
- int elts = 0;
-
- ndimensions = calc_f77_array_dims (type);
-
- if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
- error (_("\
-Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
- ndimensions, MAX_FORTRAN_DIMS);
-
- f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
- address, stream, recurse, val, options, &elts);
+ fortran_array_walker<fortran_array_printer_impl> p
+ (type, address, (struct value *) val, stream, recurse, options);
+ p.walk ();
}
\f
@@ -237,12 +241,7 @@ f_language::value_print_inner (struct value *val, struct ui_file *stream,
case TYPE_CODE_ARRAY:
if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR)
- {
- fprintf_filtered (stream, "(");
- f77_print_array (type, valaddr, 0,
- address, stream, recurse, val, options);
- fprintf_filtered (stream, ")");
- }
+ fortran_print_array (type, address, stream, recurse, val, options);
else
{
struct type *ch_type = TYPE_TARGET_TYPE (type);
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 0940fa597fb..6a4037dd077 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -39,6 +39,7 @@
#include "dwarf2/loc.h"
#include "gdbcore.h"
#include "floatformat.h"
+#include "f-lang.h"
#include <algorithm>
/* Initialize BADNESS constants. */
@@ -2627,7 +2628,16 @@ resolve_dynamic_type_internal (struct type *type,
prop = TYPE_DATA_LOCATION (resolved_type);
if (prop != NULL
&& dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
- prop->set_const_val (value);
+ {
+ /* Start of Fortran hack. See comment in f-lang.h for what is going
+ on here.*/
+ if (current_language->la_language == language_fortran
+ && resolved_type->code () == TYPE_CODE_ARRAY)
+ value = fortran_adjust_dynamic_array_base_address_hack (resolved_type,
+ value);
+ /* End of Fortran hack. */
+ prop->set_const_val (value);
+ }
return resolved_type;
}
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
new file mode 100644
index 00000000000..2583cdecc94
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
@@ -0,0 +1,69 @@
+# Copyright 2020 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/> .
+
+# Test invalid element and slice array accesses.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "First Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Second Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+gdb_continue_to_breakpoint "First Breakpoint"
+
+# Access not yet allocated array.
+gdb_test "print other" " = <not allocated>"
+gdb_test "print other(0:4,2:3)" "array not allocated"
+gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)"
+
+# Access not yet associated pointer.
+gdb_test "print pointer2d" " = <not associated>"
+gdb_test "print pointer2d(1:2,1:2)" "array not associated"
+gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)"
+
+gdb_continue_to_breakpoint "Second Breakpoint"
+
+# Accessing just outside the arrays.
+foreach name {array pointer2d other} {
+ gdb_test "print $name (0:,:)" "array subscript out of bounds"
+ gdb_test "print $name (:11,:)" "array subscript out of bounds"
+ gdb_test "print $name (:,0:)" "array subscript out of bounds"
+ gdb_test "print $name (:,:11)" "array subscript out of bounds"
+
+ gdb_test "print $name (0,:)" "no such vector element"
+ gdb_test "print $name (11,:)" "no such vector element"
+ gdb_test "print $name (:,0)" "no such vector element"
+ gdb_test "print $name (:,11)" "no such vector element"
+}
+
+# Stride in the wrong direction.
+gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination"
+gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination"
+gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
new file mode 100644
index 00000000000..0f3d45ab8cd
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
@@ -0,0 +1,42 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Declare variables used in this test.
+ integer, dimension (1:10,1:10) :: array
+ integer, allocatable :: other (:, :)
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(1:10,1:10), target :: tarray
+
+ print *, "" ! First Breakpoint.
+
+ ! Allocate or associate any variables as needed.
+ allocate (other (1:10, 1:10))
+ pointer2d => tarray
+ array = 0
+
+ print *, "" ! Second Breakpoint.
+
+ ! All done. Deallocate.
+ deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
new file mode 100644
index 00000000000..05b4802c678
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
@@ -0,0 +1,111 @@
+# Copyright 2020 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/> .
+
+# Create a slice of an array, then take a slice of that slice.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Stop Here"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We're going to print some reasonably large arrays.
+gdb_test_no_output "set print elements unlimited"
+
+gdb_continue_to_breakpoint "Stop Here"
+
+# Print a slice, capture the convenience variable name created.
+set cmd "print array (1:10:2, 1:10:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ }
+}
+
+# Now check that we can correctly extract all the elements from this
+# slice.
+for { set j 1 } { $j < 6 } { incr j } {
+ for { set i 1 } { $i < 6 } { incr i } {
+ set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1]
+ gdb_test "print ${varname} ($i,$j)" " = $val"
+ }
+}
+
+# Now take a slice of the slice.
+gdb_test "print ${varname} (3:5, 3:5)" \
+ " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)"
+
+# Now take a different slice of a slice.
+set cmd "print ${varname} (1:5:2, 1:5:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Now take a slice from the slice, of a slice!
+set cmd "print ${varname} (1:3:2, 1:3:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# And again!
+set cmd "print ${varname} (1:2:2, 1:2:2)"
+gdb_test_multiple $cmd $cmd {
+ -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" {
+ set varname "\$$expect_out(1,string)"
+ pass $gdb_test_name
+ }
+}
+
+# Test taking a slice with stride of a string. This isn't actually
+# supported within gfortran (at least), but naturally drops out of how
+# GDB models arrays and strings in a similar way, so we may as well
+# test that this is still working.
+gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'"
+gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'"
+gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'"
+
+# Now test the memory requirements of taking a slice from an array.
+# The idea is that we shouldn't require more memory to extract a slice
+# than the size of the slice.
+#
+# This will only work if array repacking is turned on, otherwise GDB
+# will create the slice by generating a new type that sits over the
+# existing value in memory.
+gdb_test_no_output "set fortran repack-array-slices on"
+set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"]
+set slice_size [expr $element_size * 4]
+gdb_test_no_output "set max-value-size $slice_size"
+gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)"
+gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)"
+gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
new file mode 100644
index 00000000000..c3530f567d4
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
@@ -0,0 +1,96 @@
+! Copyright 2020 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/>.
+
+!
+! Start of test program.
+!
+program test
+ integer, dimension (1:10,1:11) :: array
+ character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz"
+
+ call fill_array_2d (array)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Stop Here
+
+ print *, array
+ print *, str
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
+ print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
+end program test
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
index aa6bc6327eb..ff00fae886f 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.exp
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -18,6 +18,21 @@
# the subroutine. This should exercise GDB's ability to handle
# different strides for the different dimensions.
+# Testing GDB's ability to print array (and string) slices, including
+# slices that make use of array strides.
+#
+# In the Fortran code various arrays of different ranks are filled
+# with data, and slices are passed to a series of show functions.
+#
+# In this test script we break in each of the show functions, print
+# the array slice that was passed in, and then move up the stack to
+# the parent frame and check GDB can manually extract the same slice.
+#
+# This test also checks that the size of the array slice passed to the
+# function (so as extracted and described by the compiler and the
+# debug information) matches the size of the slice manually extracted
+# by GDB.
+
if {[skip_fortran_tests]} { return -1 }
standard_testfile ".f90"
@@ -28,60 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
return -1
}
-if ![fortran_runto_main] {
- untested "could not run to main"
- return -1
+# Takes the name of an array slice as used in the test source, and extracts
+# the base array name. For example: 'array (1,2)' becomes 'array'.
+proc array_slice_to_var { slice_str } {
+ regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname
+ return $varname
}
-gdb_breakpoint "show"
-gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
-
-set array_contents \
- [list \
- " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
- " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
- " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
- " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
- " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
- " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
- " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
-
-set message_strings \
- [list \
- " = 'array'" \
- " = 'array \\(1:5,1:5\\)'" \
- " = 'array \\(1:10:2,1:10:2\\)'" \
- " = 'array \\(1:10:3,1:10:2\\)'" \
- " = 'array \\(1:10:5,1:10:3\\)'" \
- " = 'other'" \
- " = 'other \\(-5:0, -2:0\\)'" \
- " = 'other \\(-5:4:2, -2:7:3\\)'" ]
-
-set i 0
-foreach result $array_contents msg $message_strings {
- incr i
- with_test_prefix "test $i" {
- gdb_continue_to_breakpoint "show"
- gdb_test "p array" $result
- gdb_test "p message" "$msg"
+proc run_test { repack } {
+ global binfile gdb_prompt
+
+ clean_restart ${binfile}
+
+ if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
}
-}
-gdb_continue_to_breakpoint "continue to Final Breakpoint"
+ gdb_test_no_output "set fortran repack-array-slices $repack"
+
+ # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
+ gdb_breakpoint [gdb_get_line_number "Display Element"]
+ gdb_breakpoint [gdb_get_line_number "Display String"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"]
+ gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"]
+ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+ # We're going to print some reasonably large arrays.
+ gdb_test_no_output "set print elements unlimited"
+
+ set found_final_breakpoint false
+
+ # We place a limit on the number of tests that can be run, just in
+ # case something goes wrong, and GDB gets stuck in an loop here.
+ set test_count 0
+ while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ set found_final_breakpoint false
+ set expected_result ""
+ set func_name ""
+ gdb_test_multiple "continue" "continue" {
+ -re ".*GDB = (\[^\r\n\]+)\r\n" {
+ set expected_result $expect_out(1,string)
+ exp_continue
+ }
+ -re "! Display Element" {
+ set func_name "show_elem"
+ exp_continue
+ }
+ -re "! Display String" {
+ set func_name "show_str"
+ exp_continue
+ }
+ -re "! Display Array Slice (.)D" {
+ set func_name "show_$expect_out(1,string)d"
+ exp_continue
+ }
+ -re "! Final Breakpoint" {
+ set found_final_breakpoint true
+ exp_continue
+ }
+ -re "$gdb_prompt $" {
+ # We're done.
+ }
+ }
-# Next test that asking for an array with stride at the CLI gives an
-# error.
-clean_restart ${testfile}
+ if ($found_final_breakpoint) {
+ break
+ }
-if ![fortran_runto_main] then {
- perror "couldn't run to main"
- continue
+ # We want to take a look at the line in the previous frame that
+ # called the current function. I couldn't find a better way of
+ # doing this than 'up', which will print the line, then 'down'
+ # again.
+ #
+ # I don't want to fill the log with passes for these up/down
+ # commands, so we don't report any. If something goes wrong then we
+ # should get a fail from gdb_test_multiple.
+ set array_slice_name ""
+ set unique_id ""
+ array unset replacement_vars
+ array set replacement_vars {}
+ gdb_test_multiple "up" "up" {
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ }
+ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" {
+ set array_slice_name $expect_out(1,string)
+ set unique_id $expect_out(2,string)
+ }
+ }
+ if {$unique_id != ""} {
+ set str ""
+ foreach v [split $unique_id ,] {
+ set val [get_integer_valueof "${v}" "??"\
+ "get variable '$v' for '$array_slice_name'"]
+ set replacement_vars($v) $val
+ if {$str != ""} {
+ set str "Str,"
+ }
+ set str "$str$v=$val"
+ }
+ set unique_id " $str"
+ }
+ gdb_test_multiple "down" "down" {
+ -re "\r\n$gdb_prompt $" {
+ # Don't issue a pass here.
+ }
+ }
+
+ # Check we have all the information we need to successfully run one
+ # of these tests.
+ if { $expected_result == "" } {
+ perror "failed to extract expected results"
+ return 0
+ }
+ if { $array_slice_name == "" } {
+ perror "failed to extract array slice name"
+ return 0
+ }
+
+ # Check GDB can correctly print the array slice that was passed into
+ # the current frame.
+ set pattern [string_to_regexp " = $expected_result"]
+ gdb_test "p array" "$pattern" \
+ "check value of '$array_slice_name'$unique_id"
+
+ # Get the size of the slice.
+ set size_in_show \
+ [get_integer_valueof "sizeof (array)" "show_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in show"]
+ set addr_in_show \
+ [get_hexadecimal_valueof "&array" "show_unknown" \
+ "get address '$array_slice_name'$unique_id in show"]
+
+ # Now move into the previous frame, and see if GDB can extract the
+ # array slice from the original parent object. Again, use of
+ # gdb_test_multiple to avoid filling the logs with unnecessary
+ # passes.
+ gdb_test_multiple "up" "up" {
+ -re "\r\n$gdb_prompt $" {
+ # Do nothing.
+ }
+ }
+
+ # Print the array slice, this will force GDB to manually extract the
+ # slice from the parent array.
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted"
+
+ # Get the size of the slice in the calling frame.
+ set size_in_parent \
+ [get_integer_valueof "sizeof ($array_slice_name)" \
+ "parent_unknown" \
+ "get sizeof '$array_slice_name'$unique_id in parent"]
+
+ # Figure out the start and end addresses of the full array in the
+ # parent frame.
+ set full_var_name [array_slice_to_var $array_slice_name]
+ set start_addr [get_hexadecimal_valueof "&${full_var_name}" \
+ "start unknown"]
+ set end_addr [get_hexadecimal_valueof \
+ "(&${full_var_name}) + sizeof (${full_var_name})" \
+ "end unknown"]
+
+ # The Fortran compiler can choose to either send a descriptor that
+ # describes the array slice to the subroutine, or it can repack the
+ # slice into an array section and send that.
+ #
+ # We find the address range of the original array in the parent,
+ # and the address of the slice in the show function, if the
+ # address of the slice (from show) is in the range of the original
+ # array then repacking has not occurred, otherwise, the slice is
+ # outside of the parent, and repacking must have occurred.
+ #
+ # The goal here is to compare the sizes of the slice in show with
+ # the size of the slice extracted by GDB. So we can only compare
+ # sizes when GDB's repacking setting matches the repacking
+ # behaviour we got from the compiler.
+ if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \
+ == ($repack == "on") } {
+ gdb_assert {$size_in_show == $size_in_parent} \
+ "check sizes match"
+ } elseif { $repack == "off" } {
+ # GDB's repacking is off (so slices are left unpacked), but
+ # the compiler did pack this one. As a result we can't
+ # compare the sizes between the compiler's slice and GDB's
+ # slice.
+ verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared"
+ } else {
+ # Like the above, but the reverse, GDB's repacking is on, but
+ # the compiler didn't repack this slice.
+ verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared"
+ }
+
+ # If the array name we just tested included variable names, then
+ # test again with all the variables expanded.
+ if {$unique_id != ""} {
+ foreach v [array names replacement_vars] {
+ set val $replacement_vars($v)
+ set array_slice_name \
+ [regsub "\\y${v}\\y" $array_slice_name $val]
+ }
+ gdb_test "p $array_slice_name" "$pattern" \
+ "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded"
+ }
+ }
+ }
+
+ # Ensure we reached the final breakpoint. If more tests have been added
+ # to the test script, and this starts failing, then the safety 'while'
+ # loop above might need to be increased.
+ gdb_assert {$found_final_breakpoint} "ran all tests"
}
-gdb_breakpoint "show"
-gdb_continue_to_breakpoint "show"
-gdb_test "up" ".*"
-gdb_test "p array (1:10:2, 1:10:2)" \
- "Fortran array strides are not currently supported" \
- "using array stride gives an error"
+foreach_with_prefix repack { on off } {
+ run_test $repack
+}
diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
index a66fa6ba784..6d75a385699 100644
--- a/gdb/testsuite/gdb.fortran/array-slices.f90
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -13,58 +13,368 @@
! 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 show (message, array)
- character (len=*) :: message
+subroutine show_elem (array)
+ integer :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = "
+ write(*, fmt="(I0)", advance="no") array
+ write(*, fmt="(A)", advance="yes") ""
+
+ print *, "" ! Display Element
+end subroutine show_elem
+
+subroutine show_str (array)
+ character (len=*) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+ write (*, fmt="(A)", advance="no") "GDB = '"
+ write (*, fmt="(A)", advance="no") array
+ write (*, fmt="(A)", advance="yes") "'"
+
+ print *, "" ! Display String
+end subroutine show_str
+
+subroutine show_1d (array)
+ integer, dimension (:) :: array
+
+ print *, "Array Contents:"
+ print *, ""
+
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ write(*, fmt="(i4)", advance="no") array (i)
+ end do
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (i > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+
+ print *, "" ! Display Array Slice 1D
+end subroutine show_1d
+
+subroutine show_2d (array)
integer, dimension (:,:) :: array
- print *, message
+ print *, "Array Contents:"
+ print *, ""
+
do i=LBOUND (array, 2), UBOUND (array, 2), 1
do j=LBOUND (array, 1), UBOUND (array, 1), 1
write(*, fmt="(i4)", advance="no") array (j, i)
end do
print *, ""
- end do
- print *, array
- print *, ""
+ end do
-end subroutine show
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
-program test
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (i > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (j > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 2D
+end subroutine show_2d
+
+subroutine show_3d (array)
+ integer, dimension (:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (i > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (j > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (k > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 3D
+end subroutine show_3d
+
+subroutine show_4d (array)
+ integer, dimension (:,:,:,:) :: array
+
+ print *, ""
+ print *, "Expected GDB Output:"
+ print *, ""
+
+ write(*, fmt="(A)", advance="no") "GDB = ("
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ if (i > LBOUND (array, 4)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ if (j > LBOUND (array, 3)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ if (k > LBOUND (array, 2)) then
+ write(*, fmt="(A)", advance="no") " "
+ end if
+ write(*, fmt="(A)", advance="no") "("
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ if (l > LBOUND (array, 1)) then
+ write(*, fmt="(A)", advance="no") ", "
+ end if
+ write(*, fmt="(I0)", advance="no") array (l, k, j, i)
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="no") ")"
+ end do
+ write(*, fmt="(A)", advance="yes") ")"
+
+ print *, "" ! Display Array Slice 4D
+end subroutine show_4d
+!
+! Start of test program.
+!
+program test
interface
- subroutine show (message, array)
- character (len=*) :: message
+ subroutine show_str (array)
+ character (len=*) :: array
+ end subroutine show_str
+
+ subroutine show_1d (array)
+ integer, dimension (:) :: array
+ end subroutine show_1d
+
+ subroutine show_2d (array)
integer, dimension(:,:) :: array
- end subroutine show
+ end subroutine show_2d
+
+ subroutine show_3d (array)
+ integer, dimension(:,:,:) :: array
+ end subroutine show_3d
+
+ subroutine show_4d (array)
+ integer, dimension(:,:,:,:) :: array
+ end subroutine show_4d
end interface
+ ! Declare variables used in this test.
+ integer, dimension (-10:-1,-10:-2) :: neg_array
integer, dimension (1:10,1:10) :: array
integer, allocatable :: other (:, :)
+ character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz"
+ integer, dimension (-2:2,-2:2,-2:2) :: array3d
+ integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d
+ integer, dimension (10:20) :: array1d
+ integer, dimension(:,:), pointer :: pointer2d => null()
+ integer, dimension(-1:9,-1:9), target :: tarray
+ ! Allocate or associate any variables as needed.
allocate (other (-5:4, -2:7))
+ pointer2d => tarray
- do i=LBOUND (array, 2), UBOUND (array, 2), 1
- do j=LBOUND (array, 1), UBOUND (array, 1), 1
- array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
- end do
- end do
+ ! Fill arrays with contents ready for testing.
+ call fill_array_1d (array1d)
+
+ call fill_array_2d (neg_array)
+ call fill_array_2d (array)
+ call fill_array_2d (other)
+ call fill_array_2d (tarray)
+
+ call fill_array_3d (array3d)
+ call fill_array_4d (array4d)
+
+ ! The tests. Each call to a show_* function must have a unique set
+ ! of arguments as GDB uses the arguments are part of the test name
+ ! string, so duplicate arguments will result in duplicate test
+ ! names.
+ !
+ ! If a show_* line ends with VARS=... where '...' is a comma
+ ! separated list of variable names, these variables are assumed to
+ ! be part of the call line, and will be expanded by the test script,
+ ! for example:
+ !
+ ! do x=1,9,1
+ ! do y=x,10,1
+ ! call show_1d (some_array (x,y)) ! VARS=x,y
+ ! end do
+ ! end do
+ !
+ ! In this example the test script will automatically expand 'x' and
+ ! 'y' in order to better test different aspects of GDB. Do take
+ ! care, the expansion is not very "smart", so try to avoid clashing
+ ! with other text on the line, in the example above, avoid variables
+ ! named 'some' or 'array', as these will likely clash with
+ ! 'some_array'.
+ call show_str (str_1)
+ call show_str (str_1 (1:20))
+ call show_str (str_1 (10:20))
- do i=LBOUND (other, 2), UBOUND (other, 2), 1
- do j=LBOUND (other, 1), UBOUND (other, 1), 1
- other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
+ call show_elem (array1d (11))
+ call show_elem (pointer2d (2,3))
+
+ call show_1d (array1d)
+ call show_1d (array1d (13:17))
+ call show_1d (array1d (17:13:-1))
+ call show_1d (array (1:5,1))
+ call show_1d (array4d (1,7,3,:))
+ call show_1d (pointer2d (-1:3, 2))
+ call show_1d (pointer2d (-1, 2:4))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_1d ((array (1:5,1)))
+
+ call show_2d (pointer2d)
+ call show_2d (array)
+ call show_2d (array (1:5,1:5))
+ do i=1,10,2
+ do j=1,10,3
+ call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j
+ call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j
+ call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j
end do
end do
+ call show_2d (array (6:2:-1,3:9))
+ call show_2d (array (1:10:2, 1:10:2))
+ call show_2d (other)
+ call show_2d (other (-5:0, -2:0))
+ call show_2d (other (-5:4:2, -2:7:3))
+ call show_2d (neg_array)
+ call show_2d (neg_array (-10:-3,-8:-4:2))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_2d ((array (1:10:3, 1:10:2)))
+ call show_2d ((neg_array (-10:-3,-8:-4:2)))
- call show ("array", array)
- call show ("array (1:5,1:5)", array (1:5,1:5))
- call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
- call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
- call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
+ call show_3d (array3d)
+ call show_3d (array3d(-1:1,-1:1,-1:1))
+ call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1))
- call show ("other", other)
- call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
- call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1)))
+ call show_4d (array4d)
+ call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1))
+ call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1))
+
+ ! Enclosing the array slice argument in (...) causess gfortran to
+ ! repack the array.
+ call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1)))
+
+ ! All done. Deallocate.
deallocate (other)
+
+ ! GDB catches this final breakpoint to indicate the end of the test.
print *, "" ! Final Breakpoint.
+
+contains
+
+ ! Fill a 1D array with a unique positive integer in each element.
+ subroutine fill_array_1d (array)
+ integer, dimension (:) :: array
+ integer :: counter
+
+ counter = 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j) = counter
+ counter = counter + 1
+ end do
+ end subroutine fill_array_1d
+
+ ! Fill a 2D array with a unique positive integer in each element.
+ subroutine fill_array_2d (array)
+ integer, dimension (:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end subroutine fill_array_2d
+
+ ! Fill a 3D array with a unique positive integer in each element.
+ subroutine fill_array_3d (array)
+ integer, dimension (:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 3), UBOUND (array, 3), 1
+ do j=LBOUND (array, 2), UBOUND (array, 2), 1
+ do k=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end subroutine fill_array_3d
+
+ ! Fill a 4D array with a unique positive integer in each element.
+ subroutine fill_array_4d (array)
+ integer, dimension (:,:,:,:) :: array
+ integer :: counter
+
+ counter = 1
+ do i=LBOUND (array, 4), UBOUND (array, 4), 1
+ do j=LBOUND (array, 3), UBOUND (array, 3), 1
+ do k=LBOUND (array, 2), UBOUND (array, 2), 1
+ do l=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (l, k, j,i) = counter
+ counter = counter + 1
+ end do
+ end do
+ end do
+ end do
+ print *, ""
+ end subroutine fill_array_4d
end program test
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
index 04296ac80c9..0ab74fbbe90 100644
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -44,7 +44,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
gdb_test "print sizeof(vla1(3,2,1))" "4" \
"print sizeof element from allocated vla1"
-gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
+gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
"print sizeof sliced vla1"
# Try to access values in undefined pointer to VLA (dangling)
@@ -61,7 +61,7 @@ gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
gdb_test "print sizeof(pvla(3,2,1))" "4" \
"print sizeof element from associated pvla"
-gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
+gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
--
2.25.4
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv6] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-10-31 22:16 ` [PATCHv6] " Andrew Burgess
@ 2020-11-12 12:09 ` Andrew Burgess
2020-11-12 18:58 ` Tom Tromey
2020-11-19 11:56 ` Andrew Burgess
2 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-11-12 12:09 UTC (permalink / raw)
To: gdb-patches
Ping!
I've had positive feedback on the parts of this patch I was most
worried about, and I've simplified the array walking mechanism after
Simon's feedback.
I'm planning to push this in the next few days if there's no further
feedback.
As always I'm happy to continue supporting this code if there's
additional feedback after I've pushed it. Or get in quick before I
push!
Thanks,
Andrew
* Andrew Burgess <andrew.burgess@embecosm.com> [2020-10-31 22:16:21 +0000]:
> The changes in v6 are:
>
> - Rebase on current master,
> - Have addressed the typos and minor issues pointed out by Simon and
> Tom,
> - The f-array-walker.h logic has been rewritten slightly after
> Simon's feedback. Hopefully the logic is slightly clearer now.
> This did actually improve the code a little, the outer parenthesis
> are now printed as part of the fortran_print_array logic, rather
> than being printed elsewhere.
>
> There's still a pending question from Tom
> w.r.t. fortran_array_walker_base_impl, but this is what I have for
> now.
>
> Thanks,
> Andrew
>
> ---
>
> [PATCH] gdb/fortran: Add support for Fortran array slices at the GDB prompt
>
> This commit brings array slice support to GDB.
>
> WARNING: This patch contains a rather big hack which is limited to
> Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More
> details on this below.
>
> This patch rewrites two areas of GDB's Fortran support, the code to
> extract an array slice, and the code to print an array.
>
> After this commit a user can, from the GDB prompt, ask for a slice of
> a Fortran array and should get the correct result back. Slices can
> (optionally) have the lower bound, upper bound, and a stride
> specified. Slices can also have a negative stride.
>
> Fortran has the concept of repacking array slices. Within a compiled
> Fortran program if a user passes a non-contiguous array slice to a
> function then the compiler may have to repack the slice, this involves
> copying the elements of the slice to a new area of memory before the
> call, and copying the elements back to the original array after the
> call. Whether repacking occurs will depend on which version of
> Fortran is being used, and what type of function is being called.
>
> This commit adds support for both packed, and unpacked array slicing,
> with the default being unpacked.
>
> With an unpacked array slice, when the user asks for a slice of an
> array GDB creates a new type that accurately describes where the
> elements of the slice can be found within the original array, a
> value of this type is then returned to the user. The address of an
> element within the slice will be equal to the address of an element
> within the original array.
>
> A user can choose to select packed array slices instead using:
>
> (gdb) set fortran repack-array-slices on|off
> (gdb) show fortran repack-array-slices
>
> With packed array slices GDB creates a new type that reflects how the
> elements of the slice would look if they were laid out in contiguous
> memory, allocates a value of this type, and then fetches the elements
> from the original array and places then into the contents buffer of
> the new value.
>
> One benefit of using packed slices over unpacked slices is the memory
> usage, taking a small slice of N elements from a large array will
> require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked
> array will also include all of the "padding" between the
> non-contiguous elements. There are new tests added that highlight
> this difference.
>
> There is also a new debugging flag added with this commit that
> introduces these commands:
>
> (gdb) set debug fortran-array-slicing on|off
> (gdb) show debug fortran-array-slicing
>
> This prints information about how the array slices are being built.
>
> As both the repacking, and the array printing requires GDB to walk
> through a multi-dimensional Fortran array visiting each element, this
> commit adds the file f-array-walk.h, which introduces some
> infrastructure to support this process. This means the array printing
> code in f-valprint.c is significantly reduced.
>
> The only slight issue with this commit is the "rather big hack" that I
> mentioned above. This hack allows us to handle one specific case,
> array slices with negative strides. This is something that I don't
> believe the current GDB value contents model will allow us to
> correctly handle, and rather than rewrite the value contents code
> right now, I'm hoping to slip this hack in as a work around.
>
> The problem is that, as I see it, the current value contents model
> assumes that an object base address will be the lowest address within
> that object, and that the contents of the object start at this base
> address and occupy the TYPE_LENGTH bytes after that.
>
> ( We do have the embedded_offset, which is used for C++ sub-classes,
> such that an object can start at some offset from the content buffer,
> however, the assumption that the object then occupies the next
> TYPE_LENGTH bytes is still true within GDB. )
>
> The problem is that Fortran arrays with a negative stride don't follow
> this pattern. In this case the base address of the object points to
> the element with the highest address, the contents of the array then
> start at some offset _before_ the base address, and proceed for one
> element _past_ the base address.
>
> As the stride for such an array would be negative then, in theory the
> TYPE_LENGTH for this type would also be negative. However, in many
> places a value in GDB will degrade to a pointer + length, and the
> length almost always comes from the TYPE_LENGTH.
>
> It is my belief that in order to correctly model this case the value
> content handling of GDB will need to be reworked to split apart the
> value's content buffer (which is a block of memory with a length), and
> the object's in memory base address and length, which could be
> negative.
>
> Things are further complicated because arrays with negative strides
> like this are always dynamic types. When a value has a dynamic type
> and its base address needs resolving we actually store the address of
> the object within the resolved dynamic type, not within the value
> object itself.
>
> In short I don't currently see an easy path to cleanly support this
> situation within GDB. And so I believe that leaves two options,
> either add a work around, or catch cases where the user tries to make
> use of a negative stride, or access an array with a negative stride,
> and throw an error.
>
> This patch currently goes with adding a work around, which is that
> when we resolve a dynamic Fortran array type, if the stride is
> negative, then we adjust the base address to point to the lowest
> address required by the array. The printing and slicing code is aware
> of this adjustment and will correctly slice and print Fortran arrays.
>
> Where this hack will show through to the user is if they ask for the
> address of an array in their program with a negative array stride, the
> address they get from GDB will not match the address that would be
> computed within the Fortran program.
>
> gdb/ChangeLog:
>
> * Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
> * NEWS: Mention new options.
> * f-array-walker.h: New file.
> * f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
> (repack_array_slices): New static global.
> (show_repack_array_slices): New function.
> (fortran_array_slicing_debug): New static global.
> (show_fortran_array_slicing_debug): New function.
> (value_f90_subarray): Delete.
> (skip_undetermined_arglist): Delete.
> (class fortran_array_repacker_base_impl): New class.
> (class fortran_lazy_array_repacker_impl): New class.
> (class fortran_array_repacker_impl): New class.
> (fortran_value_subarray): Complete rewrite.
> (set_fortran_list): New static global.
> (show_fortran_list): Likewise.
> (_initialize_f_language): Register new commands.
> (fortran_adjust_dynamic_array_base_address_hack): New function.
> * f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
> Declare.
> * f-valprint.c: Include 'f-array-walker.h'.
> (class fortran_array_printer_impl): New class.
> (f77_print_array_1): Delete.
> (f77_print_array): Delete.
> (fortran_print_array): New.
> (f_value_print_inner): Update to call fortran_print_array.
> * gdbtypes.c: Include 'f-lang.h'.
> (resolve_dynamic_type_internal): Call
> fortran_adjust_dynamic_array_base_address_hack.
>
> gdb/testsuite/ChangeLog:
>
> * gdb.fortran/array-slices-bad.exp: New file.
> * gdb.fortran/array-slices-bad.f90: New file.
> * gdb.fortran/array-slices-sub-slices.exp: New file.
> * gdb.fortran/array-slices-sub-slices.f90: New file.
> * gdb.fortran/array-slices.exp: Rewrite tests.
> * gdb.fortran/array-slices.f90: Rewrite tests.
> * gdb.fortran/vla-sizeof.exp: Correct expected results.
>
> gdb/doc/ChangeLog:
>
> * gdb.texinfo (Debugging Output): Document 'set/show debug
> fortran-array-slicing'.
> (Special Fortran Commands): Document 'set/show fortran
> repack-array-slices'.
> ---
> gdb/ChangeLog | 32 +
> gdb/Makefile.in | 1 +
> gdb/NEWS | 13 +
> gdb/doc/ChangeLog | 7 +
> gdb/doc/gdb.texinfo | 32 +
> gdb/f-array-walker.h | 265 +++++++
> gdb/f-lang.c | 712 ++++++++++++++++--
> gdb/f-lang.h | 19 +-
> gdb/f-valprint.c | 187 +++--
> gdb/gdbtypes.c | 12 +-
> gdb/testsuite/ChangeLog | 10 +
> .../gdb.fortran/array-slices-bad.exp | 69 ++
> .../gdb.fortran/array-slices-bad.f90 | 42 ++
> .../gdb.fortran/array-slices-sub-slices.exp | 111 +++
> .../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
> gdb/testsuite/gdb.fortran/array-slices.exp | 277 +++++--
> gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
> gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
> 18 files changed, 1998 insertions(+), 255 deletions(-)
> create mode 100644 gdb/f-array-walker.h
> create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
> create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
> create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
> create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
>
> diff --git a/gdb/Makefile.in b/gdb/Makefile.in
> index 8a160896e2c..1838743a883 100644
> --- a/gdb/Makefile.in
> +++ b/gdb/Makefile.in
> @@ -1273,6 +1273,7 @@ HFILES_NO_SRCDIR = \
> expression.h \
> extension.h \
> extension-priv.h \
> + f-array-walker.h \
> f-lang.h \
> fbsd-nat.h \
> fbsd-tdep.h \
> diff --git a/gdb/NEWS b/gdb/NEWS
> index c99d3181a8b..be4b2956f17 100644
> --- a/gdb/NEWS
> +++ b/gdb/NEWS
> @@ -153,6 +153,19 @@ maintenance print core-file-backed-mappings
> Prints file-backed mappings loaded from a core file's note section.
> Output is expected to be similar to that of "info proc mappings".
>
> +set debug fortran-array-slicing on|off
> +show debug fortran-array-slicing
> + Print debugging when taking slices of Fortran arrays.
> +
> +set fortran repack-array-slices on|off
> +show fortran repack-array-slices
> + When taking slices from Fortran arrays and strings, if the slice is
> + non-contiguous within the original value then, when this option is
> + on, the new value will be repacked into a single contiguous value.
> + When this option is off, then the value returned will consist of a
> + descriptor that describes the slice within the memory of the
> + original parent value.
> +
> * Changed commands
>
> alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...]
> diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
> index d779d4a84f1..9e21d65c650 100644
> --- a/gdb/doc/gdb.texinfo
> +++ b/gdb/doc/gdb.texinfo
> @@ -16989,6 +16989,29 @@
> block whose name is @var{common-name}. With no argument, the names of
> all @code{COMMON} blocks visible at the current program location are
> printed.
> +@cindex arrays slices (Fortran)
> +@kindex set fortran repack-array-slices
> +@kindex show fortran repack-array-slices
> +@item set fortran repack-array-slices [on|off]
> +@item show fortran repack-array-slices
> +When taking a slice from an array, a Fortran compiler can choose to
> +either produce an array descriptor that describes the slice in place,
> +or it may repack the slice, copying the elements of the slice into a
> +new region of memory.
> +
> +When this setting is on, then @value{GDBN} will also repack array
> +slices in some situations. When this setting is off, then
> +@value{GDBN} will create array descriptors for slices that reference
> +the original data in place.
> +
> +@value{GDBN} will never repack an array slice if the data for the
> +slice is contiguous within the original array.
> +
> +@value{GDBN} will always repack string slices if the data for the
> +slice is non-contiguous within the original string as @value{GDBN}
> +does not support printing non-contiguous strings.
> +
> +The default for this setting is @code{off}.
> @end table
>
> @node Pascal
> @@ -26581,6 +26604,15 @@
> @item show debug fbsd-nat
> Show the current state of FreeBSD native target debugging messages.
>
> +@item set debug fortran-array-slicing
> +@cindex fortran array slicing debugging info
> +Turns on or off display of @value{GDBN} Fortran array slicing
> +debugging info. The default is off.
> +
> +@item show debug fortran-array-slicing
> +Displays the current state of displaying @value{GDBN} Fortran array
> +slicing debugging info.
> +
> @item set debug frame
> @cindex frame debugging info
> Turns on or off display of @value{GDBN} frame debugging info. The
> diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h
> new file mode 100644
> index 00000000000..417f9f07980
> --- /dev/null
> +++ b/gdb/f-array-walker.h
> @@ -0,0 +1,265 @@
> +/* Copyright (C) 2020 Free Software Foundation, Inc.
> +
> + This file is part of GDB.
> +
> + 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/>. */
> +
> +/* Support classes to wrap up the process of iterating over a
> + multi-dimensional Fortran array. */
> +
> +#ifndef F_ARRAY_WALKER_H
> +#define F_ARRAY_WALKER_H
> +
> +#include "defs.h"
> +#include "gdbtypes.h"
> +#include "f-lang.h"
> +
> +/* Class for calculating the byte offset for elements within a single
> + dimension of a Fortran array. */
> +class fortran_array_offset_calculator
> +{
> +public:
> + /* Create a new offset calculator for TYPE, which is either an array or a
> + string. */
> + explicit fortran_array_offset_calculator (struct type *type)
> + {
> + /* Validate the type. */
> + type = check_typedef (type);
> + if (type->code () != TYPE_CODE_ARRAY
> + && (type->code () != TYPE_CODE_STRING))
> + error (_("can only compute offsets for arrays and strings"));
> +
> + /* Get the range, and extract the bounds. */
> + struct type *range_type = type->index_type ();
> + if (get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound) < 0)
> + error ("unable to read array bounds");
> +
> + /* Figure out the stride for this array. */
> + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
> + m_stride = type->index_type ()->bounds ()->bit_stride ();
> + if (m_stride == 0)
> + m_stride = type_length_units (elt_type);
> + else
> + {
> + struct gdbarch *arch = get_type_arch (elt_type);
> + int unit_size = gdbarch_addressable_memory_unit_size (arch);
> + m_stride /= (unit_size * 8);
> + }
> + };
> +
> + /* Get the byte offset for element INDEX within the type we are working
> + on. There is no bounds checking done on INDEX. If the stride is
> + negative then we still assume that the base address (for the array
> + object) points to the element with the lowest memory address, we then
> + calculate an offset assuming that index 0 will be the element at the
> + highest address, index 1 the next highest, and so on. This is not
> + quite how Fortran works in reality; in reality the base address of
> + the object would point at the element with the highest address, and
> + we would index backwards from there in the "normal" way, however,
> + GDB's current value contents model doesn't support having the base
> + address be near to the end of the value contents, so we currently
> + adjust the base address of Fortran arrays with negative strides so
> + their base address points at the lowest memory address. This code
> + here is part of working around this weirdness. */
> + LONGEST index_offset (LONGEST index)
> + {
> + LONGEST offset;
> + if (m_stride < 0)
> + offset = std::abs (m_stride) * (m_upperbound - index);
> + else
> + offset = std::abs (m_stride) * (index - m_lowerbound);
> + return offset;
> + }
> +
> +private:
> +
> + /* The stride for the type we are working with. */
> + LONGEST m_stride;
> +
> + /* The upper bound for the type we are working with. */
> + LONGEST m_upperbound;
> +
> + /* The lower bound for the type we are working with. */
> + LONGEST m_lowerbound;
> +};
> +
> +/* A base class used by fortran_array_walker. There's no virtual methods
> + here, sub-classes should just override the functions they want in order
> + to specialise the behaviour to their needs. The functionality
> + provided in these default implementations will visit every array
> + element, but do nothing for each element. */
> +
> +struct fortran_array_walker_base_impl
> +{
> + /* Called when iterating between the lower and upper bounds of each
> + dimension of the array. Return true if GDB should continue iterating,
> + otherwise, return false.
> +
> + SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
> + be taken into consideration when deciding what to return. If
> + SHOULD_CONTINUE is false then this function must also return false,
> + the function is still called though in case extra work needs to be
> + done as part of the stopping process. */
> + bool continue_walking (bool should_continue)
> + { return should_continue; }
> +
> + /* Called when GDB starts iterating over a dimension of the array. The
> + argument INNER_P is true for the inner most dimension (the dimension
> + containing the actual elements of the array), and false for more outer
> + dimensions. For a concrete example of how this function is called
> + see the comment on process_element below. */
> + void start_dimension (bool inner_p)
> + { /* Nothing. */ }
> +
> + /* Called when GDB finishes iterating over a dimension of the array. The
> + argument INNER_P is true for the inner most dimension (the dimension
> + containing the actual elements of the array), and false for more outer
> + dimensions. LAST_P is true for the last call at a particular
> + dimension. For a concrete example of how this function is called
> + see the comment on process_element below. */
> + void finish_dimension (bool inner_p, bool last_p)
> + { /* Nothing. */ }
> +
> + /* Called when processing the inner most dimension of the array, for
> + every element in the array. ELT_TYPE is the type of the element being
> + extracted, and ELT_OFF is the offset of the element from the start of
> + array being walked, and LAST_P is true only when this is the last
> + element that will be processed in this dimension.
> +
> + Given this two dimensional array ((1, 2) (3, 4)), the calls to
> + start_dimension, process_element, and finish_dimension look like this:
> +
> + start_dimension (false);
> + start_dimension (true);
> + process_element (TYPE, OFFSET, false);
> + process_element (TYPE, OFFSET, true);
> + finish_dimension (true, false);
> + start_dimension (true);
> + process_element (TYPE, OFFSET, false);
> + process_element (TYPE, OFFSET, true);
> + finish_dimension (true, true);
> + finish_dimension (false, true); */
> + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
> + { /* Nothing. */ }
> +};
> +
> +/* A class to wrap up the process of iterating over a multi-dimensional
> + Fortran array. IMPL is used to specialise what happens as we walk over
> + the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
> + methods than can be used to customise the array walk. */
> +template<typename Impl>
> +class fortran_array_walker
> +{
> + /* Ensure that Impl is derived from the required base class. This just
> + ensures that all of the required API methods are available and have a
> + sensible default implementation. */
> + gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
> +
> +public:
> + /* Create a new array walker. TYPE is the type of the array being walked
> + over, and ADDRESS is the base address for the object of TYPE in
> + memory. All other arguments are forwarded to the constructor of the
> + template parameter class IMPL. */
> + template <typename ...Args>
> + fortran_array_walker (struct type *type, CORE_ADDR address,
> + Args... args)
> + : m_type (type),
> + m_address (address),
> + m_impl (type, address, args...)
> + {
> + m_ndimensions = calc_f77_array_dims (m_type);
> + }
> +
> + /* Walk the array. */
> + void
> + walk ()
> + {
> + walk_1 (1, m_type, 0, false);
> + }
> +
> +private:
> + /* The core of the array walking algorithm. NSS is the current
> + dimension number being processed, TYPE is the type of this dimension,
> + and OFFSET is the offset (in bytes) for the start of this dimension. */
> + void
> + walk_1 (int nss, struct type *type, int offset, bool last_p)
> + {
> + /* Extract the range, and get lower and upper bounds. */
> + struct type *range_type = check_typedef (type)->index_type ();
> + LONGEST lowerbound, upperbound;
> + if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
> + error ("failed to get range bounds");
> +
> + /* CALC is used to calculate the offsets for each element in this
> + dimension. */
> + fortran_array_offset_calculator calc (type);
> +
> + m_impl.start_dimension (nss == m_ndimensions);
> +
> + if (nss != m_ndimensions)
> + {
> + /* For dimensions other than the inner most, walk each element and
> + recurse while peeling off one more dimension of the array. */
> + for (LONGEST i = lowerbound;
> + m_impl.continue_walking (i < upperbound + 1);
> + i++)
> + {
> + /* Use the index and the stride to work out a new offset. */
> + LONGEST new_offset = offset + calc.index_offset (i);
> +
> + /* Now print the lower dimension. */
> + struct type *subarray_type
> + = TYPE_TARGET_TYPE (check_typedef (type));
> + walk_1 (nss + 1, subarray_type, new_offset, (i == upperbound));
> + }
> + }
> + else
> + {
> + /* For the inner most dimension of the array, process each element
> + within this dimension. */
> + for (LONGEST i = lowerbound;
> + m_impl.continue_walking (i < upperbound + 1);
> + i++)
> + {
> + LONGEST elt_off = offset + calc.index_offset (i);
> +
> + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
> + if (is_dynamic_type (elt_type))
> + {
> + CORE_ADDR e_address = m_address + elt_off;
> + elt_type = resolve_dynamic_type (elt_type, {}, e_address);
> + }
> +
> + m_impl.process_element (elt_type, elt_off, (i == upperbound));
> + }
> + }
> +
> + m_impl.finish_dimension (nss == m_ndimensions, last_p || nss == 1);
> + }
> +
> + /* The array type being processed. */
> + struct type *m_type;
> +
> + /* The address in target memory for the object of M_TYPE being
> + processed. This is required in order to resolve dynamic types. */
> + CORE_ADDR m_address;
> +
> + /* An instance of the template specialisation class. */
> + Impl m_impl;
> +
> + /* The total number of dimensions in M_TYPE. */
> + int m_ndimensions;
> +};
> +
> +#endif /* F_ARRAY_WALKER_H */
> diff --git a/gdb/f-lang.c b/gdb/f-lang.c
> index 52493743031..d9b2e715442 100644
> --- a/gdb/f-lang.c
> +++ b/gdb/f-lang.c
> @@ -36,9 +36,36 @@
> #include "c-lang.h"
> #include "target-float.h"
> #include "gdbarch.h"
> +#include "gdbcmd.h"
> +#include "f-array-walker.h"
>
> #include <math.h>
>
> +/* Whether GDB should repack array slices created by the user. */
> +static bool repack_array_slices = false;
> +
> +/* Implement 'show fortran repack-array-slices'. */
> +static void
> +show_repack_array_slices (struct ui_file *file, int from_tty,
> + struct cmd_list_element *c, const char *value)
> +{
> + fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"),
> + value);
> +}
> +
> +/* Debugging of Fortran's array slicing. */
> +static bool fortran_array_slicing_debug = false;
> +
> +/* Implement 'show debug fortran-array-slicing'. */
> +static void
> +show_fortran_array_slicing_debug (struct ui_file *file, int from_tty,
> + struct cmd_list_element *c,
> + const char *value)
> +{
> + fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"),
> + value);
> +}
> +
> /* Local functions */
>
> /* Return the encoding that should be used for the character type
> @@ -114,57 +141,6 @@ enum f_primitive_types {
> nr_f_primitive_types
> };
>
> -/* Called from fortran_value_subarray to take a slice of an array or a
> - string. ARRAY is the array or string to be accessed. EXP, POS, and
> - NOSIDE are as for evaluate_subexp_standard. Return a value that is a
> - slice of the array. */
> -
> -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, stride;
> - struct type *range = check_typedef (value_type (array)->index_type ());
> - enum range_flag range_flag
> - = (enum range_flag) longest_to_int (exp->elts[pc].longconst);
> -
> - *pos += 3;
> -
> - if (range_flag & RANGE_LOW_BOUND_DEFAULT)
> - low_bound = range->bounds ()->low.const_val ();
> - else
> - low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> -
> - if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
> - high_bound = range->bounds ()->high.const_val ();
> - else
> - high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> -
> - if (range_flag & RANGE_HAS_STRIDE)
> - stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> - else
> - stride = 1;
> -
> - if (stride != 1)
> - error (_("Fortran array strides are not currently supported"));
> -
> - return value_slice (array, low_bound, high_bound - low_bound + 1);
> -}
> -
> -/* Helper for skipping all the arguments in an undetermined argument list.
> - This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
> - case of evaluate_subexp_standard as multiple, but not all, code paths
> - require a generic skip. */
> -
> -static void
> -skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
> - enum noside noside)
> -{
> - for (int i = 0; i < nargs; ++i)
> - evaluate_subexp (nullptr, exp, pos, noside);
> -}
> -
> /* Return the number of dimensions for a Fortran array or string. */
>
> int
> @@ -189,6 +165,145 @@ calc_f77_array_dims (struct type *array_type)
> return ndimen;
> }
>
> +/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
> + slices. This is a base class for two alternative repacking mechanisms,
> + one for when repacking from a lazy value, and one for repacking from a
> + non-lazy (already loaded) value. */
> +class fortran_array_repacker_base_impl
> + : public fortran_array_walker_base_impl
> +{
> +public:
> + /* Constructor, DEST is the value we are repacking into. */
> + fortran_array_repacker_base_impl (struct value *dest)
> + : m_dest (dest),
> + m_dest_offset (0)
> + { /* Nothing. */ }
> +
> + /* When we start processing the inner most dimension, this is where we
> + will be creating values for each element as we load them and then copy
> + them into the M_DEST value. Set a value mark so we can free these
> + temporary values. */
> + void start_dimension (bool inner_p)
> + {
> + if (inner_p)
> + {
> + gdb_assert (m_mark == nullptr);
> + m_mark = value_mark ();
> + }
> + }
> +
> + /* When we finish processing the inner most dimension free all temporary
> + value that were created. */
> + void finish_dimension (bool inner_p, bool last_p)
> + {
> + if (inner_p)
> + {
> + gdb_assert (m_mark != nullptr);
> + value_free_to_mark (m_mark);
> + m_mark = nullptr;
> + }
> + }
> +
> +protected:
> + /* Copy the contents of array element ELT into M_DEST at the next
> + available offset. */
> + void copy_element_to_dest (struct value *elt)
> + {
> + value_contents_copy (m_dest, m_dest_offset, elt, 0,
> + TYPE_LENGTH (value_type (elt)));
> + m_dest_offset += TYPE_LENGTH (value_type (elt));
> + }
> +
> + /* The value being written to. */
> + struct value *m_dest;
> +
> + /* The byte offset in M_DEST at which the next element should be
> + written. */
> + LONGEST m_dest_offset;
> +
> + /* Set with a call to VALUE_MARK, and then reset after calling
> + VALUE_FREE_TO_MARK. */
> + struct value *m_mark = nullptr;
> +};
> +
> +/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
> + slices. This class is specialised for repacking an array slice from a
> + lazy array value, as such it does not require the parent array value to
> + be loaded into GDB's memory; the parent value could be huge, while the
> + slice could be tiny. */
> +class fortran_lazy_array_repacker_impl
> + : public fortran_array_repacker_base_impl
> +{
> +public:
> + /* Constructor. TYPE is the type of the slice being loaded from the
> + parent value, so this type will correctly reflect the strides required
> + to find all of the elements from the parent value. ADDRESS is the
> + address in target memory of value matching TYPE, and DEST is the value
> + we are repacking into. */
> + explicit fortran_lazy_array_repacker_impl (struct type *type,
> + CORE_ADDR address,
> + struct value *dest)
> + : fortran_array_repacker_base_impl (dest),
> + m_addr (address)
> + { /* Nothing. */ }
> +
> + /* Create a lazy value in target memory representing a single element,
> + then load the element into GDB's memory and copy the contents into the
> + destination value. */
> + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
> + {
> + copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off));
> + }
> +
> +private:
> + /* The address in target memory where the parent value starts. */
> + CORE_ADDR m_addr;
> +};
> +
> +/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
> + slices. This class is specialised for repacking an array slice from a
> + previously loaded (non-lazy) array value, as such it fetches the
> + element values from the contents of the parent value. */
> +class fortran_array_repacker_impl
> + : public fortran_array_repacker_base_impl
> +{
> +public:
> + /* Constructor. TYPE is the type for the array slice within the parent
> + value, as such it has stride values as required to find the elements
> + within the original parent value. ADDRESS is the address in target
> + memory of the value matching TYPE. BASE_OFFSET is the offset from
> + the start of VAL's content buffer to the start of the object of TYPE,
> + VAL is the parent object from which we are loading the value, and
> + DEST is the value into which we are repacking. */
> + explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address,
> + LONGEST base_offset,
> + struct value *val, struct value *dest)
> + : fortran_array_repacker_base_impl (dest),
> + m_base_offset (base_offset),
> + m_val (val)
> + {
> + gdb_assert (!value_lazy (val));
> + }
> +
> + /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF)
> + from the content buffer of M_VAL then copy this extracted value into
> + the repacked destination value. */
> + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
> + {
> + struct value *elt
> + = value_from_component (m_val, elt_type, (elt_off + m_base_offset));
> + copy_element_to_dest (elt);
> + }
> +
> +private:
> + /* The offset into the content buffer of M_VAL to the start of the slice
> + being extracted. */
> + LONGEST m_base_offset;
> +
> + /* The parent value from which we are extracting a slice. */
> + struct value *m_val;
> +};
> +
> /* Called from evaluate_subexp_standard to perform array indexing, and
> sub-range extraction, for Fortran. As well as arrays this function
> also handles strings as they can be treated like arrays of characters.
> @@ -200,51 +315,394 @@ static struct value *
> fortran_value_subarray (struct value *array, struct expression *exp,
> int *pos, int nargs, enum noside noside)
> {
> - if (exp->elts[*pos].opcode == OP_RANGE)
> - return value_f90_subarray (array, exp, pos, noside);
> -
> - if (noside == EVAL_SKIP)
> + type *original_array_type = check_typedef (value_type (array));
> + bool is_string_p = original_array_type->code () == TYPE_CODE_STRING;
> +
> + /* Perform checks for ARRAY not being available. The somewhat overly
> + complex logic here is just to keep backward compatibility with the
> + errors that we used to get before FORTRAN_VALUE_SUBARRAY was
> + rewritten. Maybe a future task would streamline the error messages we
> + get here, and update all the expected test results. */
> + if (exp->elts[*pos].opcode != OP_RANGE)
> + {
> + if (type_not_associated (original_array_type))
> + error (_("no such vector element (vector not associated)"));
> + else if (type_not_allocated (original_array_type))
> + error (_("no such vector element (vector not allocated)"));
> + }
> + else
> {
> - skip_undetermined_arglist (nargs, exp, pos, noside);
> - /* Return the dummy value with the correct type. */
> - return array;
> + if (type_not_associated (original_array_type))
> + error (_("array not associated"));
> + else if (type_not_allocated (original_array_type))
> + error (_("array not allocated"));
> }
>
> - LONGEST subscript_array[MAX_FORTRAN_DIMS];
> - int ndimensions = 1;
> - struct type *type = check_typedef (value_type (array));
> + /* First check that the number of dimensions in the type we are slicing
> + matches the number of arguments we were passed. */
> + int ndimensions = calc_f77_array_dims (original_array_type);
> + if (nargs != ndimensions)
> + error (_("Wrong number of subscripts"));
> +
> + /* This will be initialised below with the type of the elements held in
> + ARRAY. */
> + struct type *inner_element_type;
> +
> + /* Extract the types of each array dimension from the original array
> + type. We need these available so we can fill in the default upper and
> + lower bounds if the user requested slice doesn't provide that
> + information. Additionally unpacking the dimensions like this gives us
> + the inner element type. */
> + std::vector<struct type *> dim_types;
> + {
> + dim_types.reserve (ndimensions);
> + struct type *type = original_array_type;
> + for (int i = 0; i < ndimensions; ++i)
> + {
> + dim_types.push_back (type);
> + type = TYPE_TARGET_TYPE (type);
> + }
> + /* TYPE is now the inner element type of the array, we start the new
> + array slice off as this type, then as we process the requested slice
> + (from the user) we wrap new types around this to build up the final
> + slice type. */
> + inner_element_type = type;
> + }
> +
> + /* As we analyse the new slice type we need to understand if the data
> + being referenced is contiguous. Do decide this we must track the size
> + of an element at each dimension of the new slice array. Initially the
> + elements of the inner most dimension of the array are the same inner
> + most elements as the original ARRAY. */
> + LONGEST slice_element_size = TYPE_LENGTH (inner_element_type);
> +
> + /* Start off assuming all data is contiguous, this will be set to false
> + if access to any dimension results in non-contiguous data. */
> + bool is_all_contiguous = true;
> +
> + /* The TOTAL_OFFSET is the distance in bytes from the start of the
> + original ARRAY to the start of the new slice. This is calculated as
> + we process the information from the user. */
> + LONGEST total_offset = 0;
> +
> + /* A structure representing information about each dimension of the
> + resulting slice. */
> + struct slice_dim
> + {
> + /* Constructor. */
> + slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx)
> + : low (l),
> + high (h),
> + stride (s),
> + index (idx)
> + { /* Nothing. */ }
> +
> + /* The low bound for this dimension of the slice. */
> + LONGEST low;
> +
> + /* The high bound for this dimension of the slice. */
> + LONGEST high;
> +
> + /* The byte stride for this dimension of the slice. */
> + LONGEST stride;
> +
> + struct type *index;
> + };
> +
> + /* The dimensions of the resulting slice. */
> + std::vector<slice_dim> slice_dims;
> +
> + /* Process the incoming arguments. These arguments are in the reverse
> + order to the array dimensions, that is the first argument refers to
> + the last array dimension. */
> + if (fortran_array_slicing_debug)
> + debug_printf ("Processing array access:\n");
> + for (int i = 0; i < nargs; ++i)
> + {
> + /* For each dimension of the array the user will have either provided
> + a ranged access with optional lower bound, upper bound, and
> + stride, or the user will have supplied a single index. */
> + struct type *dim_type = dim_types[ndimensions - (i + 1)];
> + if (exp->elts[*pos].opcode == OP_RANGE)
> + {
> + int pc = (*pos) + 1;
> + enum range_flag range_flag = (enum range_flag) exp->elts[pc].longconst;
> + *pos += 3;
> +
> + LONGEST low, high, stride;
> + low = high = stride = 0;
> +
> + if ((range_flag & RANGE_LOW_BOUND_DEFAULT) == 0)
> + low = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> + else
> + low = f77_get_lowerbound (dim_type);
> + if ((range_flag & RANGE_HIGH_BOUND_DEFAULT) == 0)
> + high = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> + else
> + high = f77_get_upperbound (dim_type);
> + if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
> + stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> + else
> + stride = 1;
> +
> + if (stride == 0)
> + error (_("stride must not be 0"));
> +
> + /* Get information about this dimension in the original ARRAY. */
> + struct type *target_type = TYPE_TARGET_TYPE (dim_type);
> + struct type *index_type = dim_type->index_type ();
> + LONGEST lb = f77_get_lowerbound (dim_type);
> + LONGEST ub = f77_get_upperbound (dim_type);
> + LONGEST sd = index_type->bit_stride ();
> + if (sd == 0)
> + sd = TYPE_LENGTH (target_type) * 8;
> +
> + if (fortran_array_slicing_debug)
> + {
> + debug_printf ("|-> Range access\n");
> + std::string str = type_to_string (dim_type);
> + debug_printf ("| |-> Type: %s\n", str.c_str ());
> + debug_printf ("| |-> Array:\n");
> + debug_printf ("| | |-> Low bound: %ld\n", lb);
> + debug_printf ("| | |-> High bound: %ld\n", ub);
> + debug_printf ("| | |-> Bit stride: %ld\n", sd);
> + debug_printf ("| | |-> Byte stride: %ld\n", sd / 8);
> + debug_printf ("| | |-> Type size: %ld\n",
> + TYPE_LENGTH (dim_type));
> + debug_printf ("| | '-> Target type size: %ld\n",
> + TYPE_LENGTH (target_type));
> + debug_printf ("| |-> Accessing:\n");
> + debug_printf ("| | |-> Low bound: %ld\n",
> + low);
> + debug_printf ("| | |-> High bound: %ld\n",
> + high);
> + debug_printf ("| | '-> Element stride: %ld\n",
> + stride);
> + }
> +
> + /* Check the user hasn't asked for something invalid. */
> + if (high > ub || low < lb)
> + error (_("array subscript out of bounds"));
> +
> + /* Calculate what this dimension of the new slice array will look
> + like. OFFSET is the byte offset from the start of the
> + previous (more outer) dimension to the start of this
> + dimension. E_COUNT is the number of elements in this
> + dimension. REMAINDER is the number of elements remaining
> + between the last included element and the upper bound. For
> + example an access '1:6:2' will include elements 1, 3, 5 and
> + have a remainder of 1 (element #6). */
> + LONGEST lowest = std::min (low, high);
> + LONGEST offset = (sd / 8) * (lowest - lb);
> + LONGEST e_count = std::abs (high - low) + 1;
> + e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride);
> + LONGEST new_low = 1;
> + LONGEST new_high = new_low + e_count - 1;
> + LONGEST new_stride = (sd * stride) / 8;
> + LONGEST last_elem = low + ((e_count - 1) * stride);
> + LONGEST remainder = high - last_elem;
> + if (low > high)
> + {
> + offset += std::abs (remainder) * TYPE_LENGTH (target_type);
> + if (stride > 0)
> + error (_("incorrect stride and boundary combination"));
> + }
> + else if (stride < 0)
> + error (_("incorrect stride and boundary combination"));
> +
> + /* Is the data within this dimension contiguous? It is if the
> + newly computed stride is the same size as a single element of
> + this dimension. */
> + bool is_dim_contiguous = (new_stride == slice_element_size);
> + is_all_contiguous &= is_dim_contiguous;
>
> - if (nargs > MAX_FORTRAN_DIMS)
> - error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
> + if (fortran_array_slicing_debug)
> + {
> + debug_printf ("| '-> Results:\n");
> + debug_printf ("| |-> Offset = %ld\n", offset);
> + debug_printf ("| |-> Elements = %ld\n", e_count);
> + debug_printf ("| |-> Low bound = %ld\n", new_low);
> + debug_printf ("| |-> High bound = %ld\n", new_high);
> + debug_printf ("| |-> Byte stride = %ld\n", new_stride);
> + debug_printf ("| |-> Last element = %ld\n", last_elem);
> + debug_printf ("| |-> Remainder = %ld\n", remainder);
> + debug_printf ("| '-> Contiguous = %s\n",
> + (is_dim_contiguous ? "Yes" : "No"));
> + }
>
> - ndimensions = calc_f77_array_dims (type);
> + /* Figure out how big (in bytes) an element of this dimension of
> + the new array slice will be. */
> + slice_element_size = std::abs (new_stride * e_count);
>
> - if (nargs != ndimensions)
> - error (_("Wrong number of subscripts"));
> + slice_dims.emplace_back (new_low, new_high, new_stride,
> + index_type);
> +
> + /* Update the total offset. */
> + total_offset += offset;
> + }
> + else
> + {
> + /* There is a single index for this dimension. */
> + LONGEST index
> + = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside));
> +
> + /* Get information about this dimension in the original ARRAY. */
> + struct type *target_type = TYPE_TARGET_TYPE (dim_type);
> + struct type *index_type = dim_type->index_type ();
> + LONGEST lb = f77_get_lowerbound (dim_type);
> + LONGEST ub = f77_get_upperbound (dim_type);
> + LONGEST sd = index_type->bit_stride () / 8;
> + if (sd == 0)
> + sd = TYPE_LENGTH (target_type);
> +
> + if (fortran_array_slicing_debug)
> + {
> + debug_printf ("|-> Index access\n");
> + std::string str = type_to_string (dim_type);
> + debug_printf ("| |-> Type: %s\n", str.c_str ());
> + debug_printf ("| |-> Array:\n");
> + debug_printf ("| | |-> Low bound: %ld\n", lb);
> + debug_printf ("| | |-> High bound: %ld\n", ub);
> + debug_printf ("| | |-> Byte stride: %ld\n", sd);
> + debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type));
> + debug_printf ("| | '-> Target type size: %ld\n",
> + TYPE_LENGTH (target_type));
> + debug_printf ("| '-> Accessing:\n");
> + debug_printf ("| '-> Index: %ld\n", index);
> + }
>
> - gdb_assert (nargs > 0);
> + /* If the array has actual content then check the index is in
> + bounds. An array without content (an unbound array) doesn't
> + have a known upper bound, so don't error check in that
> + situation. */
> + if (index < lb
> + || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED
> + && index > ub)
> + || (VALUE_LVAL (array) != lval_memory
> + && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED))
> + {
> + if (type_not_associated (dim_type))
> + error (_("no such vector element (vector not associated)"));
> + else if (type_not_allocated (dim_type))
> + error (_("no such vector element (vector not allocated)"));
> + else
> + error (_("no such vector element"));
> + }
> +
> + /* Calculate using the type stride, not the target type size. */
> + LONGEST offset = sd * (index - lb);
> + total_offset += offset;
> + }
> + }
>
> - /* Now that we know we have a legal array subscript expression let us
> - actually find out where this element exists in the array. */
> + if (noside == EVAL_SKIP)
> + return array;
>
> - /* Take array indices left to right. */
> - for (int i = 0; i < nargs; i++)
> + /* Build a type that represents the new array slice in the target memory
> + of the original ARRAY, this type makes use of strides to correctly
> + find only those elements that are part of the new slice. */
> + struct type *array_slice_type = inner_element_type;
> + for (const auto &d : slice_dims)
> {
> - /* Evaluate each subscript; it must be a legal integer in F77. */
> - value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
> + /* Create the range. */
> + dynamic_prop p_low, p_high, p_stride;
> +
> + p_low.set_const_val (d.low);
> + p_high.set_const_val (d.high);
> + p_stride.set_const_val (d.stride);
> +
> + struct type *new_range
> + = create_range_type_with_stride ((struct type *) NULL,
> + TYPE_TARGET_TYPE (d.index),
> + &p_low, &p_high, 0, &p_stride,
> + true);
> + array_slice_type
> + = create_array_type (nullptr, array_slice_type, new_range);
> + }
>
> - /* Fill in the subscript array. */
> - subscript_array[i] = value_as_long (arg2);
> + if (fortran_array_slicing_debug)
> + {
> + debug_printf ("'-> Final result:\n");
> + debug_printf (" |-> Type: %s\n",
> + type_to_string (array_slice_type).c_str ());
> + debug_printf (" |-> Total offset: %ld\n", total_offset);
> + debug_printf (" |-> Base address: %s\n",
> + core_addr_to_string (value_address (array)));
> + debug_printf (" '-> Contiguous = %s\n",
> + (is_all_contiguous ? "Yes" : "No"));
> }
>
> - /* Internal type of array is arranged right to left. */
> - for (int i = nargs; i > 0; i--)
> + /* Should we repack this array slice? */
> + if (!is_all_contiguous && (repack_array_slices || is_string_p))
> {
> - struct type *array_type = check_typedef (value_type (array));
> - LONGEST index = subscript_array[i - 1];
> + /* Build a type for the repacked slice. */
> + struct type *repacked_array_type = inner_element_type;
> + for (const auto &d : slice_dims)
> + {
> + /* Create the range. */
> + dynamic_prop p_low, p_high, p_stride;
> +
> + p_low.set_const_val (d.low);
> + p_high.set_const_val (d.high);
> + p_stride.set_const_val (TYPE_LENGTH (repacked_array_type));
> +
> + struct type *new_range
> + = create_range_type_with_stride ((struct type *) NULL,
> + TYPE_TARGET_TYPE (d.index),
> + &p_low, &p_high, 0, &p_stride,
> + true);
> + repacked_array_type
> + = create_array_type (nullptr, repacked_array_type, new_range);
> + }
>
> - array = value_subscripted_rvalue (array, index,
> - f77_get_lowerbound (array_type));
> + /* Now copy the elements from the original ARRAY into the packed
> + array value DEST. */
> + struct value *dest = allocate_value (repacked_array_type);
> + if (value_lazy (array)
> + || (total_offset + TYPE_LENGTH (array_slice_type)
> + > TYPE_LENGTH (check_typedef (value_type (array)))))
> + {
> + fortran_array_walker<fortran_lazy_array_repacker_impl> p
> + (array_slice_type, value_address (array) + total_offset, dest);
> + p.walk ();
> + }
> + else
> + {
> + fortran_array_walker<fortran_array_repacker_impl> p
> + (array_slice_type, value_address (array) + total_offset,
> + total_offset, array, dest);
> + p.walk ();
> + }
> + array = dest;
> + }
> + else
> + {
> + if (VALUE_LVAL (array) == lval_memory)
> + {
> + /* If the value we're taking a slice from is not yet loaded, or
> + the requested slice is outside the values content range then
> + just create a new lazy value pointing at the memory where the
> + contents we're looking for exist. */
> + if (value_lazy (array)
> + || (total_offset + TYPE_LENGTH (array_slice_type)
> + > TYPE_LENGTH (check_typedef (value_type (array)))))
> + array = value_at_lazy (array_slice_type,
> + value_address (array) + total_offset);
> + else
> + array = value_from_contents_and_address (array_slice_type,
> + (value_contents (array)
> + + total_offset),
> + (value_address (array)
> + + total_offset));
> + }
> + else if (!value_lazy (array))
> + {
> + const void *valaddr = value_contents (array) + total_offset;
> + array = allocate_value (array_slice_type);
> + memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type));
> + }
> + else
> + error (_("cannot subscript arrays that are not in memory"));
> }
>
> return array;
> @@ -862,11 +1320,50 @@ builtin_f_type (struct gdbarch *gdbarch)
> return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
> }
>
> +/* Command-list for the "set/show fortran" prefix command. */
> +static struct cmd_list_element *set_fortran_list;
> +static struct cmd_list_element *show_fortran_list;
> +
> void _initialize_f_language ();
> void
> _initialize_f_language ()
> {
> f_type_data = gdbarch_data_register_post_init (build_fortran_types);
> +
> + add_basic_prefix_cmd ("fortran", no_class,
> + _("Prefix command for changing Fortran-specific settings."),
> + &set_fortran_list, "set fortran ", 0, &setlist);
> +
> + add_show_prefix_cmd ("fortran", no_class,
> + _("Generic command for showing Fortran-specific settings."),
> + &show_fortran_list, "show fortran ", 0, &showlist);
> +
> + add_setshow_boolean_cmd ("repack-array-slices", class_vars,
> + &repack_array_slices, _("\
> +Enable or disable repacking of non-contiguous array slices."), _("\
> +Show whether non-contiguous array slices are repacked."), _("\
> +When the user requests a slice of a Fortran array then we can either return\n\
> +a descriptor that describes the array in place (using the original array data\n\
> +in its existing location) or the original data can be repacked (copied) to a\n\
> +new location.\n\
> +\n\
> +When the content of the array slice is contiguous within the original array\n\
> +then the result will never be repacked, but when the data for the new array\n\
> +is non-contiguous within the original array repacking will only be performed\n\
> +when this setting is on."),
> + NULL,
> + show_repack_array_slices,
> + &set_fortran_list, &show_fortran_list);
> +
> + /* Debug Fortran's array slicing logic. */
> + add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance,
> + &fortran_array_slicing_debug, _("\
> +Set debugging of Fortran array slicing."), _("\
> +Show debugging of Fortran array slicing."), _("\
> +When on, debugging of Fortran array slicing is enabled."),
> + NULL,
> + show_fortran_array_slicing_debug,
> + &setdebuglist, &showdebuglist);
> }
>
> /* See f-lang.h. */
> @@ -905,3 +1402,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type)
> return value_type (arg);
> return type;
> }
> +
> +/* See f-lang.h. */
> +
> +CORE_ADDR
> +fortran_adjust_dynamic_array_base_address_hack (struct type *type,
> + CORE_ADDR address)
> +{
> + gdb_assert (type->code () == TYPE_CODE_ARRAY);
> +
> + int ndimensions = calc_f77_array_dims (type);
> + LONGEST total_offset = 0;
> +
> + /* Walk through each of the dimensions of this array type and figure out
> + if any of the dimensions are "backwards", that is the base address
> + for this dimension points to the element at the highest memory
> + address and the stride is negative. */
> + struct type *tmp_type = type;
> + for (int i = 0 ; i < ndimensions; ++i)
> + {
> + /* Grab the range for this dimension and extract the lower and upper
> + bounds. */
> + tmp_type = check_typedef (tmp_type);
> + struct type *range_type = tmp_type->index_type ();
> + LONGEST lowerbound, upperbound, stride;
> + if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
> + error ("failed to get range bounds");
> +
> + /* Figure out the stride for this dimension. */
> + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
> + stride = tmp_type->index_type ()->bounds ()->bit_stride ();
> + if (stride == 0)
> + stride = type_length_units (elt_type);
> + else
> + {
> + struct gdbarch *arch = get_type_arch (elt_type);
> + int unit_size = gdbarch_addressable_memory_unit_size (arch);
> + stride /= (unit_size * 8);
> + }
> +
> + /* If this dimension is "backward" then figure out the offset
> + adjustment required to point to the element at the lowest memory
> + address, and add this to the total offset. */
> + LONGEST offset = 0;
> + if (stride < 0 && lowerbound < upperbound)
> + offset = (upperbound - lowerbound) * stride;
> + total_offset += offset;
> + tmp_type = TYPE_TARGET_TYPE (tmp_type);
> + }
> +
> + /* Adjust the address of this object and return it. */
> + address += total_offset;
> + return address;
> +}
> diff --git a/gdb/f-lang.h b/gdb/f-lang.h
> index e59fdef1b19..880c07e4473 100644
> --- a/gdb/f-lang.h
> +++ b/gdb/f-lang.h
> @@ -316,7 +316,6 @@ extern void f77_get_dynamic_array_length (struct type *);
>
> extern int calc_f77_array_dims (struct type *);
>
> -
> /* Fortran (F77) types */
>
> struct builtin_f_type
> @@ -374,4 +373,22 @@ extern struct value *fortran_argument_convert (struct value *value,
> extern struct type *fortran_preserve_arg_pointer (struct value *arg,
> struct type *type);
>
> +/* Fortran arrays can have a negative stride. When this happens it is
> + often the case that the base address for an object is not the lowest
> + address occupied by that object. For example, an array slice (10:1:-1)
> + will be encoded with lower bound 1, upper bound 10, a stride of
> + -ELEMENT_SIZE, and have a base address pointer that points at the
> + element with the highest address in memory.
> +
> + This really doesn't play well with our current model of value contents,
> + but could easily require a significant update in order to be supported
> + "correctly".
> +
> + For now, we manually force the base address to be the lowest addressed
> + element here. Yes, this will break some things, but it fixes other
> + things. The hope is that it fixes more than it breaks. */
> +
> +extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
> + (struct type *type, CORE_ADDR address);
> +
> #endif /* F_LANG_H */
> diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
> index 95630a76d7d..83242f5ed47 100644
> --- a/gdb/f-valprint.c
> +++ b/gdb/f-valprint.c
> @@ -35,6 +35,7 @@
> #include "dictionary.h"
> #include "cli/cli-style.h"
> #include "gdbarch.h"
> +#include "f-array-walker.h"
>
> static void f77_get_dynamic_length_of_aggregate (struct type *);
>
> @@ -100,100 +101,103 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
> * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
> }
>
> -/* Actual function which prints out F77 arrays, Valaddr == address in
> - the superior. Address == the address in the inferior. */
> +/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array
> + walking template. This specialisation prints Fortran arrays. */
>
> -static void
> -f77_print_array_1 (int nss, int ndimensions, struct type *type,
> - const gdb_byte *valaddr,
> - int embedded_offset, CORE_ADDR address,
> - struct ui_file *stream, int recurse,
> - const struct value *val,
> - const struct value_print_options *options,
> - int *elts)
> +class fortran_array_printer_impl : public fortran_array_walker_base_impl
> {
> - struct type *range_type = check_typedef (type)->index_type ();
> - CORE_ADDR addr = address + embedded_offset;
> - LONGEST lowerbound, upperbound;
> - LONGEST i;
> -
> - get_discrete_bounds (range_type, &lowerbound, &upperbound);
> -
> - if (nss != ndimensions)
> - {
> - struct gdbarch *gdbarch = get_type_arch (type);
> - size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type));
> - int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
> - size_t byte_stride = type->bit_stride () / (unit_size * 8);
> - if (byte_stride == 0)
> - byte_stride = dim_size;
> - size_t offs = 0;
> -
> - for (i = lowerbound;
> - (i < upperbound + 1 && (*elts) < options->print_max);
> - i++)
> - {
> - struct value *subarray = value_from_contents_and_address
> - (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
> - + offs, addr + offs);
> -
> - fprintf_filtered (stream, "(");
> - f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
> - value_contents_for_printing (subarray),
> - value_embedded_offset (subarray),
> - value_address (subarray),
> - stream, recurse, subarray, options, elts);
> - offs += byte_stride;
> - fprintf_filtered (stream, ")");
> -
> - if (i < upperbound)
> - fprintf_filtered (stream, " ");
> - }
> - if (*elts >= options->print_max && i < upperbound)
> - fprintf_filtered (stream, "...");
> - }
> - else
> - {
> - for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
> - i++, (*elts)++)
> - {
> - struct value *elt = value_subscript ((struct value *)val, i);
> -
> - common_val_print (elt, stream, recurse, options, current_language);
> -
> - if (i != upperbound)
> - fprintf_filtered (stream, ", ");
> -
> - if ((*elts == options->print_max - 1)
> - && (i != upperbound))
> - fprintf_filtered (stream, "...");
> - }
> - }
> -}
> +public:
> + /* Constructor. TYPE is the array type being printed, ADDRESS is the
> + address in target memory for the object of TYPE being printed. VAL is
> + the GDB value (of TYPE) being printed. STREAM is where to print to,
> + RECOURSE is passed through (and prevents infinite recursion), and
> + OPTIONS are the printing control options. */
> + explicit fortran_array_printer_impl (struct type *type,
> + CORE_ADDR address,
> + struct value *val,
> + struct ui_file *stream,
> + int recurse,
> + const struct value_print_options *options)
> + : m_elts (0),
> + m_val (val),
> + m_stream (stream),
> + m_recurse (recurse),
> + m_options (options)
> + { /* Nothing. */ }
> +
> + /* Called while iterating over the array bounds. When SHOULD_CONTINUE is
> + false then we must return false, as we have reached the end of the
> + array bounds for this dimension. However, we also return false if we
> + have printed too many elements (after printing '...'). In all other
> + cases, return true. */
> + bool continue_walking (bool should_continue)
> + {
> + bool cont = should_continue && (m_elts < m_options->print_max);
> + if (!cont && should_continue)
> + fputs_filtered ("...", m_stream);
> + return cont;
> + }
> +
> + /* Called when we start iterating over a dimension. If it's not the
> + inner most dimension then print an opening '(' character. */
> + void start_dimension (bool inner_p)
> + {
> + fputs_filtered ("(", m_stream);
> + }
> +
> + /* Called when we finish processing a batch of items within a dimension
> + of the array. Depending on whether this is the inner most dimension
> + or not we print different things, but this is all about adding
> + separators between elements, and dimensions of the array. */
> + void finish_dimension (bool inner_p, bool last_p)
> + {
> + fputs_filtered (")", m_stream);
> + if (!last_p)
> + fputs_filtered (" ", m_stream);
> + }
> +
> + /* Called to process an element of ELT_TYPE at offset ELT_OFF from the
> + start of the parent object. */
> + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
> + {
> + /* Extract the element value from the parent value. */
> + struct value *e_val
> + = value_from_component (m_val, elt_type, elt_off);
> + common_val_print (e_val, m_stream, m_recurse, m_options, current_language);
> + if (!last_p)
> + fputs_filtered (", ", m_stream);
> + ++m_elts;
> + }
> +
> +private:
> + /* The number of elements printed so far. */
> + int m_elts;
> +
> + /* The value from which we are printing elements. */
> + struct value *m_val;
> +
> + /* The stream we should print too. */
> + struct ui_file *m_stream;
> +
> + /* The recursion counter, passed through when we print each element. */
> + int m_recurse;
> +
> + /* The print control options. Gives us the maximum number of elements to
> + print, and is passed through to each element that we print. */
> + const struct value_print_options *m_options = nullptr;
> +};
>
> -/* This function gets called to print an F77 array, we set up some
> - stuff and then immediately call f77_print_array_1(). */
> +/* This function gets called to print a Fortran array. */
>
> static void
> -f77_print_array (struct type *type, const gdb_byte *valaddr,
> - int embedded_offset,
> - CORE_ADDR address, struct ui_file *stream,
> - int recurse,
> - const struct value *val,
> - const struct value_print_options *options)
> +fortran_print_array (struct type *type, CORE_ADDR address,
> + struct ui_file *stream, int recurse,
> + const struct value *val,
> + const struct value_print_options *options)
> {
> - int ndimensions;
> - int elts = 0;
> -
> - ndimensions = calc_f77_array_dims (type);
> -
> - if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
> - error (_("\
> -Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
> - ndimensions, MAX_FORTRAN_DIMS);
> -
> - f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
> - address, stream, recurse, val, options, &elts);
> + fortran_array_walker<fortran_array_printer_impl> p
> + (type, address, (struct value *) val, stream, recurse, options);
> + p.walk ();
> }
> \f
>
> @@ -237,12 +241,7 @@ f_language::value_print_inner (struct value *val, struct ui_file *stream,
>
> case TYPE_CODE_ARRAY:
> if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR)
> - {
> - fprintf_filtered (stream, "(");
> - f77_print_array (type, valaddr, 0,
> - address, stream, recurse, val, options);
> - fprintf_filtered (stream, ")");
> - }
> + fortran_print_array (type, address, stream, recurse, val, options);
> else
> {
> struct type *ch_type = TYPE_TARGET_TYPE (type);
> diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
> index 0940fa597fb..6a4037dd077 100644
> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
> @@ -39,6 +39,7 @@
> #include "dwarf2/loc.h"
> #include "gdbcore.h"
> #include "floatformat.h"
> +#include "f-lang.h"
> #include <algorithm>
>
> /* Initialize BADNESS constants. */
> @@ -2627,7 +2628,16 @@ resolve_dynamic_type_internal (struct type *type,
> prop = TYPE_DATA_LOCATION (resolved_type);
> if (prop != NULL
> && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> - prop->set_const_val (value);
> + {
> + /* Start of Fortran hack. See comment in f-lang.h for what is going
> + on here.*/
> + if (current_language->la_language == language_fortran
> + && resolved_type->code () == TYPE_CODE_ARRAY)
> + value = fortran_adjust_dynamic_array_base_address_hack (resolved_type,
> + value);
> + /* End of Fortran hack. */
> + prop->set_const_val (value);
> + }
>
> return resolved_type;
> }
> diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
> new file mode 100644
> index 00000000000..2583cdecc94
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
> @@ -0,0 +1,69 @@
> +# Copyright 2020 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/> .
> +
> +# Test invalid element and slice array accesses.
> +
> +if {[skip_fortran_tests]} { return -1 }
> +
> +standard_testfile ".f90"
> +load_lib fortran.exp
> +
> +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
> + {debug f90}]} {
> + return -1
> +}
> +
> +if ![fortran_runto_main] {
> + untested "could not run to main"
> + return -1
> +}
> +
> +# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
> +gdb_breakpoint [gdb_get_line_number "First Breakpoint"]
> +gdb_breakpoint [gdb_get_line_number "Second Breakpoint"]
> +gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
> +
> +gdb_continue_to_breakpoint "First Breakpoint"
> +
> +# Access not yet allocated array.
> +gdb_test "print other" " = <not allocated>"
> +gdb_test "print other(0:4,2:3)" "array not allocated"
> +gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)"
> +
> +# Access not yet associated pointer.
> +gdb_test "print pointer2d" " = <not associated>"
> +gdb_test "print pointer2d(1:2,1:2)" "array not associated"
> +gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)"
> +
> +gdb_continue_to_breakpoint "Second Breakpoint"
> +
> +# Accessing just outside the arrays.
> +foreach name {array pointer2d other} {
> + gdb_test "print $name (0:,:)" "array subscript out of bounds"
> + gdb_test "print $name (:11,:)" "array subscript out of bounds"
> + gdb_test "print $name (:,0:)" "array subscript out of bounds"
> + gdb_test "print $name (:,:11)" "array subscript out of bounds"
> +
> + gdb_test "print $name (0,:)" "no such vector element"
> + gdb_test "print $name (11,:)" "no such vector element"
> + gdb_test "print $name (:,0)" "no such vector element"
> + gdb_test "print $name (:,11)" "no such vector element"
> +}
> +
> +# Stride in the wrong direction.
> +gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination"
> +gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination"
> +gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination"
> +gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination"
> diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
> new file mode 100644
> index 00000000000..0f3d45ab8cd
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
> @@ -0,0 +1,42 @@
> +! Copyright 2020 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/>.
> +
> +!
> +! Start of test program.
> +!
> +program test
> +
> + ! Declare variables used in this test.
> + integer, dimension (1:10,1:10) :: array
> + integer, allocatable :: other (:, :)
> + integer, dimension(:,:), pointer :: pointer2d => null()
> + integer, dimension(1:10,1:10), target :: tarray
> +
> + print *, "" ! First Breakpoint.
> +
> + ! Allocate or associate any variables as needed.
> + allocate (other (1:10, 1:10))
> + pointer2d => tarray
> + array = 0
> +
> + print *, "" ! Second Breakpoint.
> +
> + ! All done. Deallocate.
> + deallocate (other)
> +
> + ! GDB catches this final breakpoint to indicate the end of the test.
> + print *, "" ! Final Breakpoint.
> +
> +end program test
> diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
> new file mode 100644
> index 00000000000..05b4802c678
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
> @@ -0,0 +1,111 @@
> +# Copyright 2020 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/> .
> +
> +# Create a slice of an array, then take a slice of that slice.
> +
> +if {[skip_fortran_tests]} { return -1 }
> +
> +standard_testfile ".f90"
> +load_lib fortran.exp
> +
> +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
> + {debug f90}]} {
> + return -1
> +}
> +
> +if ![fortran_runto_main] {
> + untested "could not run to main"
> + return -1
> +}
> +
> +# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
> +gdb_breakpoint [gdb_get_line_number "Stop Here"]
> +gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
> +
> +# We're going to print some reasonably large arrays.
> +gdb_test_no_output "set print elements unlimited"
> +
> +gdb_continue_to_breakpoint "Stop Here"
> +
> +# Print a slice, capture the convenience variable name created.
> +set cmd "print array (1:10:2, 1:10:2)"
> +gdb_test_multiple $cmd $cmd {
> + -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" {
> + set varname "\$$expect_out(1,string)"
> + }
> +}
> +
> +# Now check that we can correctly extract all the elements from this
> +# slice.
> +for { set j 1 } { $j < 6 } { incr j } {
> + for { set i 1 } { $i < 6 } { incr i } {
> + set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1]
> + gdb_test "print ${varname} ($i,$j)" " = $val"
> + }
> +}
> +
> +# Now take a slice of the slice.
> +gdb_test "print ${varname} (3:5, 3:5)" \
> + " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)"
> +
> +# Now take a different slice of a slice.
> +set cmd "print ${varname} (1:5:2, 1:5:2)"
> +gdb_test_multiple $cmd $cmd {
> + -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" {
> + set varname "\$$expect_out(1,string)"
> + pass $gdb_test_name
> + }
> +}
> +
> +# Now take a slice from the slice, of a slice!
> +set cmd "print ${varname} (1:3:2, 1:3:2)"
> +gdb_test_multiple $cmd $cmd {
> + -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" {
> + set varname "\$$expect_out(1,string)"
> + pass $gdb_test_name
> + }
> +}
> +
> +# And again!
> +set cmd "print ${varname} (1:2:2, 1:2:2)"
> +gdb_test_multiple $cmd $cmd {
> + -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" {
> + set varname "\$$expect_out(1,string)"
> + pass $gdb_test_name
> + }
> +}
> +
> +# Test taking a slice with stride of a string. This isn't actually
> +# supported within gfortran (at least), but naturally drops out of how
> +# GDB models arrays and strings in a similar way, so we may as well
> +# test that this is still working.
> +gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'"
> +gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'"
> +gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'"
> +
> +# Now test the memory requirements of taking a slice from an array.
> +# The idea is that we shouldn't require more memory to extract a slice
> +# than the size of the slice.
> +#
> +# This will only work if array repacking is turned on, otherwise GDB
> +# will create the slice by generating a new type that sits over the
> +# existing value in memory.
> +gdb_test_no_output "set fortran repack-array-slices on"
> +set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"]
> +set slice_size [expr $element_size * 4]
> +gdb_test_no_output "set max-value-size $slice_size"
> +gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)"
> +gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)"
> +gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)"
> diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
> new file mode 100644
> index 00000000000..c3530f567d4
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
> @@ -0,0 +1,96 @@
> +! Copyright 2020 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/>.
> +
> +!
> +! Start of test program.
> +!
> +program test
> + integer, dimension (1:10,1:11) :: array
> + character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz"
> +
> + call fill_array_2d (array)
> +
> + ! GDB catches this final breakpoint to indicate the end of the test.
> + print *, "" ! Stop Here
> +
> + print *, array
> + print *, str
> +
> + ! GDB catches this final breakpoint to indicate the end of the test.
> + print *, "" ! Final Breakpoint.
> +
> +contains
> +
> + ! Fill a 1D array with a unique positive integer in each element.
> + subroutine fill_array_1d (array)
> + integer, dimension (:) :: array
> + integer :: counter
> +
> + counter = 1
> + do j=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (j) = counter
> + counter = counter + 1
> + end do
> + end subroutine fill_array_1d
> +
> + ! Fill a 2D array with a unique positive integer in each element.
> + subroutine fill_array_2d (array)
> + integer, dimension (:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 2), UBOUND (array, 2), 1
> + do j=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end subroutine fill_array_2d
> +
> + ! Fill a 3D array with a unique positive integer in each element.
> + subroutine fill_array_3d (array)
> + integer, dimension (:,:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 3), UBOUND (array, 3), 1
> + do j=LBOUND (array, 2), UBOUND (array, 2), 1
> + do k=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (k, j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end do
> + end subroutine fill_array_3d
> +
> + ! Fill a 4D array with a unique positive integer in each element.
> + subroutine fill_array_4d (array)
> + integer, dimension (:,:,:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 4), UBOUND (array, 4), 1
> + do j=LBOUND (array, 3), UBOUND (array, 3), 1
> + do k=LBOUND (array, 2), UBOUND (array, 2), 1
> + do l=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (l, k, j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end do
> + end do
> + print *, ""
> + end subroutine fill_array_4d
> +end program test
> diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
> index aa6bc6327eb..ff00fae886f 100644
> --- a/gdb/testsuite/gdb.fortran/array-slices.exp
> +++ b/gdb/testsuite/gdb.fortran/array-slices.exp
> @@ -18,6 +18,21 @@
> # the subroutine. This should exercise GDB's ability to handle
> # different strides for the different dimensions.
>
> +# Testing GDB's ability to print array (and string) slices, including
> +# slices that make use of array strides.
> +#
> +# In the Fortran code various arrays of different ranks are filled
> +# with data, and slices are passed to a series of show functions.
> +#
> +# In this test script we break in each of the show functions, print
> +# the array slice that was passed in, and then move up the stack to
> +# the parent frame and check GDB can manually extract the same slice.
> +#
> +# This test also checks that the size of the array slice passed to the
> +# function (so as extracted and described by the compiler and the
> +# debug information) matches the size of the slice manually extracted
> +# by GDB.
> +
> if {[skip_fortran_tests]} { return -1 }
>
> standard_testfile ".f90"
> @@ -28,60 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
> return -1
> }
>
> -if ![fortran_runto_main] {
> - untested "could not run to main"
> - return -1
> +# Takes the name of an array slice as used in the test source, and extracts
> +# the base array name. For example: 'array (1,2)' becomes 'array'.
> +proc array_slice_to_var { slice_str } {
> + regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname
> + return $varname
> }
>
> -gdb_breakpoint "show"
> -gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
> -
> -set array_contents \
> - [list \
> - " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
> - " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
> - " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
> - " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
> - " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
> - " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
> - " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
> - " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
> -
> -set message_strings \
> - [list \
> - " = 'array'" \
> - " = 'array \\(1:5,1:5\\)'" \
> - " = 'array \\(1:10:2,1:10:2\\)'" \
> - " = 'array \\(1:10:3,1:10:2\\)'" \
> - " = 'array \\(1:10:5,1:10:3\\)'" \
> - " = 'other'" \
> - " = 'other \\(-5:0, -2:0\\)'" \
> - " = 'other \\(-5:4:2, -2:7:3\\)'" ]
> -
> -set i 0
> -foreach result $array_contents msg $message_strings {
> - incr i
> - with_test_prefix "test $i" {
> - gdb_continue_to_breakpoint "show"
> - gdb_test "p array" $result
> - gdb_test "p message" "$msg"
> +proc run_test { repack } {
> + global binfile gdb_prompt
> +
> + clean_restart ${binfile}
> +
> + if ![fortran_runto_main] {
> + untested "could not run to main"
> + return -1
> }
> -}
>
> -gdb_continue_to_breakpoint "continue to Final Breakpoint"
> + gdb_test_no_output "set fortran repack-array-slices $repack"
> +
> + # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
> + gdb_breakpoint [gdb_get_line_number "Display Element"]
> + gdb_breakpoint [gdb_get_line_number "Display String"]
> + gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"]
> + gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"]
> + gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"]
> + gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"]
> + gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
> +
> + # We're going to print some reasonably large arrays.
> + gdb_test_no_output "set print elements unlimited"
> +
> + set found_final_breakpoint false
> +
> + # We place a limit on the number of tests that can be run, just in
> + # case something goes wrong, and GDB gets stuck in an loop here.
> + set test_count 0
> + while { $test_count < 500 } {
> + with_test_prefix "test $test_count" {
> + incr test_count
> +
> + set found_final_breakpoint false
> + set expected_result ""
> + set func_name ""
> + gdb_test_multiple "continue" "continue" {
> + -re ".*GDB = (\[^\r\n\]+)\r\n" {
> + set expected_result $expect_out(1,string)
> + exp_continue
> + }
> + -re "! Display Element" {
> + set func_name "show_elem"
> + exp_continue
> + }
> + -re "! Display String" {
> + set func_name "show_str"
> + exp_continue
> + }
> + -re "! Display Array Slice (.)D" {
> + set func_name "show_$expect_out(1,string)d"
> + exp_continue
> + }
> + -re "! Final Breakpoint" {
> + set found_final_breakpoint true
> + exp_continue
> + }
> + -re "$gdb_prompt $" {
> + # We're done.
> + }
> + }
>
> -# Next test that asking for an array with stride at the CLI gives an
> -# error.
> -clean_restart ${testfile}
> + if ($found_final_breakpoint) {
> + break
> + }
>
> -if ![fortran_runto_main] then {
> - perror "couldn't run to main"
> - continue
> + # We want to take a look at the line in the previous frame that
> + # called the current function. I couldn't find a better way of
> + # doing this than 'up', which will print the line, then 'down'
> + # again.
> + #
> + # I don't want to fill the log with passes for these up/down
> + # commands, so we don't report any. If something goes wrong then we
> + # should get a fail from gdb_test_multiple.
> + set array_slice_name ""
> + set unique_id ""
> + array unset replacement_vars
> + array set replacement_vars {}
> + gdb_test_multiple "up" "up" {
> + -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" {
> + set array_slice_name $expect_out(1,string)
> + }
> + -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" {
> + set array_slice_name $expect_out(1,string)
> + set unique_id $expect_out(2,string)
> + }
> + }
> + if {$unique_id != ""} {
> + set str ""
> + foreach v [split $unique_id ,] {
> + set val [get_integer_valueof "${v}" "??"\
> + "get variable '$v' for '$array_slice_name'"]
> + set replacement_vars($v) $val
> + if {$str != ""} {
> + set str "Str,"
> + }
> + set str "$str$v=$val"
> + }
> + set unique_id " $str"
> + }
> + gdb_test_multiple "down" "down" {
> + -re "\r\n$gdb_prompt $" {
> + # Don't issue a pass here.
> + }
> + }
> +
> + # Check we have all the information we need to successfully run one
> + # of these tests.
> + if { $expected_result == "" } {
> + perror "failed to extract expected results"
> + return 0
> + }
> + if { $array_slice_name == "" } {
> + perror "failed to extract array slice name"
> + return 0
> + }
> +
> + # Check GDB can correctly print the array slice that was passed into
> + # the current frame.
> + set pattern [string_to_regexp " = $expected_result"]
> + gdb_test "p array" "$pattern" \
> + "check value of '$array_slice_name'$unique_id"
> +
> + # Get the size of the slice.
> + set size_in_show \
> + [get_integer_valueof "sizeof (array)" "show_unknown" \
> + "get sizeof '$array_slice_name'$unique_id in show"]
> + set addr_in_show \
> + [get_hexadecimal_valueof "&array" "show_unknown" \
> + "get address '$array_slice_name'$unique_id in show"]
> +
> + # Now move into the previous frame, and see if GDB can extract the
> + # array slice from the original parent object. Again, use of
> + # gdb_test_multiple to avoid filling the logs with unnecessary
> + # passes.
> + gdb_test_multiple "up" "up" {
> + -re "\r\n$gdb_prompt $" {
> + # Do nothing.
> + }
> + }
> +
> + # Print the array slice, this will force GDB to manually extract the
> + # slice from the parent array.
> + gdb_test "p $array_slice_name" "$pattern" \
> + "check array slice '$array_slice_name'$unique_id can be extracted"
> +
> + # Get the size of the slice in the calling frame.
> + set size_in_parent \
> + [get_integer_valueof "sizeof ($array_slice_name)" \
> + "parent_unknown" \
> + "get sizeof '$array_slice_name'$unique_id in parent"]
> +
> + # Figure out the start and end addresses of the full array in the
> + # parent frame.
> + set full_var_name [array_slice_to_var $array_slice_name]
> + set start_addr [get_hexadecimal_valueof "&${full_var_name}" \
> + "start unknown"]
> + set end_addr [get_hexadecimal_valueof \
> + "(&${full_var_name}) + sizeof (${full_var_name})" \
> + "end unknown"]
> +
> + # The Fortran compiler can choose to either send a descriptor that
> + # describes the array slice to the subroutine, or it can repack the
> + # slice into an array section and send that.
> + #
> + # We find the address range of the original array in the parent,
> + # and the address of the slice in the show function, if the
> + # address of the slice (from show) is in the range of the original
> + # array then repacking has not occurred, otherwise, the slice is
> + # outside of the parent, and repacking must have occurred.
> + #
> + # The goal here is to compare the sizes of the slice in show with
> + # the size of the slice extracted by GDB. So we can only compare
> + # sizes when GDB's repacking setting matches the repacking
> + # behaviour we got from the compiler.
> + if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \
> + == ($repack == "on") } {
> + gdb_assert {$size_in_show == $size_in_parent} \
> + "check sizes match"
> + } elseif { $repack == "off" } {
> + # GDB's repacking is off (so slices are left unpacked), but
> + # the compiler did pack this one. As a result we can't
> + # compare the sizes between the compiler's slice and GDB's
> + # slice.
> + verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared"
> + } else {
> + # Like the above, but the reverse, GDB's repacking is on, but
> + # the compiler didn't repack this slice.
> + verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared"
> + }
> +
> + # If the array name we just tested included variable names, then
> + # test again with all the variables expanded.
> + if {$unique_id != ""} {
> + foreach v [array names replacement_vars] {
> + set val $replacement_vars($v)
> + set array_slice_name \
> + [regsub "\\y${v}\\y" $array_slice_name $val]
> + }
> + gdb_test "p $array_slice_name" "$pattern" \
> + "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded"
> + }
> + }
> + }
> +
> + # Ensure we reached the final breakpoint. If more tests have been added
> + # to the test script, and this starts failing, then the safety 'while'
> + # loop above might need to be increased.
> + gdb_assert {$found_final_breakpoint} "ran all tests"
> }
>
> -gdb_breakpoint "show"
> -gdb_continue_to_breakpoint "show"
> -gdb_test "up" ".*"
> -gdb_test "p array (1:10:2, 1:10:2)" \
> - "Fortran array strides are not currently supported" \
> - "using array stride gives an error"
> +foreach_with_prefix repack { on off } {
> + run_test $repack
> +}
> diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
> index a66fa6ba784..6d75a385699 100644
> --- a/gdb/testsuite/gdb.fortran/array-slices.f90
> +++ b/gdb/testsuite/gdb.fortran/array-slices.f90
> @@ -13,58 +13,368 @@
> ! 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 show (message, array)
> - character (len=*) :: message
> +subroutine show_elem (array)
> + integer :: array
> +
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
> +
> + write(*, fmt="(A)", advance="no") "GDB = "
> + write(*, fmt="(I0)", advance="no") array
> + write(*, fmt="(A)", advance="yes") ""
> +
> + print *, "" ! Display Element
> +end subroutine show_elem
> +
> +subroutine show_str (array)
> + character (len=*) :: array
> +
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
> + write (*, fmt="(A)", advance="no") "GDB = '"
> + write (*, fmt="(A)", advance="no") array
> + write (*, fmt="(A)", advance="yes") "'"
> +
> + print *, "" ! Display String
> +end subroutine show_str
> +
> +subroutine show_1d (array)
> + integer, dimension (:) :: array
> +
> + print *, "Array Contents:"
> + print *, ""
> +
> + do i=LBOUND (array, 1), UBOUND (array, 1), 1
> + write(*, fmt="(i4)", advance="no") array (i)
> + end do
> +
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
> +
> + write(*, fmt="(A)", advance="no") "GDB = ("
> + do i=LBOUND (array, 1), UBOUND (array, 1), 1
> + if (i > LBOUND (array, 1)) then
> + write(*, fmt="(A)", advance="no") ", "
> + end if
> + write(*, fmt="(I0)", advance="no") array (i)
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> +
> + print *, "" ! Display Array Slice 1D
> +end subroutine show_1d
> +
> +subroutine show_2d (array)
> integer, dimension (:,:) :: array
>
> - print *, message
> + print *, "Array Contents:"
> + print *, ""
> +
> do i=LBOUND (array, 2), UBOUND (array, 2), 1
> do j=LBOUND (array, 1), UBOUND (array, 1), 1
> write(*, fmt="(i4)", advance="no") array (j, i)
> end do
> print *, ""
> - end do
> - print *, array
> - print *, ""
> + end do
>
> -end subroutine show
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
>
> -program test
> + write(*, fmt="(A)", advance="no") "GDB = ("
> + do i=LBOUND (array, 2), UBOUND (array, 2), 1
> + if (i > LBOUND (array, 2)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> + do j=LBOUND (array, 1), UBOUND (array, 1), 1
> + if (j > LBOUND (array, 1)) then
> + write(*, fmt="(A)", advance="no") ", "
> + end if
> + write(*, fmt="(I0)", advance="no") array (j, i)
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="yes") ")"
> +
> + print *, "" ! Display Array Slice 2D
> +end subroutine show_2d
> +
> +subroutine show_3d (array)
> + integer, dimension (:,:,:) :: array
> +
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
> +
> + write(*, fmt="(A)", advance="no") "GDB = ("
> + do i=LBOUND (array, 3), UBOUND (array, 3), 1
> + if (i > LBOUND (array, 3)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> + do j=LBOUND (array, 2), UBOUND (array, 2), 1
> + if (j > LBOUND (array, 2)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> + do k=LBOUND (array, 1), UBOUND (array, 1), 1
> + if (k > LBOUND (array, 1)) then
> + write(*, fmt="(A)", advance="no") ", "
> + end if
> + write(*, fmt="(I0)", advance="no") array (k, j, i)
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="yes") ")"
> +
> + print *, "" ! Display Array Slice 3D
> +end subroutine show_3d
> +
> +subroutine show_4d (array)
> + integer, dimension (:,:,:,:) :: array
> +
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
> +
> + write(*, fmt="(A)", advance="no") "GDB = ("
> + do i=LBOUND (array, 4), UBOUND (array, 4), 1
> + if (i > LBOUND (array, 4)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> + do j=LBOUND (array, 3), UBOUND (array, 3), 1
> + if (j > LBOUND (array, 3)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> +
> + do k=LBOUND (array, 2), UBOUND (array, 2), 1
> + if (k > LBOUND (array, 2)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> + do l=LBOUND (array, 1), UBOUND (array, 1), 1
> + if (l > LBOUND (array, 1)) then
> + write(*, fmt="(A)", advance="no") ", "
> + end if
> + write(*, fmt="(I0)", advance="no") array (l, k, j, i)
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="yes") ")"
> +
> + print *, "" ! Display Array Slice 4D
> +end subroutine show_4d
>
> +!
> +! Start of test program.
> +!
> +program test
> interface
> - subroutine show (message, array)
> - character (len=*) :: message
> + subroutine show_str (array)
> + character (len=*) :: array
> + end subroutine show_str
> +
> + subroutine show_1d (array)
> + integer, dimension (:) :: array
> + end subroutine show_1d
> +
> + subroutine show_2d (array)
> integer, dimension(:,:) :: array
> - end subroutine show
> + end subroutine show_2d
> +
> + subroutine show_3d (array)
> + integer, dimension(:,:,:) :: array
> + end subroutine show_3d
> +
> + subroutine show_4d (array)
> + integer, dimension(:,:,:,:) :: array
> + end subroutine show_4d
> end interface
>
> + ! Declare variables used in this test.
> + integer, dimension (-10:-1,-10:-2) :: neg_array
> integer, dimension (1:10,1:10) :: array
> integer, allocatable :: other (:, :)
> + character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz"
> + integer, dimension (-2:2,-2:2,-2:2) :: array3d
> + integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d
> + integer, dimension (10:20) :: array1d
> + integer, dimension(:,:), pointer :: pointer2d => null()
> + integer, dimension(-1:9,-1:9), target :: tarray
>
> + ! Allocate or associate any variables as needed.
> allocate (other (-5:4, -2:7))
> + pointer2d => tarray
>
> - do i=LBOUND (array, 2), UBOUND (array, 2), 1
> - do j=LBOUND (array, 1), UBOUND (array, 1), 1
> - array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
> - end do
> - end do
> + ! Fill arrays with contents ready for testing.
> + call fill_array_1d (array1d)
> +
> + call fill_array_2d (neg_array)
> + call fill_array_2d (array)
> + call fill_array_2d (other)
> + call fill_array_2d (tarray)
> +
> + call fill_array_3d (array3d)
> + call fill_array_4d (array4d)
> +
> + ! The tests. Each call to a show_* function must have a unique set
> + ! of arguments as GDB uses the arguments are part of the test name
> + ! string, so duplicate arguments will result in duplicate test
> + ! names.
> + !
> + ! If a show_* line ends with VARS=... where '...' is a comma
> + ! separated list of variable names, these variables are assumed to
> + ! be part of the call line, and will be expanded by the test script,
> + ! for example:
> + !
> + ! do x=1,9,1
> + ! do y=x,10,1
> + ! call show_1d (some_array (x,y)) ! VARS=x,y
> + ! end do
> + ! end do
> + !
> + ! In this example the test script will automatically expand 'x' and
> + ! 'y' in order to better test different aspects of GDB. Do take
> + ! care, the expansion is not very "smart", so try to avoid clashing
> + ! with other text on the line, in the example above, avoid variables
> + ! named 'some' or 'array', as these will likely clash with
> + ! 'some_array'.
> + call show_str (str_1)
> + call show_str (str_1 (1:20))
> + call show_str (str_1 (10:20))
>
> - do i=LBOUND (other, 2), UBOUND (other, 2), 1
> - do j=LBOUND (other, 1), UBOUND (other, 1), 1
> - other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
> + call show_elem (array1d (11))
> + call show_elem (pointer2d (2,3))
> +
> + call show_1d (array1d)
> + call show_1d (array1d (13:17))
> + call show_1d (array1d (17:13:-1))
> + call show_1d (array (1:5,1))
> + call show_1d (array4d (1,7,3,:))
> + call show_1d (pointer2d (-1:3, 2))
> + call show_1d (pointer2d (-1, 2:4))
> +
> + ! Enclosing the array slice argument in (...) causess gfortran to
> + ! repack the array.
> + call show_1d ((array (1:5,1)))
> +
> + call show_2d (pointer2d)
> + call show_2d (array)
> + call show_2d (array (1:5,1:5))
> + do i=1,10,2
> + do j=1,10,3
> + call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j
> + call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j
> + call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j
> + call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j
> end do
> end do
> + call show_2d (array (6:2:-1,3:9))
> + call show_2d (array (1:10:2, 1:10:2))
> + call show_2d (other)
> + call show_2d (other (-5:0, -2:0))
> + call show_2d (other (-5:4:2, -2:7:3))
> + call show_2d (neg_array)
> + call show_2d (neg_array (-10:-3,-8:-4:2))
> +
> + ! Enclosing the array slice argument in (...) causess gfortran to
> + ! repack the array.
> + call show_2d ((array (1:10:3, 1:10:2)))
> + call show_2d ((neg_array (-10:-3,-8:-4:2)))
>
> - call show ("array", array)
> - call show ("array (1:5,1:5)", array (1:5,1:5))
> - call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
> - call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
> - call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
> + call show_3d (array3d)
> + call show_3d (array3d(-1:1,-1:1,-1:1))
> + call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1))
>
> - call show ("other", other)
> - call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
> - call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
> + ! Enclosing the array slice argument in (...) causess gfortran to
> + ! repack the array.
> + call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1)))
>
> + call show_4d (array4d)
> + call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1))
> + call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1))
> +
> + ! Enclosing the array slice argument in (...) causess gfortran to
> + ! repack the array.
> + call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1)))
> +
> + ! All done. Deallocate.
> deallocate (other)
> +
> + ! GDB catches this final breakpoint to indicate the end of the test.
> print *, "" ! Final Breakpoint.
> +
> +contains
> +
> + ! Fill a 1D array with a unique positive integer in each element.
> + subroutine fill_array_1d (array)
> + integer, dimension (:) :: array
> + integer :: counter
> +
> + counter = 1
> + do j=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (j) = counter
> + counter = counter + 1
> + end do
> + end subroutine fill_array_1d
> +
> + ! Fill a 2D array with a unique positive integer in each element.
> + subroutine fill_array_2d (array)
> + integer, dimension (:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 2), UBOUND (array, 2), 1
> + do j=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end subroutine fill_array_2d
> +
> + ! Fill a 3D array with a unique positive integer in each element.
> + subroutine fill_array_3d (array)
> + integer, dimension (:,:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 3), UBOUND (array, 3), 1
> + do j=LBOUND (array, 2), UBOUND (array, 2), 1
> + do k=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (k, j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end do
> + end subroutine fill_array_3d
> +
> + ! Fill a 4D array with a unique positive integer in each element.
> + subroutine fill_array_4d (array)
> + integer, dimension (:,:,:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 4), UBOUND (array, 4), 1
> + do j=LBOUND (array, 3), UBOUND (array, 3), 1
> + do k=LBOUND (array, 2), UBOUND (array, 2), 1
> + do l=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (l, k, j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end do
> + end do
> + print *, ""
> + end subroutine fill_array_4d
> end program test
> diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
> index 04296ac80c9..0ab74fbbe90 100644
> --- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
> +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
> @@ -44,7 +44,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
> gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
> gdb_test "print sizeof(vla1(3,2,1))" "4" \
> "print sizeof element from allocated vla1"
> -gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
> +gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
> "print sizeof sliced vla1"
>
> # Try to access values in undefined pointer to VLA (dangling)
> @@ -61,7 +61,7 @@ gdb_continue_to_breakpoint "pvla-associated"
> gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
> gdb_test "print sizeof(pvla(3,2,1))" "4" \
> "print sizeof element from associated pvla"
> -gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
> +gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
>
> gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
> gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
> --
> 2.25.4
>
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv6] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-10-31 22:16 ` [PATCHv6] " Andrew Burgess
2020-11-12 12:09 ` Andrew Burgess
@ 2020-11-12 18:58 ` Tom Tromey
2020-11-19 11:56 ` Andrew Burgess
2 siblings, 0 replies; 62+ messages in thread
From: Tom Tromey @ 2020-11-12 18:58 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> There's still a pending question from Tom
Andrew> w.r.t. fortran_array_walker_base_impl, but this is what I have for
Andrew> now.
I've given this some thought since the last go-around, and I think it is
fine this way.
So, no objections from me. It looks good. Thanks for doing this.
Tom
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: [PATCHv6] gdb/fortran: Add support for Fortran array slices at the GDB prompt
2020-10-31 22:16 ` [PATCHv6] " Andrew Burgess
2020-11-12 12:09 ` Andrew Burgess
2020-11-12 18:58 ` Tom Tromey
@ 2020-11-19 11:56 ` Andrew Burgess
2 siblings, 0 replies; 62+ messages in thread
From: Andrew Burgess @ 2020-11-19 11:56 UTC (permalink / raw)
To: gdb-patches
I've now pushed this patch. Let me know if you see any problems.
Thanks,
Andrew
* Andrew Burgess <andrew.burgess@embecosm.com> [2020-10-31 22:16:21 +0000]:
> The changes in v6 are:
>
> - Rebase on current master,
> - Have addressed the typos and minor issues pointed out by Simon and
> Tom,
> - The f-array-walker.h logic has been rewritten slightly after
> Simon's feedback. Hopefully the logic is slightly clearer now.
> This did actually improve the code a little, the outer parenthesis
> are now printed as part of the fortran_print_array logic, rather
> than being printed elsewhere.
>
> There's still a pending question from Tom
> w.r.t. fortran_array_walker_base_impl, but this is what I have for
> now.
>
> Thanks,
> Andrew
>
> ---
>
> [PATCH] gdb/fortran: Add support for Fortran array slices at the GDB prompt
>
> This commit brings array slice support to GDB.
>
> WARNING: This patch contains a rather big hack which is limited to
> Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More
> details on this below.
>
> This patch rewrites two areas of GDB's Fortran support, the code to
> extract an array slice, and the code to print an array.
>
> After this commit a user can, from the GDB prompt, ask for a slice of
> a Fortran array and should get the correct result back. Slices can
> (optionally) have the lower bound, upper bound, and a stride
> specified. Slices can also have a negative stride.
>
> Fortran has the concept of repacking array slices. Within a compiled
> Fortran program if a user passes a non-contiguous array slice to a
> function then the compiler may have to repack the slice, this involves
> copying the elements of the slice to a new area of memory before the
> call, and copying the elements back to the original array after the
> call. Whether repacking occurs will depend on which version of
> Fortran is being used, and what type of function is being called.
>
> This commit adds support for both packed, and unpacked array slicing,
> with the default being unpacked.
>
> With an unpacked array slice, when the user asks for a slice of an
> array GDB creates a new type that accurately describes where the
> elements of the slice can be found within the original array, a
> value of this type is then returned to the user. The address of an
> element within the slice will be equal to the address of an element
> within the original array.
>
> A user can choose to select packed array slices instead using:
>
> (gdb) set fortran repack-array-slices on|off
> (gdb) show fortran repack-array-slices
>
> With packed array slices GDB creates a new type that reflects how the
> elements of the slice would look if they were laid out in contiguous
> memory, allocates a value of this type, and then fetches the elements
> from the original array and places then into the contents buffer of
> the new value.
>
> One benefit of using packed slices over unpacked slices is the memory
> usage, taking a small slice of N elements from a large array will
> require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked
> array will also include all of the "padding" between the
> non-contiguous elements. There are new tests added that highlight
> this difference.
>
> There is also a new debugging flag added with this commit that
> introduces these commands:
>
> (gdb) set debug fortran-array-slicing on|off
> (gdb) show debug fortran-array-slicing
>
> This prints information about how the array slices are being built.
>
> As both the repacking, and the array printing requires GDB to walk
> through a multi-dimensional Fortran array visiting each element, this
> commit adds the file f-array-walk.h, which introduces some
> infrastructure to support this process. This means the array printing
> code in f-valprint.c is significantly reduced.
>
> The only slight issue with this commit is the "rather big hack" that I
> mentioned above. This hack allows us to handle one specific case,
> array slices with negative strides. This is something that I don't
> believe the current GDB value contents model will allow us to
> correctly handle, and rather than rewrite the value contents code
> right now, I'm hoping to slip this hack in as a work around.
>
> The problem is that, as I see it, the current value contents model
> assumes that an object base address will be the lowest address within
> that object, and that the contents of the object start at this base
> address and occupy the TYPE_LENGTH bytes after that.
>
> ( We do have the embedded_offset, which is used for C++ sub-classes,
> such that an object can start at some offset from the content buffer,
> however, the assumption that the object then occupies the next
> TYPE_LENGTH bytes is still true within GDB. )
>
> The problem is that Fortran arrays with a negative stride don't follow
> this pattern. In this case the base address of the object points to
> the element with the highest address, the contents of the array then
> start at some offset _before_ the base address, and proceed for one
> element _past_ the base address.
>
> As the stride for such an array would be negative then, in theory the
> TYPE_LENGTH for this type would also be negative. However, in many
> places a value in GDB will degrade to a pointer + length, and the
> length almost always comes from the TYPE_LENGTH.
>
> It is my belief that in order to correctly model this case the value
> content handling of GDB will need to be reworked to split apart the
> value's content buffer (which is a block of memory with a length), and
> the object's in memory base address and length, which could be
> negative.
>
> Things are further complicated because arrays with negative strides
> like this are always dynamic types. When a value has a dynamic type
> and its base address needs resolving we actually store the address of
> the object within the resolved dynamic type, not within the value
> object itself.
>
> In short I don't currently see an easy path to cleanly support this
> situation within GDB. And so I believe that leaves two options,
> either add a work around, or catch cases where the user tries to make
> use of a negative stride, or access an array with a negative stride,
> and throw an error.
>
> This patch currently goes with adding a work around, which is that
> when we resolve a dynamic Fortran array type, if the stride is
> negative, then we adjust the base address to point to the lowest
> address required by the array. The printing and slicing code is aware
> of this adjustment and will correctly slice and print Fortran arrays.
>
> Where this hack will show through to the user is if they ask for the
> address of an array in their program with a negative array stride, the
> address they get from GDB will not match the address that would be
> computed within the Fortran program.
>
> gdb/ChangeLog:
>
> * Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h.
> * NEWS: Mention new options.
> * f-array-walker.h: New file.
> * f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'.
> (repack_array_slices): New static global.
> (show_repack_array_slices): New function.
> (fortran_array_slicing_debug): New static global.
> (show_fortran_array_slicing_debug): New function.
> (value_f90_subarray): Delete.
> (skip_undetermined_arglist): Delete.
> (class fortran_array_repacker_base_impl): New class.
> (class fortran_lazy_array_repacker_impl): New class.
> (class fortran_array_repacker_impl): New class.
> (fortran_value_subarray): Complete rewrite.
> (set_fortran_list): New static global.
> (show_fortran_list): Likewise.
> (_initialize_f_language): Register new commands.
> (fortran_adjust_dynamic_array_base_address_hack): New function.
> * f-lang.h (fortran_adjust_dynamic_array_base_address_hack):
> Declare.
> * f-valprint.c: Include 'f-array-walker.h'.
> (class fortran_array_printer_impl): New class.
> (f77_print_array_1): Delete.
> (f77_print_array): Delete.
> (fortran_print_array): New.
> (f_value_print_inner): Update to call fortran_print_array.
> * gdbtypes.c: Include 'f-lang.h'.
> (resolve_dynamic_type_internal): Call
> fortran_adjust_dynamic_array_base_address_hack.
>
> gdb/testsuite/ChangeLog:
>
> * gdb.fortran/array-slices-bad.exp: New file.
> * gdb.fortran/array-slices-bad.f90: New file.
> * gdb.fortran/array-slices-sub-slices.exp: New file.
> * gdb.fortran/array-slices-sub-slices.f90: New file.
> * gdb.fortran/array-slices.exp: Rewrite tests.
> * gdb.fortran/array-slices.f90: Rewrite tests.
> * gdb.fortran/vla-sizeof.exp: Correct expected results.
>
> gdb/doc/ChangeLog:
>
> * gdb.texinfo (Debugging Output): Document 'set/show debug
> fortran-array-slicing'.
> (Special Fortran Commands): Document 'set/show fortran
> repack-array-slices'.
> ---
> gdb/ChangeLog | 32 +
> gdb/Makefile.in | 1 +
> gdb/NEWS | 13 +
> gdb/doc/ChangeLog | 7 +
> gdb/doc/gdb.texinfo | 32 +
> gdb/f-array-walker.h | 265 +++++++
> gdb/f-lang.c | 712 ++++++++++++++++--
> gdb/f-lang.h | 19 +-
> gdb/f-valprint.c | 187 +++--
> gdb/gdbtypes.c | 12 +-
> gdb/testsuite/ChangeLog | 10 +
> .../gdb.fortran/array-slices-bad.exp | 69 ++
> .../gdb.fortran/array-slices-bad.f90 | 42 ++
> .../gdb.fortran/array-slices-sub-slices.exp | 111 +++
> .../gdb.fortran/array-slices-sub-slices.f90 | 96 +++
> gdb/testsuite/gdb.fortran/array-slices.exp | 277 +++++--
> gdb/testsuite/gdb.fortran/array-slices.f90 | 364 ++++++++-
> gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +-
> 18 files changed, 1998 insertions(+), 255 deletions(-)
> create mode 100644 gdb/f-array-walker.h
> create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.exp
> create mode 100644 gdb/testsuite/gdb.fortran/array-slices-bad.f90
> create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
> create mode 100644 gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
>
> diff --git a/gdb/Makefile.in b/gdb/Makefile.in
> index 8a160896e2c..1838743a883 100644
> --- a/gdb/Makefile.in
> +++ b/gdb/Makefile.in
> @@ -1273,6 +1273,7 @@ HFILES_NO_SRCDIR = \
> expression.h \
> extension.h \
> extension-priv.h \
> + f-array-walker.h \
> f-lang.h \
> fbsd-nat.h \
> fbsd-tdep.h \
> diff --git a/gdb/NEWS b/gdb/NEWS
> index c99d3181a8b..be4b2956f17 100644
> --- a/gdb/NEWS
> +++ b/gdb/NEWS
> @@ -153,6 +153,19 @@ maintenance print core-file-backed-mappings
> Prints file-backed mappings loaded from a core file's note section.
> Output is expected to be similar to that of "info proc mappings".
>
> +set debug fortran-array-slicing on|off
> +show debug fortran-array-slicing
> + Print debugging when taking slices of Fortran arrays.
> +
> +set fortran repack-array-slices on|off
> +show fortran repack-array-slices
> + When taking slices from Fortran arrays and strings, if the slice is
> + non-contiguous within the original value then, when this option is
> + on, the new value will be repacked into a single contiguous value.
> + When this option is off, then the value returned will consist of a
> + descriptor that describes the slice within the memory of the
> + original parent value.
> +
> * Changed commands
>
> alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...]
> diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
> index d779d4a84f1..9e21d65c650 100644
> --- a/gdb/doc/gdb.texinfo
> +++ b/gdb/doc/gdb.texinfo
> @@ -16989,6 +16989,29 @@
> block whose name is @var{common-name}. With no argument, the names of
> all @code{COMMON} blocks visible at the current program location are
> printed.
> +@cindex arrays slices (Fortran)
> +@kindex set fortran repack-array-slices
> +@kindex show fortran repack-array-slices
> +@item set fortran repack-array-slices [on|off]
> +@item show fortran repack-array-slices
> +When taking a slice from an array, a Fortran compiler can choose to
> +either produce an array descriptor that describes the slice in place,
> +or it may repack the slice, copying the elements of the slice into a
> +new region of memory.
> +
> +When this setting is on, then @value{GDBN} will also repack array
> +slices in some situations. When this setting is off, then
> +@value{GDBN} will create array descriptors for slices that reference
> +the original data in place.
> +
> +@value{GDBN} will never repack an array slice if the data for the
> +slice is contiguous within the original array.
> +
> +@value{GDBN} will always repack string slices if the data for the
> +slice is non-contiguous within the original string as @value{GDBN}
> +does not support printing non-contiguous strings.
> +
> +The default for this setting is @code{off}.
> @end table
>
> @node Pascal
> @@ -26581,6 +26604,15 @@
> @item show debug fbsd-nat
> Show the current state of FreeBSD native target debugging messages.
>
> +@item set debug fortran-array-slicing
> +@cindex fortran array slicing debugging info
> +Turns on or off display of @value{GDBN} Fortran array slicing
> +debugging info. The default is off.
> +
> +@item show debug fortran-array-slicing
> +Displays the current state of displaying @value{GDBN} Fortran array
> +slicing debugging info.
> +
> @item set debug frame
> @cindex frame debugging info
> Turns on or off display of @value{GDBN} frame debugging info. The
> diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h
> new file mode 100644
> index 00000000000..417f9f07980
> --- /dev/null
> +++ b/gdb/f-array-walker.h
> @@ -0,0 +1,265 @@
> +/* Copyright (C) 2020 Free Software Foundation, Inc.
> +
> + This file is part of GDB.
> +
> + 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/>. */
> +
> +/* Support classes to wrap up the process of iterating over a
> + multi-dimensional Fortran array. */
> +
> +#ifndef F_ARRAY_WALKER_H
> +#define F_ARRAY_WALKER_H
> +
> +#include "defs.h"
> +#include "gdbtypes.h"
> +#include "f-lang.h"
> +
> +/* Class for calculating the byte offset for elements within a single
> + dimension of a Fortran array. */
> +class fortran_array_offset_calculator
> +{
> +public:
> + /* Create a new offset calculator for TYPE, which is either an array or a
> + string. */
> + explicit fortran_array_offset_calculator (struct type *type)
> + {
> + /* Validate the type. */
> + type = check_typedef (type);
> + if (type->code () != TYPE_CODE_ARRAY
> + && (type->code () != TYPE_CODE_STRING))
> + error (_("can only compute offsets for arrays and strings"));
> +
> + /* Get the range, and extract the bounds. */
> + struct type *range_type = type->index_type ();
> + if (get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound) < 0)
> + error ("unable to read array bounds");
> +
> + /* Figure out the stride for this array. */
> + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
> + m_stride = type->index_type ()->bounds ()->bit_stride ();
> + if (m_stride == 0)
> + m_stride = type_length_units (elt_type);
> + else
> + {
> + struct gdbarch *arch = get_type_arch (elt_type);
> + int unit_size = gdbarch_addressable_memory_unit_size (arch);
> + m_stride /= (unit_size * 8);
> + }
> + };
> +
> + /* Get the byte offset for element INDEX within the type we are working
> + on. There is no bounds checking done on INDEX. If the stride is
> + negative then we still assume that the base address (for the array
> + object) points to the element with the lowest memory address, we then
> + calculate an offset assuming that index 0 will be the element at the
> + highest address, index 1 the next highest, and so on. This is not
> + quite how Fortran works in reality; in reality the base address of
> + the object would point at the element with the highest address, and
> + we would index backwards from there in the "normal" way, however,
> + GDB's current value contents model doesn't support having the base
> + address be near to the end of the value contents, so we currently
> + adjust the base address of Fortran arrays with negative strides so
> + their base address points at the lowest memory address. This code
> + here is part of working around this weirdness. */
> + LONGEST index_offset (LONGEST index)
> + {
> + LONGEST offset;
> + if (m_stride < 0)
> + offset = std::abs (m_stride) * (m_upperbound - index);
> + else
> + offset = std::abs (m_stride) * (index - m_lowerbound);
> + return offset;
> + }
> +
> +private:
> +
> + /* The stride for the type we are working with. */
> + LONGEST m_stride;
> +
> + /* The upper bound for the type we are working with. */
> + LONGEST m_upperbound;
> +
> + /* The lower bound for the type we are working with. */
> + LONGEST m_lowerbound;
> +};
> +
> +/* A base class used by fortran_array_walker. There's no virtual methods
> + here, sub-classes should just override the functions they want in order
> + to specialise the behaviour to their needs. The functionality
> + provided in these default implementations will visit every array
> + element, but do nothing for each element. */
> +
> +struct fortran_array_walker_base_impl
> +{
> + /* Called when iterating between the lower and upper bounds of each
> + dimension of the array. Return true if GDB should continue iterating,
> + otherwise, return false.
> +
> + SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
> + be taken into consideration when deciding what to return. If
> + SHOULD_CONTINUE is false then this function must also return false,
> + the function is still called though in case extra work needs to be
> + done as part of the stopping process. */
> + bool continue_walking (bool should_continue)
> + { return should_continue; }
> +
> + /* Called when GDB starts iterating over a dimension of the array. The
> + argument INNER_P is true for the inner most dimension (the dimension
> + containing the actual elements of the array), and false for more outer
> + dimensions. For a concrete example of how this function is called
> + see the comment on process_element below. */
> + void start_dimension (bool inner_p)
> + { /* Nothing. */ }
> +
> + /* Called when GDB finishes iterating over a dimension of the array. The
> + argument INNER_P is true for the inner most dimension (the dimension
> + containing the actual elements of the array), and false for more outer
> + dimensions. LAST_P is true for the last call at a particular
> + dimension. For a concrete example of how this function is called
> + see the comment on process_element below. */
> + void finish_dimension (bool inner_p, bool last_p)
> + { /* Nothing. */ }
> +
> + /* Called when processing the inner most dimension of the array, for
> + every element in the array. ELT_TYPE is the type of the element being
> + extracted, and ELT_OFF is the offset of the element from the start of
> + array being walked, and LAST_P is true only when this is the last
> + element that will be processed in this dimension.
> +
> + Given this two dimensional array ((1, 2) (3, 4)), the calls to
> + start_dimension, process_element, and finish_dimension look like this:
> +
> + start_dimension (false);
> + start_dimension (true);
> + process_element (TYPE, OFFSET, false);
> + process_element (TYPE, OFFSET, true);
> + finish_dimension (true, false);
> + start_dimension (true);
> + process_element (TYPE, OFFSET, false);
> + process_element (TYPE, OFFSET, true);
> + finish_dimension (true, true);
> + finish_dimension (false, true); */
> + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
> + { /* Nothing. */ }
> +};
> +
> +/* A class to wrap up the process of iterating over a multi-dimensional
> + Fortran array. IMPL is used to specialise what happens as we walk over
> + the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
> + methods than can be used to customise the array walk. */
> +template<typename Impl>
> +class fortran_array_walker
> +{
> + /* Ensure that Impl is derived from the required base class. This just
> + ensures that all of the required API methods are available and have a
> + sensible default implementation. */
> + gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
> +
> +public:
> + /* Create a new array walker. TYPE is the type of the array being walked
> + over, and ADDRESS is the base address for the object of TYPE in
> + memory. All other arguments are forwarded to the constructor of the
> + template parameter class IMPL. */
> + template <typename ...Args>
> + fortran_array_walker (struct type *type, CORE_ADDR address,
> + Args... args)
> + : m_type (type),
> + m_address (address),
> + m_impl (type, address, args...)
> + {
> + m_ndimensions = calc_f77_array_dims (m_type);
> + }
> +
> + /* Walk the array. */
> + void
> + walk ()
> + {
> + walk_1 (1, m_type, 0, false);
> + }
> +
> +private:
> + /* The core of the array walking algorithm. NSS is the current
> + dimension number being processed, TYPE is the type of this dimension,
> + and OFFSET is the offset (in bytes) for the start of this dimension. */
> + void
> + walk_1 (int nss, struct type *type, int offset, bool last_p)
> + {
> + /* Extract the range, and get lower and upper bounds. */
> + struct type *range_type = check_typedef (type)->index_type ();
> + LONGEST lowerbound, upperbound;
> + if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
> + error ("failed to get range bounds");
> +
> + /* CALC is used to calculate the offsets for each element in this
> + dimension. */
> + fortran_array_offset_calculator calc (type);
> +
> + m_impl.start_dimension (nss == m_ndimensions);
> +
> + if (nss != m_ndimensions)
> + {
> + /* For dimensions other than the inner most, walk each element and
> + recurse while peeling off one more dimension of the array. */
> + for (LONGEST i = lowerbound;
> + m_impl.continue_walking (i < upperbound + 1);
> + i++)
> + {
> + /* Use the index and the stride to work out a new offset. */
> + LONGEST new_offset = offset + calc.index_offset (i);
> +
> + /* Now print the lower dimension. */
> + struct type *subarray_type
> + = TYPE_TARGET_TYPE (check_typedef (type));
> + walk_1 (nss + 1, subarray_type, new_offset, (i == upperbound));
> + }
> + }
> + else
> + {
> + /* For the inner most dimension of the array, process each element
> + within this dimension. */
> + for (LONGEST i = lowerbound;
> + m_impl.continue_walking (i < upperbound + 1);
> + i++)
> + {
> + LONGEST elt_off = offset + calc.index_offset (i);
> +
> + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
> + if (is_dynamic_type (elt_type))
> + {
> + CORE_ADDR e_address = m_address + elt_off;
> + elt_type = resolve_dynamic_type (elt_type, {}, e_address);
> + }
> +
> + m_impl.process_element (elt_type, elt_off, (i == upperbound));
> + }
> + }
> +
> + m_impl.finish_dimension (nss == m_ndimensions, last_p || nss == 1);
> + }
> +
> + /* The array type being processed. */
> + struct type *m_type;
> +
> + /* The address in target memory for the object of M_TYPE being
> + processed. This is required in order to resolve dynamic types. */
> + CORE_ADDR m_address;
> +
> + /* An instance of the template specialisation class. */
> + Impl m_impl;
> +
> + /* The total number of dimensions in M_TYPE. */
> + int m_ndimensions;
> +};
> +
> +#endif /* F_ARRAY_WALKER_H */
> diff --git a/gdb/f-lang.c b/gdb/f-lang.c
> index 52493743031..d9b2e715442 100644
> --- a/gdb/f-lang.c
> +++ b/gdb/f-lang.c
> @@ -36,9 +36,36 @@
> #include "c-lang.h"
> #include "target-float.h"
> #include "gdbarch.h"
> +#include "gdbcmd.h"
> +#include "f-array-walker.h"
>
> #include <math.h>
>
> +/* Whether GDB should repack array slices created by the user. */
> +static bool repack_array_slices = false;
> +
> +/* Implement 'show fortran repack-array-slices'. */
> +static void
> +show_repack_array_slices (struct ui_file *file, int from_tty,
> + struct cmd_list_element *c, const char *value)
> +{
> + fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"),
> + value);
> +}
> +
> +/* Debugging of Fortran's array slicing. */
> +static bool fortran_array_slicing_debug = false;
> +
> +/* Implement 'show debug fortran-array-slicing'. */
> +static void
> +show_fortran_array_slicing_debug (struct ui_file *file, int from_tty,
> + struct cmd_list_element *c,
> + const char *value)
> +{
> + fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"),
> + value);
> +}
> +
> /* Local functions */
>
> /* Return the encoding that should be used for the character type
> @@ -114,57 +141,6 @@ enum f_primitive_types {
> nr_f_primitive_types
> };
>
> -/* Called from fortran_value_subarray to take a slice of an array or a
> - string. ARRAY is the array or string to be accessed. EXP, POS, and
> - NOSIDE are as for evaluate_subexp_standard. Return a value that is a
> - slice of the array. */
> -
> -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, stride;
> - struct type *range = check_typedef (value_type (array)->index_type ());
> - enum range_flag range_flag
> - = (enum range_flag) longest_to_int (exp->elts[pc].longconst);
> -
> - *pos += 3;
> -
> - if (range_flag & RANGE_LOW_BOUND_DEFAULT)
> - low_bound = range->bounds ()->low.const_val ();
> - else
> - low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> -
> - if (range_flag & RANGE_HIGH_BOUND_DEFAULT)
> - high_bound = range->bounds ()->high.const_val ();
> - else
> - high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> -
> - if (range_flag & RANGE_HAS_STRIDE)
> - stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> - else
> - stride = 1;
> -
> - if (stride != 1)
> - error (_("Fortran array strides are not currently supported"));
> -
> - return value_slice (array, low_bound, high_bound - low_bound + 1);
> -}
> -
> -/* Helper for skipping all the arguments in an undetermined argument list.
> - This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
> - case of evaluate_subexp_standard as multiple, but not all, code paths
> - require a generic skip. */
> -
> -static void
> -skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
> - enum noside noside)
> -{
> - for (int i = 0; i < nargs; ++i)
> - evaluate_subexp (nullptr, exp, pos, noside);
> -}
> -
> /* Return the number of dimensions for a Fortran array or string. */
>
> int
> @@ -189,6 +165,145 @@ calc_f77_array_dims (struct type *array_type)
> return ndimen;
> }
>
> +/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
> + slices. This is a base class for two alternative repacking mechanisms,
> + one for when repacking from a lazy value, and one for repacking from a
> + non-lazy (already loaded) value. */
> +class fortran_array_repacker_base_impl
> + : public fortran_array_walker_base_impl
> +{
> +public:
> + /* Constructor, DEST is the value we are repacking into. */
> + fortran_array_repacker_base_impl (struct value *dest)
> + : m_dest (dest),
> + m_dest_offset (0)
> + { /* Nothing. */ }
> +
> + /* When we start processing the inner most dimension, this is where we
> + will be creating values for each element as we load them and then copy
> + them into the M_DEST value. Set a value mark so we can free these
> + temporary values. */
> + void start_dimension (bool inner_p)
> + {
> + if (inner_p)
> + {
> + gdb_assert (m_mark == nullptr);
> + m_mark = value_mark ();
> + }
> + }
> +
> + /* When we finish processing the inner most dimension free all temporary
> + value that were created. */
> + void finish_dimension (bool inner_p, bool last_p)
> + {
> + if (inner_p)
> + {
> + gdb_assert (m_mark != nullptr);
> + value_free_to_mark (m_mark);
> + m_mark = nullptr;
> + }
> + }
> +
> +protected:
> + /* Copy the contents of array element ELT into M_DEST at the next
> + available offset. */
> + void copy_element_to_dest (struct value *elt)
> + {
> + value_contents_copy (m_dest, m_dest_offset, elt, 0,
> + TYPE_LENGTH (value_type (elt)));
> + m_dest_offset += TYPE_LENGTH (value_type (elt));
> + }
> +
> + /* The value being written to. */
> + struct value *m_dest;
> +
> + /* The byte offset in M_DEST at which the next element should be
> + written. */
> + LONGEST m_dest_offset;
> +
> + /* Set with a call to VALUE_MARK, and then reset after calling
> + VALUE_FREE_TO_MARK. */
> + struct value *m_mark = nullptr;
> +};
> +
> +/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
> + slices. This class is specialised for repacking an array slice from a
> + lazy array value, as such it does not require the parent array value to
> + be loaded into GDB's memory; the parent value could be huge, while the
> + slice could be tiny. */
> +class fortran_lazy_array_repacker_impl
> + : public fortran_array_repacker_base_impl
> +{
> +public:
> + /* Constructor. TYPE is the type of the slice being loaded from the
> + parent value, so this type will correctly reflect the strides required
> + to find all of the elements from the parent value. ADDRESS is the
> + address in target memory of value matching TYPE, and DEST is the value
> + we are repacking into. */
> + explicit fortran_lazy_array_repacker_impl (struct type *type,
> + CORE_ADDR address,
> + struct value *dest)
> + : fortran_array_repacker_base_impl (dest),
> + m_addr (address)
> + { /* Nothing. */ }
> +
> + /* Create a lazy value in target memory representing a single element,
> + then load the element into GDB's memory and copy the contents into the
> + destination value. */
> + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
> + {
> + copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off));
> + }
> +
> +private:
> + /* The address in target memory where the parent value starts. */
> + CORE_ADDR m_addr;
> +};
> +
> +/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array
> + slices. This class is specialised for repacking an array slice from a
> + previously loaded (non-lazy) array value, as such it fetches the
> + element values from the contents of the parent value. */
> +class fortran_array_repacker_impl
> + : public fortran_array_repacker_base_impl
> +{
> +public:
> + /* Constructor. TYPE is the type for the array slice within the parent
> + value, as such it has stride values as required to find the elements
> + within the original parent value. ADDRESS is the address in target
> + memory of the value matching TYPE. BASE_OFFSET is the offset from
> + the start of VAL's content buffer to the start of the object of TYPE,
> + VAL is the parent object from which we are loading the value, and
> + DEST is the value into which we are repacking. */
> + explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address,
> + LONGEST base_offset,
> + struct value *val, struct value *dest)
> + : fortran_array_repacker_base_impl (dest),
> + m_base_offset (base_offset),
> + m_val (val)
> + {
> + gdb_assert (!value_lazy (val));
> + }
> +
> + /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF)
> + from the content buffer of M_VAL then copy this extracted value into
> + the repacked destination value. */
> + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
> + {
> + struct value *elt
> + = value_from_component (m_val, elt_type, (elt_off + m_base_offset));
> + copy_element_to_dest (elt);
> + }
> +
> +private:
> + /* The offset into the content buffer of M_VAL to the start of the slice
> + being extracted. */
> + LONGEST m_base_offset;
> +
> + /* The parent value from which we are extracting a slice. */
> + struct value *m_val;
> +};
> +
> /* Called from evaluate_subexp_standard to perform array indexing, and
> sub-range extraction, for Fortran. As well as arrays this function
> also handles strings as they can be treated like arrays of characters.
> @@ -200,51 +315,394 @@ static struct value *
> fortran_value_subarray (struct value *array, struct expression *exp,
> int *pos, int nargs, enum noside noside)
> {
> - if (exp->elts[*pos].opcode == OP_RANGE)
> - return value_f90_subarray (array, exp, pos, noside);
> -
> - if (noside == EVAL_SKIP)
> + type *original_array_type = check_typedef (value_type (array));
> + bool is_string_p = original_array_type->code () == TYPE_CODE_STRING;
> +
> + /* Perform checks for ARRAY not being available. The somewhat overly
> + complex logic here is just to keep backward compatibility with the
> + errors that we used to get before FORTRAN_VALUE_SUBARRAY was
> + rewritten. Maybe a future task would streamline the error messages we
> + get here, and update all the expected test results. */
> + if (exp->elts[*pos].opcode != OP_RANGE)
> + {
> + if (type_not_associated (original_array_type))
> + error (_("no such vector element (vector not associated)"));
> + else if (type_not_allocated (original_array_type))
> + error (_("no such vector element (vector not allocated)"));
> + }
> + else
> {
> - skip_undetermined_arglist (nargs, exp, pos, noside);
> - /* Return the dummy value with the correct type. */
> - return array;
> + if (type_not_associated (original_array_type))
> + error (_("array not associated"));
> + else if (type_not_allocated (original_array_type))
> + error (_("array not allocated"));
> }
>
> - LONGEST subscript_array[MAX_FORTRAN_DIMS];
> - int ndimensions = 1;
> - struct type *type = check_typedef (value_type (array));
> + /* First check that the number of dimensions in the type we are slicing
> + matches the number of arguments we were passed. */
> + int ndimensions = calc_f77_array_dims (original_array_type);
> + if (nargs != ndimensions)
> + error (_("Wrong number of subscripts"));
> +
> + /* This will be initialised below with the type of the elements held in
> + ARRAY. */
> + struct type *inner_element_type;
> +
> + /* Extract the types of each array dimension from the original array
> + type. We need these available so we can fill in the default upper and
> + lower bounds if the user requested slice doesn't provide that
> + information. Additionally unpacking the dimensions like this gives us
> + the inner element type. */
> + std::vector<struct type *> dim_types;
> + {
> + dim_types.reserve (ndimensions);
> + struct type *type = original_array_type;
> + for (int i = 0; i < ndimensions; ++i)
> + {
> + dim_types.push_back (type);
> + type = TYPE_TARGET_TYPE (type);
> + }
> + /* TYPE is now the inner element type of the array, we start the new
> + array slice off as this type, then as we process the requested slice
> + (from the user) we wrap new types around this to build up the final
> + slice type. */
> + inner_element_type = type;
> + }
> +
> + /* As we analyse the new slice type we need to understand if the data
> + being referenced is contiguous. Do decide this we must track the size
> + of an element at each dimension of the new slice array. Initially the
> + elements of the inner most dimension of the array are the same inner
> + most elements as the original ARRAY. */
> + LONGEST slice_element_size = TYPE_LENGTH (inner_element_type);
> +
> + /* Start off assuming all data is contiguous, this will be set to false
> + if access to any dimension results in non-contiguous data. */
> + bool is_all_contiguous = true;
> +
> + /* The TOTAL_OFFSET is the distance in bytes from the start of the
> + original ARRAY to the start of the new slice. This is calculated as
> + we process the information from the user. */
> + LONGEST total_offset = 0;
> +
> + /* A structure representing information about each dimension of the
> + resulting slice. */
> + struct slice_dim
> + {
> + /* Constructor. */
> + slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx)
> + : low (l),
> + high (h),
> + stride (s),
> + index (idx)
> + { /* Nothing. */ }
> +
> + /* The low bound for this dimension of the slice. */
> + LONGEST low;
> +
> + /* The high bound for this dimension of the slice. */
> + LONGEST high;
> +
> + /* The byte stride for this dimension of the slice. */
> + LONGEST stride;
> +
> + struct type *index;
> + };
> +
> + /* The dimensions of the resulting slice. */
> + std::vector<slice_dim> slice_dims;
> +
> + /* Process the incoming arguments. These arguments are in the reverse
> + order to the array dimensions, that is the first argument refers to
> + the last array dimension. */
> + if (fortran_array_slicing_debug)
> + debug_printf ("Processing array access:\n");
> + for (int i = 0; i < nargs; ++i)
> + {
> + /* For each dimension of the array the user will have either provided
> + a ranged access with optional lower bound, upper bound, and
> + stride, or the user will have supplied a single index. */
> + struct type *dim_type = dim_types[ndimensions - (i + 1)];
> + if (exp->elts[*pos].opcode == OP_RANGE)
> + {
> + int pc = (*pos) + 1;
> + enum range_flag range_flag = (enum range_flag) exp->elts[pc].longconst;
> + *pos += 3;
> +
> + LONGEST low, high, stride;
> + low = high = stride = 0;
> +
> + if ((range_flag & RANGE_LOW_BOUND_DEFAULT) == 0)
> + low = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> + else
> + low = f77_get_lowerbound (dim_type);
> + if ((range_flag & RANGE_HIGH_BOUND_DEFAULT) == 0)
> + high = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> + else
> + high = f77_get_upperbound (dim_type);
> + if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE)
> + stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
> + else
> + stride = 1;
> +
> + if (stride == 0)
> + error (_("stride must not be 0"));
> +
> + /* Get information about this dimension in the original ARRAY. */
> + struct type *target_type = TYPE_TARGET_TYPE (dim_type);
> + struct type *index_type = dim_type->index_type ();
> + LONGEST lb = f77_get_lowerbound (dim_type);
> + LONGEST ub = f77_get_upperbound (dim_type);
> + LONGEST sd = index_type->bit_stride ();
> + if (sd == 0)
> + sd = TYPE_LENGTH (target_type) * 8;
> +
> + if (fortran_array_slicing_debug)
> + {
> + debug_printf ("|-> Range access\n");
> + std::string str = type_to_string (dim_type);
> + debug_printf ("| |-> Type: %s\n", str.c_str ());
> + debug_printf ("| |-> Array:\n");
> + debug_printf ("| | |-> Low bound: %ld\n", lb);
> + debug_printf ("| | |-> High bound: %ld\n", ub);
> + debug_printf ("| | |-> Bit stride: %ld\n", sd);
> + debug_printf ("| | |-> Byte stride: %ld\n", sd / 8);
> + debug_printf ("| | |-> Type size: %ld\n",
> + TYPE_LENGTH (dim_type));
> + debug_printf ("| | '-> Target type size: %ld\n",
> + TYPE_LENGTH (target_type));
> + debug_printf ("| |-> Accessing:\n");
> + debug_printf ("| | |-> Low bound: %ld\n",
> + low);
> + debug_printf ("| | |-> High bound: %ld\n",
> + high);
> + debug_printf ("| | '-> Element stride: %ld\n",
> + stride);
> + }
> +
> + /* Check the user hasn't asked for something invalid. */
> + if (high > ub || low < lb)
> + error (_("array subscript out of bounds"));
> +
> + /* Calculate what this dimension of the new slice array will look
> + like. OFFSET is the byte offset from the start of the
> + previous (more outer) dimension to the start of this
> + dimension. E_COUNT is the number of elements in this
> + dimension. REMAINDER is the number of elements remaining
> + between the last included element and the upper bound. For
> + example an access '1:6:2' will include elements 1, 3, 5 and
> + have a remainder of 1 (element #6). */
> + LONGEST lowest = std::min (low, high);
> + LONGEST offset = (sd / 8) * (lowest - lb);
> + LONGEST e_count = std::abs (high - low) + 1;
> + e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride);
> + LONGEST new_low = 1;
> + LONGEST new_high = new_low + e_count - 1;
> + LONGEST new_stride = (sd * stride) / 8;
> + LONGEST last_elem = low + ((e_count - 1) * stride);
> + LONGEST remainder = high - last_elem;
> + if (low > high)
> + {
> + offset += std::abs (remainder) * TYPE_LENGTH (target_type);
> + if (stride > 0)
> + error (_("incorrect stride and boundary combination"));
> + }
> + else if (stride < 0)
> + error (_("incorrect stride and boundary combination"));
> +
> + /* Is the data within this dimension contiguous? It is if the
> + newly computed stride is the same size as a single element of
> + this dimension. */
> + bool is_dim_contiguous = (new_stride == slice_element_size);
> + is_all_contiguous &= is_dim_contiguous;
>
> - if (nargs > MAX_FORTRAN_DIMS)
> - error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
> + if (fortran_array_slicing_debug)
> + {
> + debug_printf ("| '-> Results:\n");
> + debug_printf ("| |-> Offset = %ld\n", offset);
> + debug_printf ("| |-> Elements = %ld\n", e_count);
> + debug_printf ("| |-> Low bound = %ld\n", new_low);
> + debug_printf ("| |-> High bound = %ld\n", new_high);
> + debug_printf ("| |-> Byte stride = %ld\n", new_stride);
> + debug_printf ("| |-> Last element = %ld\n", last_elem);
> + debug_printf ("| |-> Remainder = %ld\n", remainder);
> + debug_printf ("| '-> Contiguous = %s\n",
> + (is_dim_contiguous ? "Yes" : "No"));
> + }
>
> - ndimensions = calc_f77_array_dims (type);
> + /* Figure out how big (in bytes) an element of this dimension of
> + the new array slice will be. */
> + slice_element_size = std::abs (new_stride * e_count);
>
> - if (nargs != ndimensions)
> - error (_("Wrong number of subscripts"));
> + slice_dims.emplace_back (new_low, new_high, new_stride,
> + index_type);
> +
> + /* Update the total offset. */
> + total_offset += offset;
> + }
> + else
> + {
> + /* There is a single index for this dimension. */
> + LONGEST index
> + = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside));
> +
> + /* Get information about this dimension in the original ARRAY. */
> + struct type *target_type = TYPE_TARGET_TYPE (dim_type);
> + struct type *index_type = dim_type->index_type ();
> + LONGEST lb = f77_get_lowerbound (dim_type);
> + LONGEST ub = f77_get_upperbound (dim_type);
> + LONGEST sd = index_type->bit_stride () / 8;
> + if (sd == 0)
> + sd = TYPE_LENGTH (target_type);
> +
> + if (fortran_array_slicing_debug)
> + {
> + debug_printf ("|-> Index access\n");
> + std::string str = type_to_string (dim_type);
> + debug_printf ("| |-> Type: %s\n", str.c_str ());
> + debug_printf ("| |-> Array:\n");
> + debug_printf ("| | |-> Low bound: %ld\n", lb);
> + debug_printf ("| | |-> High bound: %ld\n", ub);
> + debug_printf ("| | |-> Byte stride: %ld\n", sd);
> + debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type));
> + debug_printf ("| | '-> Target type size: %ld\n",
> + TYPE_LENGTH (target_type));
> + debug_printf ("| '-> Accessing:\n");
> + debug_printf ("| '-> Index: %ld\n", index);
> + }
>
> - gdb_assert (nargs > 0);
> + /* If the array has actual content then check the index is in
> + bounds. An array without content (an unbound array) doesn't
> + have a known upper bound, so don't error check in that
> + situation. */
> + if (index < lb
> + || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED
> + && index > ub)
> + || (VALUE_LVAL (array) != lval_memory
> + && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED))
> + {
> + if (type_not_associated (dim_type))
> + error (_("no such vector element (vector not associated)"));
> + else if (type_not_allocated (dim_type))
> + error (_("no such vector element (vector not allocated)"));
> + else
> + error (_("no such vector element"));
> + }
> +
> + /* Calculate using the type stride, not the target type size. */
> + LONGEST offset = sd * (index - lb);
> + total_offset += offset;
> + }
> + }
>
> - /* Now that we know we have a legal array subscript expression let us
> - actually find out where this element exists in the array. */
> + if (noside == EVAL_SKIP)
> + return array;
>
> - /* Take array indices left to right. */
> - for (int i = 0; i < nargs; i++)
> + /* Build a type that represents the new array slice in the target memory
> + of the original ARRAY, this type makes use of strides to correctly
> + find only those elements that are part of the new slice. */
> + struct type *array_slice_type = inner_element_type;
> + for (const auto &d : slice_dims)
> {
> - /* Evaluate each subscript; it must be a legal integer in F77. */
> - value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
> + /* Create the range. */
> + dynamic_prop p_low, p_high, p_stride;
> +
> + p_low.set_const_val (d.low);
> + p_high.set_const_val (d.high);
> + p_stride.set_const_val (d.stride);
> +
> + struct type *new_range
> + = create_range_type_with_stride ((struct type *) NULL,
> + TYPE_TARGET_TYPE (d.index),
> + &p_low, &p_high, 0, &p_stride,
> + true);
> + array_slice_type
> + = create_array_type (nullptr, array_slice_type, new_range);
> + }
>
> - /* Fill in the subscript array. */
> - subscript_array[i] = value_as_long (arg2);
> + if (fortran_array_slicing_debug)
> + {
> + debug_printf ("'-> Final result:\n");
> + debug_printf (" |-> Type: %s\n",
> + type_to_string (array_slice_type).c_str ());
> + debug_printf (" |-> Total offset: %ld\n", total_offset);
> + debug_printf (" |-> Base address: %s\n",
> + core_addr_to_string (value_address (array)));
> + debug_printf (" '-> Contiguous = %s\n",
> + (is_all_contiguous ? "Yes" : "No"));
> }
>
> - /* Internal type of array is arranged right to left. */
> - for (int i = nargs; i > 0; i--)
> + /* Should we repack this array slice? */
> + if (!is_all_contiguous && (repack_array_slices || is_string_p))
> {
> - struct type *array_type = check_typedef (value_type (array));
> - LONGEST index = subscript_array[i - 1];
> + /* Build a type for the repacked slice. */
> + struct type *repacked_array_type = inner_element_type;
> + for (const auto &d : slice_dims)
> + {
> + /* Create the range. */
> + dynamic_prop p_low, p_high, p_stride;
> +
> + p_low.set_const_val (d.low);
> + p_high.set_const_val (d.high);
> + p_stride.set_const_val (TYPE_LENGTH (repacked_array_type));
> +
> + struct type *new_range
> + = create_range_type_with_stride ((struct type *) NULL,
> + TYPE_TARGET_TYPE (d.index),
> + &p_low, &p_high, 0, &p_stride,
> + true);
> + repacked_array_type
> + = create_array_type (nullptr, repacked_array_type, new_range);
> + }
>
> - array = value_subscripted_rvalue (array, index,
> - f77_get_lowerbound (array_type));
> + /* Now copy the elements from the original ARRAY into the packed
> + array value DEST. */
> + struct value *dest = allocate_value (repacked_array_type);
> + if (value_lazy (array)
> + || (total_offset + TYPE_LENGTH (array_slice_type)
> + > TYPE_LENGTH (check_typedef (value_type (array)))))
> + {
> + fortran_array_walker<fortran_lazy_array_repacker_impl> p
> + (array_slice_type, value_address (array) + total_offset, dest);
> + p.walk ();
> + }
> + else
> + {
> + fortran_array_walker<fortran_array_repacker_impl> p
> + (array_slice_type, value_address (array) + total_offset,
> + total_offset, array, dest);
> + p.walk ();
> + }
> + array = dest;
> + }
> + else
> + {
> + if (VALUE_LVAL (array) == lval_memory)
> + {
> + /* If the value we're taking a slice from is not yet loaded, or
> + the requested slice is outside the values content range then
> + just create a new lazy value pointing at the memory where the
> + contents we're looking for exist. */
> + if (value_lazy (array)
> + || (total_offset + TYPE_LENGTH (array_slice_type)
> + > TYPE_LENGTH (check_typedef (value_type (array)))))
> + array = value_at_lazy (array_slice_type,
> + value_address (array) + total_offset);
> + else
> + array = value_from_contents_and_address (array_slice_type,
> + (value_contents (array)
> + + total_offset),
> + (value_address (array)
> + + total_offset));
> + }
> + else if (!value_lazy (array))
> + {
> + const void *valaddr = value_contents (array) + total_offset;
> + array = allocate_value (array_slice_type);
> + memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type));
> + }
> + else
> + error (_("cannot subscript arrays that are not in memory"));
> }
>
> return array;
> @@ -862,11 +1320,50 @@ builtin_f_type (struct gdbarch *gdbarch)
> return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
> }
>
> +/* Command-list for the "set/show fortran" prefix command. */
> +static struct cmd_list_element *set_fortran_list;
> +static struct cmd_list_element *show_fortran_list;
> +
> void _initialize_f_language ();
> void
> _initialize_f_language ()
> {
> f_type_data = gdbarch_data_register_post_init (build_fortran_types);
> +
> + add_basic_prefix_cmd ("fortran", no_class,
> + _("Prefix command for changing Fortran-specific settings."),
> + &set_fortran_list, "set fortran ", 0, &setlist);
> +
> + add_show_prefix_cmd ("fortran", no_class,
> + _("Generic command for showing Fortran-specific settings."),
> + &show_fortran_list, "show fortran ", 0, &showlist);
> +
> + add_setshow_boolean_cmd ("repack-array-slices", class_vars,
> + &repack_array_slices, _("\
> +Enable or disable repacking of non-contiguous array slices."), _("\
> +Show whether non-contiguous array slices are repacked."), _("\
> +When the user requests a slice of a Fortran array then we can either return\n\
> +a descriptor that describes the array in place (using the original array data\n\
> +in its existing location) or the original data can be repacked (copied) to a\n\
> +new location.\n\
> +\n\
> +When the content of the array slice is contiguous within the original array\n\
> +then the result will never be repacked, but when the data for the new array\n\
> +is non-contiguous within the original array repacking will only be performed\n\
> +when this setting is on."),
> + NULL,
> + show_repack_array_slices,
> + &set_fortran_list, &show_fortran_list);
> +
> + /* Debug Fortran's array slicing logic. */
> + add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance,
> + &fortran_array_slicing_debug, _("\
> +Set debugging of Fortran array slicing."), _("\
> +Show debugging of Fortran array slicing."), _("\
> +When on, debugging of Fortran array slicing is enabled."),
> + NULL,
> + show_fortran_array_slicing_debug,
> + &setdebuglist, &showdebuglist);
> }
>
> /* See f-lang.h. */
> @@ -905,3 +1402,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type)
> return value_type (arg);
> return type;
> }
> +
> +/* See f-lang.h. */
> +
> +CORE_ADDR
> +fortran_adjust_dynamic_array_base_address_hack (struct type *type,
> + CORE_ADDR address)
> +{
> + gdb_assert (type->code () == TYPE_CODE_ARRAY);
> +
> + int ndimensions = calc_f77_array_dims (type);
> + LONGEST total_offset = 0;
> +
> + /* Walk through each of the dimensions of this array type and figure out
> + if any of the dimensions are "backwards", that is the base address
> + for this dimension points to the element at the highest memory
> + address and the stride is negative. */
> + struct type *tmp_type = type;
> + for (int i = 0 ; i < ndimensions; ++i)
> + {
> + /* Grab the range for this dimension and extract the lower and upper
> + bounds. */
> + tmp_type = check_typedef (tmp_type);
> + struct type *range_type = tmp_type->index_type ();
> + LONGEST lowerbound, upperbound, stride;
> + if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
> + error ("failed to get range bounds");
> +
> + /* Figure out the stride for this dimension. */
> + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
> + stride = tmp_type->index_type ()->bounds ()->bit_stride ();
> + if (stride == 0)
> + stride = type_length_units (elt_type);
> + else
> + {
> + struct gdbarch *arch = get_type_arch (elt_type);
> + int unit_size = gdbarch_addressable_memory_unit_size (arch);
> + stride /= (unit_size * 8);
> + }
> +
> + /* If this dimension is "backward" then figure out the offset
> + adjustment required to point to the element at the lowest memory
> + address, and add this to the total offset. */
> + LONGEST offset = 0;
> + if (stride < 0 && lowerbound < upperbound)
> + offset = (upperbound - lowerbound) * stride;
> + total_offset += offset;
> + tmp_type = TYPE_TARGET_TYPE (tmp_type);
> + }
> +
> + /* Adjust the address of this object and return it. */
> + address += total_offset;
> + return address;
> +}
> diff --git a/gdb/f-lang.h b/gdb/f-lang.h
> index e59fdef1b19..880c07e4473 100644
> --- a/gdb/f-lang.h
> +++ b/gdb/f-lang.h
> @@ -316,7 +316,6 @@ extern void f77_get_dynamic_array_length (struct type *);
>
> extern int calc_f77_array_dims (struct type *);
>
> -
> /* Fortran (F77) types */
>
> struct builtin_f_type
> @@ -374,4 +373,22 @@ extern struct value *fortran_argument_convert (struct value *value,
> extern struct type *fortran_preserve_arg_pointer (struct value *arg,
> struct type *type);
>
> +/* Fortran arrays can have a negative stride. When this happens it is
> + often the case that the base address for an object is not the lowest
> + address occupied by that object. For example, an array slice (10:1:-1)
> + will be encoded with lower bound 1, upper bound 10, a stride of
> + -ELEMENT_SIZE, and have a base address pointer that points at the
> + element with the highest address in memory.
> +
> + This really doesn't play well with our current model of value contents,
> + but could easily require a significant update in order to be supported
> + "correctly".
> +
> + For now, we manually force the base address to be the lowest addressed
> + element here. Yes, this will break some things, but it fixes other
> + things. The hope is that it fixes more than it breaks. */
> +
> +extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
> + (struct type *type, CORE_ADDR address);
> +
> #endif /* F_LANG_H */
> diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
> index 95630a76d7d..83242f5ed47 100644
> --- a/gdb/f-valprint.c
> +++ b/gdb/f-valprint.c
> @@ -35,6 +35,7 @@
> #include "dictionary.h"
> #include "cli/cli-style.h"
> #include "gdbarch.h"
> +#include "f-array-walker.h"
>
> static void f77_get_dynamic_length_of_aggregate (struct type *);
>
> @@ -100,100 +101,103 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
> * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
> }
>
> -/* Actual function which prints out F77 arrays, Valaddr == address in
> - the superior. Address == the address in the inferior. */
> +/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array
> + walking template. This specialisation prints Fortran arrays. */
>
> -static void
> -f77_print_array_1 (int nss, int ndimensions, struct type *type,
> - const gdb_byte *valaddr,
> - int embedded_offset, CORE_ADDR address,
> - struct ui_file *stream, int recurse,
> - const struct value *val,
> - const struct value_print_options *options,
> - int *elts)
> +class fortran_array_printer_impl : public fortran_array_walker_base_impl
> {
> - struct type *range_type = check_typedef (type)->index_type ();
> - CORE_ADDR addr = address + embedded_offset;
> - LONGEST lowerbound, upperbound;
> - LONGEST i;
> -
> - get_discrete_bounds (range_type, &lowerbound, &upperbound);
> -
> - if (nss != ndimensions)
> - {
> - struct gdbarch *gdbarch = get_type_arch (type);
> - size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type));
> - int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
> - size_t byte_stride = type->bit_stride () / (unit_size * 8);
> - if (byte_stride == 0)
> - byte_stride = dim_size;
> - size_t offs = 0;
> -
> - for (i = lowerbound;
> - (i < upperbound + 1 && (*elts) < options->print_max);
> - i++)
> - {
> - struct value *subarray = value_from_contents_and_address
> - (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
> - + offs, addr + offs);
> -
> - fprintf_filtered (stream, "(");
> - f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
> - value_contents_for_printing (subarray),
> - value_embedded_offset (subarray),
> - value_address (subarray),
> - stream, recurse, subarray, options, elts);
> - offs += byte_stride;
> - fprintf_filtered (stream, ")");
> -
> - if (i < upperbound)
> - fprintf_filtered (stream, " ");
> - }
> - if (*elts >= options->print_max && i < upperbound)
> - fprintf_filtered (stream, "...");
> - }
> - else
> - {
> - for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
> - i++, (*elts)++)
> - {
> - struct value *elt = value_subscript ((struct value *)val, i);
> -
> - common_val_print (elt, stream, recurse, options, current_language);
> -
> - if (i != upperbound)
> - fprintf_filtered (stream, ", ");
> -
> - if ((*elts == options->print_max - 1)
> - && (i != upperbound))
> - fprintf_filtered (stream, "...");
> - }
> - }
> -}
> +public:
> + /* Constructor. TYPE is the array type being printed, ADDRESS is the
> + address in target memory for the object of TYPE being printed. VAL is
> + the GDB value (of TYPE) being printed. STREAM is where to print to,
> + RECOURSE is passed through (and prevents infinite recursion), and
> + OPTIONS are the printing control options. */
> + explicit fortran_array_printer_impl (struct type *type,
> + CORE_ADDR address,
> + struct value *val,
> + struct ui_file *stream,
> + int recurse,
> + const struct value_print_options *options)
> + : m_elts (0),
> + m_val (val),
> + m_stream (stream),
> + m_recurse (recurse),
> + m_options (options)
> + { /* Nothing. */ }
> +
> + /* Called while iterating over the array bounds. When SHOULD_CONTINUE is
> + false then we must return false, as we have reached the end of the
> + array bounds for this dimension. However, we also return false if we
> + have printed too many elements (after printing '...'). In all other
> + cases, return true. */
> + bool continue_walking (bool should_continue)
> + {
> + bool cont = should_continue && (m_elts < m_options->print_max);
> + if (!cont && should_continue)
> + fputs_filtered ("...", m_stream);
> + return cont;
> + }
> +
> + /* Called when we start iterating over a dimension. If it's not the
> + inner most dimension then print an opening '(' character. */
> + void start_dimension (bool inner_p)
> + {
> + fputs_filtered ("(", m_stream);
> + }
> +
> + /* Called when we finish processing a batch of items within a dimension
> + of the array. Depending on whether this is the inner most dimension
> + or not we print different things, but this is all about adding
> + separators between elements, and dimensions of the array. */
> + void finish_dimension (bool inner_p, bool last_p)
> + {
> + fputs_filtered (")", m_stream);
> + if (!last_p)
> + fputs_filtered (" ", m_stream);
> + }
> +
> + /* Called to process an element of ELT_TYPE at offset ELT_OFF from the
> + start of the parent object. */
> + void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
> + {
> + /* Extract the element value from the parent value. */
> + struct value *e_val
> + = value_from_component (m_val, elt_type, elt_off);
> + common_val_print (e_val, m_stream, m_recurse, m_options, current_language);
> + if (!last_p)
> + fputs_filtered (", ", m_stream);
> + ++m_elts;
> + }
> +
> +private:
> + /* The number of elements printed so far. */
> + int m_elts;
> +
> + /* The value from which we are printing elements. */
> + struct value *m_val;
> +
> + /* The stream we should print too. */
> + struct ui_file *m_stream;
> +
> + /* The recursion counter, passed through when we print each element. */
> + int m_recurse;
> +
> + /* The print control options. Gives us the maximum number of elements to
> + print, and is passed through to each element that we print. */
> + const struct value_print_options *m_options = nullptr;
> +};
>
> -/* This function gets called to print an F77 array, we set up some
> - stuff and then immediately call f77_print_array_1(). */
> +/* This function gets called to print a Fortran array. */
>
> static void
> -f77_print_array (struct type *type, const gdb_byte *valaddr,
> - int embedded_offset,
> - CORE_ADDR address, struct ui_file *stream,
> - int recurse,
> - const struct value *val,
> - const struct value_print_options *options)
> +fortran_print_array (struct type *type, CORE_ADDR address,
> + struct ui_file *stream, int recurse,
> + const struct value *val,
> + const struct value_print_options *options)
> {
> - int ndimensions;
> - int elts = 0;
> -
> - ndimensions = calc_f77_array_dims (type);
> -
> - if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
> - error (_("\
> -Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
> - ndimensions, MAX_FORTRAN_DIMS);
> -
> - f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
> - address, stream, recurse, val, options, &elts);
> + fortran_array_walker<fortran_array_printer_impl> p
> + (type, address, (struct value *) val, stream, recurse, options);
> + p.walk ();
> }
> \f
>
> @@ -237,12 +241,7 @@ f_language::value_print_inner (struct value *val, struct ui_file *stream,
>
> case TYPE_CODE_ARRAY:
> if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR)
> - {
> - fprintf_filtered (stream, "(");
> - f77_print_array (type, valaddr, 0,
> - address, stream, recurse, val, options);
> - fprintf_filtered (stream, ")");
> - }
> + fortran_print_array (type, address, stream, recurse, val, options);
> else
> {
> struct type *ch_type = TYPE_TARGET_TYPE (type);
> diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
> index 0940fa597fb..6a4037dd077 100644
> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
> @@ -39,6 +39,7 @@
> #include "dwarf2/loc.h"
> #include "gdbcore.h"
> #include "floatformat.h"
> +#include "f-lang.h"
> #include <algorithm>
>
> /* Initialize BADNESS constants. */
> @@ -2627,7 +2628,16 @@ resolve_dynamic_type_internal (struct type *type,
> prop = TYPE_DATA_LOCATION (resolved_type);
> if (prop != NULL
> && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> - prop->set_const_val (value);
> + {
> + /* Start of Fortran hack. See comment in f-lang.h for what is going
> + on here.*/
> + if (current_language->la_language == language_fortran
> + && resolved_type->code () == TYPE_CODE_ARRAY)
> + value = fortran_adjust_dynamic_array_base_address_hack (resolved_type,
> + value);
> + /* End of Fortran hack. */
> + prop->set_const_val (value);
> + }
>
> return resolved_type;
> }
> diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
> new file mode 100644
> index 00000000000..2583cdecc94
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp
> @@ -0,0 +1,69 @@
> +# Copyright 2020 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/> .
> +
> +# Test invalid element and slice array accesses.
> +
> +if {[skip_fortran_tests]} { return -1 }
> +
> +standard_testfile ".f90"
> +load_lib fortran.exp
> +
> +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
> + {debug f90}]} {
> + return -1
> +}
> +
> +if ![fortran_runto_main] {
> + untested "could not run to main"
> + return -1
> +}
> +
> +# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
> +gdb_breakpoint [gdb_get_line_number "First Breakpoint"]
> +gdb_breakpoint [gdb_get_line_number "Second Breakpoint"]
> +gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
> +
> +gdb_continue_to_breakpoint "First Breakpoint"
> +
> +# Access not yet allocated array.
> +gdb_test "print other" " = <not allocated>"
> +gdb_test "print other(0:4,2:3)" "array not allocated"
> +gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)"
> +
> +# Access not yet associated pointer.
> +gdb_test "print pointer2d" " = <not associated>"
> +gdb_test "print pointer2d(1:2,1:2)" "array not associated"
> +gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)"
> +
> +gdb_continue_to_breakpoint "Second Breakpoint"
> +
> +# Accessing just outside the arrays.
> +foreach name {array pointer2d other} {
> + gdb_test "print $name (0:,:)" "array subscript out of bounds"
> + gdb_test "print $name (:11,:)" "array subscript out of bounds"
> + gdb_test "print $name (:,0:)" "array subscript out of bounds"
> + gdb_test "print $name (:,:11)" "array subscript out of bounds"
> +
> + gdb_test "print $name (0,:)" "no such vector element"
> + gdb_test "print $name (11,:)" "no such vector element"
> + gdb_test "print $name (:,0)" "no such vector element"
> + gdb_test "print $name (:,11)" "no such vector element"
> +}
> +
> +# Stride in the wrong direction.
> +gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination"
> +gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination"
> +gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination"
> +gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination"
> diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
> new file mode 100644
> index 00000000000..0f3d45ab8cd
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90
> @@ -0,0 +1,42 @@
> +! Copyright 2020 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/>.
> +
> +!
> +! Start of test program.
> +!
> +program test
> +
> + ! Declare variables used in this test.
> + integer, dimension (1:10,1:10) :: array
> + integer, allocatable :: other (:, :)
> + integer, dimension(:,:), pointer :: pointer2d => null()
> + integer, dimension(1:10,1:10), target :: tarray
> +
> + print *, "" ! First Breakpoint.
> +
> + ! Allocate or associate any variables as needed.
> + allocate (other (1:10, 1:10))
> + pointer2d => tarray
> + array = 0
> +
> + print *, "" ! Second Breakpoint.
> +
> + ! All done. Deallocate.
> + deallocate (other)
> +
> + ! GDB catches this final breakpoint to indicate the end of the test.
> + print *, "" ! Final Breakpoint.
> +
> +end program test
> diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
> new file mode 100644
> index 00000000000..05b4802c678
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp
> @@ -0,0 +1,111 @@
> +# Copyright 2020 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/> .
> +
> +# Create a slice of an array, then take a slice of that slice.
> +
> +if {[skip_fortran_tests]} { return -1 }
> +
> +standard_testfile ".f90"
> +load_lib fortran.exp
> +
> +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
> + {debug f90}]} {
> + return -1
> +}
> +
> +if ![fortran_runto_main] {
> + untested "could not run to main"
> + return -1
> +}
> +
> +# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
> +gdb_breakpoint [gdb_get_line_number "Stop Here"]
> +gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
> +
> +# We're going to print some reasonably large arrays.
> +gdb_test_no_output "set print elements unlimited"
> +
> +gdb_continue_to_breakpoint "Stop Here"
> +
> +# Print a slice, capture the convenience variable name created.
> +set cmd "print array (1:10:2, 1:10:2)"
> +gdb_test_multiple $cmd $cmd {
> + -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" {
> + set varname "\$$expect_out(1,string)"
> + }
> +}
> +
> +# Now check that we can correctly extract all the elements from this
> +# slice.
> +for { set j 1 } { $j < 6 } { incr j } {
> + for { set i 1 } { $i < 6 } { incr i } {
> + set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1]
> + gdb_test "print ${varname} ($i,$j)" " = $val"
> + }
> +}
> +
> +# Now take a slice of the slice.
> +gdb_test "print ${varname} (3:5, 3:5)" \
> + " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)"
> +
> +# Now take a different slice of a slice.
> +set cmd "print ${varname} (1:5:2, 1:5:2)"
> +gdb_test_multiple $cmd $cmd {
> + -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" {
> + set varname "\$$expect_out(1,string)"
> + pass $gdb_test_name
> + }
> +}
> +
> +# Now take a slice from the slice, of a slice!
> +set cmd "print ${varname} (1:3:2, 1:3:2)"
> +gdb_test_multiple $cmd $cmd {
> + -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" {
> + set varname "\$$expect_out(1,string)"
> + pass $gdb_test_name
> + }
> +}
> +
> +# And again!
> +set cmd "print ${varname} (1:2:2, 1:2:2)"
> +gdb_test_multiple $cmd $cmd {
> + -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" {
> + set varname "\$$expect_out(1,string)"
> + pass $gdb_test_name
> + }
> +}
> +
> +# Test taking a slice with stride of a string. This isn't actually
> +# supported within gfortran (at least), but naturally drops out of how
> +# GDB models arrays and strings in a similar way, so we may as well
> +# test that this is still working.
> +gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'"
> +gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'"
> +gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'"
> +
> +# Now test the memory requirements of taking a slice from an array.
> +# The idea is that we shouldn't require more memory to extract a slice
> +# than the size of the slice.
> +#
> +# This will only work if array repacking is turned on, otherwise GDB
> +# will create the slice by generating a new type that sits over the
> +# existing value in memory.
> +gdb_test_no_output "set fortran repack-array-slices on"
> +set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"]
> +set slice_size [expr $element_size * 4]
> +gdb_test_no_output "set max-value-size $slice_size"
> +gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)"
> +gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)"
> +gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)"
> diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
> new file mode 100644
> index 00000000000..c3530f567d4
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90
> @@ -0,0 +1,96 @@
> +! Copyright 2020 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/>.
> +
> +!
> +! Start of test program.
> +!
> +program test
> + integer, dimension (1:10,1:11) :: array
> + character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz"
> +
> + call fill_array_2d (array)
> +
> + ! GDB catches this final breakpoint to indicate the end of the test.
> + print *, "" ! Stop Here
> +
> + print *, array
> + print *, str
> +
> + ! GDB catches this final breakpoint to indicate the end of the test.
> + print *, "" ! Final Breakpoint.
> +
> +contains
> +
> + ! Fill a 1D array with a unique positive integer in each element.
> + subroutine fill_array_1d (array)
> + integer, dimension (:) :: array
> + integer :: counter
> +
> + counter = 1
> + do j=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (j) = counter
> + counter = counter + 1
> + end do
> + end subroutine fill_array_1d
> +
> + ! Fill a 2D array with a unique positive integer in each element.
> + subroutine fill_array_2d (array)
> + integer, dimension (:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 2), UBOUND (array, 2), 1
> + do j=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end subroutine fill_array_2d
> +
> + ! Fill a 3D array with a unique positive integer in each element.
> + subroutine fill_array_3d (array)
> + integer, dimension (:,:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 3), UBOUND (array, 3), 1
> + do j=LBOUND (array, 2), UBOUND (array, 2), 1
> + do k=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (k, j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end do
> + end subroutine fill_array_3d
> +
> + ! Fill a 4D array with a unique positive integer in each element.
> + subroutine fill_array_4d (array)
> + integer, dimension (:,:,:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 4), UBOUND (array, 4), 1
> + do j=LBOUND (array, 3), UBOUND (array, 3), 1
> + do k=LBOUND (array, 2), UBOUND (array, 2), 1
> + do l=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (l, k, j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end do
> + end do
> + print *, ""
> + end subroutine fill_array_4d
> +end program test
> diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
> index aa6bc6327eb..ff00fae886f 100644
> --- a/gdb/testsuite/gdb.fortran/array-slices.exp
> +++ b/gdb/testsuite/gdb.fortran/array-slices.exp
> @@ -18,6 +18,21 @@
> # the subroutine. This should exercise GDB's ability to handle
> # different strides for the different dimensions.
>
> +# Testing GDB's ability to print array (and string) slices, including
> +# slices that make use of array strides.
> +#
> +# In the Fortran code various arrays of different ranks are filled
> +# with data, and slices are passed to a series of show functions.
> +#
> +# In this test script we break in each of the show functions, print
> +# the array slice that was passed in, and then move up the stack to
> +# the parent frame and check GDB can manually extract the same slice.
> +#
> +# This test also checks that the size of the array slice passed to the
> +# function (so as extracted and described by the compiler and the
> +# debug information) matches the size of the slice manually extracted
> +# by GDB.
> +
> if {[skip_fortran_tests]} { return -1 }
>
> standard_testfile ".f90"
> @@ -28,60 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
> return -1
> }
>
> -if ![fortran_runto_main] {
> - untested "could not run to main"
> - return -1
> +# Takes the name of an array slice as used in the test source, and extracts
> +# the base array name. For example: 'array (1,2)' becomes 'array'.
> +proc array_slice_to_var { slice_str } {
> + regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname
> + return $varname
> }
>
> -gdb_breakpoint "show"
> -gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
> -
> -set array_contents \
> - [list \
> - " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \
> - " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \
> - " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \
> - " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \
> - " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \
> - " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \
> - " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \
> - " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ]
> -
> -set message_strings \
> - [list \
> - " = 'array'" \
> - " = 'array \\(1:5,1:5\\)'" \
> - " = 'array \\(1:10:2,1:10:2\\)'" \
> - " = 'array \\(1:10:3,1:10:2\\)'" \
> - " = 'array \\(1:10:5,1:10:3\\)'" \
> - " = 'other'" \
> - " = 'other \\(-5:0, -2:0\\)'" \
> - " = 'other \\(-5:4:2, -2:7:3\\)'" ]
> -
> -set i 0
> -foreach result $array_contents msg $message_strings {
> - incr i
> - with_test_prefix "test $i" {
> - gdb_continue_to_breakpoint "show"
> - gdb_test "p array" $result
> - gdb_test "p message" "$msg"
> +proc run_test { repack } {
> + global binfile gdb_prompt
> +
> + clean_restart ${binfile}
> +
> + if ![fortran_runto_main] {
> + untested "could not run to main"
> + return -1
> }
> -}
>
> -gdb_continue_to_breakpoint "continue to Final Breakpoint"
> + gdb_test_no_output "set fortran repack-array-slices $repack"
> +
> + # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"]
> + gdb_breakpoint [gdb_get_line_number "Display Element"]
> + gdb_breakpoint [gdb_get_line_number "Display String"]
> + gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"]
> + gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"]
> + gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"]
> + gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"]
> + gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
> +
> + # We're going to print some reasonably large arrays.
> + gdb_test_no_output "set print elements unlimited"
> +
> + set found_final_breakpoint false
> +
> + # We place a limit on the number of tests that can be run, just in
> + # case something goes wrong, and GDB gets stuck in an loop here.
> + set test_count 0
> + while { $test_count < 500 } {
> + with_test_prefix "test $test_count" {
> + incr test_count
> +
> + set found_final_breakpoint false
> + set expected_result ""
> + set func_name ""
> + gdb_test_multiple "continue" "continue" {
> + -re ".*GDB = (\[^\r\n\]+)\r\n" {
> + set expected_result $expect_out(1,string)
> + exp_continue
> + }
> + -re "! Display Element" {
> + set func_name "show_elem"
> + exp_continue
> + }
> + -re "! Display String" {
> + set func_name "show_str"
> + exp_continue
> + }
> + -re "! Display Array Slice (.)D" {
> + set func_name "show_$expect_out(1,string)d"
> + exp_continue
> + }
> + -re "! Final Breakpoint" {
> + set found_final_breakpoint true
> + exp_continue
> + }
> + -re "$gdb_prompt $" {
> + # We're done.
> + }
> + }
>
> -# Next test that asking for an array with stride at the CLI gives an
> -# error.
> -clean_restart ${testfile}
> + if ($found_final_breakpoint) {
> + break
> + }
>
> -if ![fortran_runto_main] then {
> - perror "couldn't run to main"
> - continue
> + # We want to take a look at the line in the previous frame that
> + # called the current function. I couldn't find a better way of
> + # doing this than 'up', which will print the line, then 'down'
> + # again.
> + #
> + # I don't want to fill the log with passes for these up/down
> + # commands, so we don't report any. If something goes wrong then we
> + # should get a fail from gdb_test_multiple.
> + set array_slice_name ""
> + set unique_id ""
> + array unset replacement_vars
> + array set replacement_vars {}
> + gdb_test_multiple "up" "up" {
> + -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" {
> + set array_slice_name $expect_out(1,string)
> + }
> + -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" {
> + set array_slice_name $expect_out(1,string)
> + set unique_id $expect_out(2,string)
> + }
> + }
> + if {$unique_id != ""} {
> + set str ""
> + foreach v [split $unique_id ,] {
> + set val [get_integer_valueof "${v}" "??"\
> + "get variable '$v' for '$array_slice_name'"]
> + set replacement_vars($v) $val
> + if {$str != ""} {
> + set str "Str,"
> + }
> + set str "$str$v=$val"
> + }
> + set unique_id " $str"
> + }
> + gdb_test_multiple "down" "down" {
> + -re "\r\n$gdb_prompt $" {
> + # Don't issue a pass here.
> + }
> + }
> +
> + # Check we have all the information we need to successfully run one
> + # of these tests.
> + if { $expected_result == "" } {
> + perror "failed to extract expected results"
> + return 0
> + }
> + if { $array_slice_name == "" } {
> + perror "failed to extract array slice name"
> + return 0
> + }
> +
> + # Check GDB can correctly print the array slice that was passed into
> + # the current frame.
> + set pattern [string_to_regexp " = $expected_result"]
> + gdb_test "p array" "$pattern" \
> + "check value of '$array_slice_name'$unique_id"
> +
> + # Get the size of the slice.
> + set size_in_show \
> + [get_integer_valueof "sizeof (array)" "show_unknown" \
> + "get sizeof '$array_slice_name'$unique_id in show"]
> + set addr_in_show \
> + [get_hexadecimal_valueof "&array" "show_unknown" \
> + "get address '$array_slice_name'$unique_id in show"]
> +
> + # Now move into the previous frame, and see if GDB can extract the
> + # array slice from the original parent object. Again, use of
> + # gdb_test_multiple to avoid filling the logs with unnecessary
> + # passes.
> + gdb_test_multiple "up" "up" {
> + -re "\r\n$gdb_prompt $" {
> + # Do nothing.
> + }
> + }
> +
> + # Print the array slice, this will force GDB to manually extract the
> + # slice from the parent array.
> + gdb_test "p $array_slice_name" "$pattern" \
> + "check array slice '$array_slice_name'$unique_id can be extracted"
> +
> + # Get the size of the slice in the calling frame.
> + set size_in_parent \
> + [get_integer_valueof "sizeof ($array_slice_name)" \
> + "parent_unknown" \
> + "get sizeof '$array_slice_name'$unique_id in parent"]
> +
> + # Figure out the start and end addresses of the full array in the
> + # parent frame.
> + set full_var_name [array_slice_to_var $array_slice_name]
> + set start_addr [get_hexadecimal_valueof "&${full_var_name}" \
> + "start unknown"]
> + set end_addr [get_hexadecimal_valueof \
> + "(&${full_var_name}) + sizeof (${full_var_name})" \
> + "end unknown"]
> +
> + # The Fortran compiler can choose to either send a descriptor that
> + # describes the array slice to the subroutine, or it can repack the
> + # slice into an array section and send that.
> + #
> + # We find the address range of the original array in the parent,
> + # and the address of the slice in the show function, if the
> + # address of the slice (from show) is in the range of the original
> + # array then repacking has not occurred, otherwise, the slice is
> + # outside of the parent, and repacking must have occurred.
> + #
> + # The goal here is to compare the sizes of the slice in show with
> + # the size of the slice extracted by GDB. So we can only compare
> + # sizes when GDB's repacking setting matches the repacking
> + # behaviour we got from the compiler.
> + if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \
> + == ($repack == "on") } {
> + gdb_assert {$size_in_show == $size_in_parent} \
> + "check sizes match"
> + } elseif { $repack == "off" } {
> + # GDB's repacking is off (so slices are left unpacked), but
> + # the compiler did pack this one. As a result we can't
> + # compare the sizes between the compiler's slice and GDB's
> + # slice.
> + verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared"
> + } else {
> + # Like the above, but the reverse, GDB's repacking is on, but
> + # the compiler didn't repack this slice.
> + verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared"
> + }
> +
> + # If the array name we just tested included variable names, then
> + # test again with all the variables expanded.
> + if {$unique_id != ""} {
> + foreach v [array names replacement_vars] {
> + set val $replacement_vars($v)
> + set array_slice_name \
> + [regsub "\\y${v}\\y" $array_slice_name $val]
> + }
> + gdb_test "p $array_slice_name" "$pattern" \
> + "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded"
> + }
> + }
> + }
> +
> + # Ensure we reached the final breakpoint. If more tests have been added
> + # to the test script, and this starts failing, then the safety 'while'
> + # loop above might need to be increased.
> + gdb_assert {$found_final_breakpoint} "ran all tests"
> }
>
> -gdb_breakpoint "show"
> -gdb_continue_to_breakpoint "show"
> -gdb_test "up" ".*"
> -gdb_test "p array (1:10:2, 1:10:2)" \
> - "Fortran array strides are not currently supported" \
> - "using array stride gives an error"
> +foreach_with_prefix repack { on off } {
> + run_test $repack
> +}
> diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
> index a66fa6ba784..6d75a385699 100644
> --- a/gdb/testsuite/gdb.fortran/array-slices.f90
> +++ b/gdb/testsuite/gdb.fortran/array-slices.f90
> @@ -13,58 +13,368 @@
> ! 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 show (message, array)
> - character (len=*) :: message
> +subroutine show_elem (array)
> + integer :: array
> +
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
> +
> + write(*, fmt="(A)", advance="no") "GDB = "
> + write(*, fmt="(I0)", advance="no") array
> + write(*, fmt="(A)", advance="yes") ""
> +
> + print *, "" ! Display Element
> +end subroutine show_elem
> +
> +subroutine show_str (array)
> + character (len=*) :: array
> +
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
> + write (*, fmt="(A)", advance="no") "GDB = '"
> + write (*, fmt="(A)", advance="no") array
> + write (*, fmt="(A)", advance="yes") "'"
> +
> + print *, "" ! Display String
> +end subroutine show_str
> +
> +subroutine show_1d (array)
> + integer, dimension (:) :: array
> +
> + print *, "Array Contents:"
> + print *, ""
> +
> + do i=LBOUND (array, 1), UBOUND (array, 1), 1
> + write(*, fmt="(i4)", advance="no") array (i)
> + end do
> +
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
> +
> + write(*, fmt="(A)", advance="no") "GDB = ("
> + do i=LBOUND (array, 1), UBOUND (array, 1), 1
> + if (i > LBOUND (array, 1)) then
> + write(*, fmt="(A)", advance="no") ", "
> + end if
> + write(*, fmt="(I0)", advance="no") array (i)
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> +
> + print *, "" ! Display Array Slice 1D
> +end subroutine show_1d
> +
> +subroutine show_2d (array)
> integer, dimension (:,:) :: array
>
> - print *, message
> + print *, "Array Contents:"
> + print *, ""
> +
> do i=LBOUND (array, 2), UBOUND (array, 2), 1
> do j=LBOUND (array, 1), UBOUND (array, 1), 1
> write(*, fmt="(i4)", advance="no") array (j, i)
> end do
> print *, ""
> - end do
> - print *, array
> - print *, ""
> + end do
>
> -end subroutine show
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
>
> -program test
> + write(*, fmt="(A)", advance="no") "GDB = ("
> + do i=LBOUND (array, 2), UBOUND (array, 2), 1
> + if (i > LBOUND (array, 2)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> + do j=LBOUND (array, 1), UBOUND (array, 1), 1
> + if (j > LBOUND (array, 1)) then
> + write(*, fmt="(A)", advance="no") ", "
> + end if
> + write(*, fmt="(I0)", advance="no") array (j, i)
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="yes") ")"
> +
> + print *, "" ! Display Array Slice 2D
> +end subroutine show_2d
> +
> +subroutine show_3d (array)
> + integer, dimension (:,:,:) :: array
> +
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
> +
> + write(*, fmt="(A)", advance="no") "GDB = ("
> + do i=LBOUND (array, 3), UBOUND (array, 3), 1
> + if (i > LBOUND (array, 3)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> + do j=LBOUND (array, 2), UBOUND (array, 2), 1
> + if (j > LBOUND (array, 2)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> + do k=LBOUND (array, 1), UBOUND (array, 1), 1
> + if (k > LBOUND (array, 1)) then
> + write(*, fmt="(A)", advance="no") ", "
> + end if
> + write(*, fmt="(I0)", advance="no") array (k, j, i)
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="yes") ")"
> +
> + print *, "" ! Display Array Slice 3D
> +end subroutine show_3d
> +
> +subroutine show_4d (array)
> + integer, dimension (:,:,:,:) :: array
> +
> + print *, ""
> + print *, "Expected GDB Output:"
> + print *, ""
> +
> + write(*, fmt="(A)", advance="no") "GDB = ("
> + do i=LBOUND (array, 4), UBOUND (array, 4), 1
> + if (i > LBOUND (array, 4)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> + do j=LBOUND (array, 3), UBOUND (array, 3), 1
> + if (j > LBOUND (array, 3)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> +
> + do k=LBOUND (array, 2), UBOUND (array, 2), 1
> + if (k > LBOUND (array, 2)) then
> + write(*, fmt="(A)", advance="no") " "
> + end if
> + write(*, fmt="(A)", advance="no") "("
> + do l=LBOUND (array, 1), UBOUND (array, 1), 1
> + if (l > LBOUND (array, 1)) then
> + write(*, fmt="(A)", advance="no") ", "
> + end if
> + write(*, fmt="(I0)", advance="no") array (l, k, j, i)
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="no") ")"
> + end do
> + write(*, fmt="(A)", advance="yes") ")"
> +
> + print *, "" ! Display Array Slice 4D
> +end subroutine show_4d
>
> +!
> +! Start of test program.
> +!
> +program test
> interface
> - subroutine show (message, array)
> - character (len=*) :: message
> + subroutine show_str (array)
> + character (len=*) :: array
> + end subroutine show_str
> +
> + subroutine show_1d (array)
> + integer, dimension (:) :: array
> + end subroutine show_1d
> +
> + subroutine show_2d (array)
> integer, dimension(:,:) :: array
> - end subroutine show
> + end subroutine show_2d
> +
> + subroutine show_3d (array)
> + integer, dimension(:,:,:) :: array
> + end subroutine show_3d
> +
> + subroutine show_4d (array)
> + integer, dimension(:,:,:,:) :: array
> + end subroutine show_4d
> end interface
>
> + ! Declare variables used in this test.
> + integer, dimension (-10:-1,-10:-2) :: neg_array
> integer, dimension (1:10,1:10) :: array
> integer, allocatable :: other (:, :)
> + character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz"
> + integer, dimension (-2:2,-2:2,-2:2) :: array3d
> + integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d
> + integer, dimension (10:20) :: array1d
> + integer, dimension(:,:), pointer :: pointer2d => null()
> + integer, dimension(-1:9,-1:9), target :: tarray
>
> + ! Allocate or associate any variables as needed.
> allocate (other (-5:4, -2:7))
> + pointer2d => tarray
>
> - do i=LBOUND (array, 2), UBOUND (array, 2), 1
> - do j=LBOUND (array, 1), UBOUND (array, 1), 1
> - array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
> - end do
> - end do
> + ! Fill arrays with contents ready for testing.
> + call fill_array_1d (array1d)
> +
> + call fill_array_2d (neg_array)
> + call fill_array_2d (array)
> + call fill_array_2d (other)
> + call fill_array_2d (tarray)
> +
> + call fill_array_3d (array3d)
> + call fill_array_4d (array4d)
> +
> + ! The tests. Each call to a show_* function must have a unique set
> + ! of arguments as GDB uses the arguments are part of the test name
> + ! string, so duplicate arguments will result in duplicate test
> + ! names.
> + !
> + ! If a show_* line ends with VARS=... where '...' is a comma
> + ! separated list of variable names, these variables are assumed to
> + ! be part of the call line, and will be expanded by the test script,
> + ! for example:
> + !
> + ! do x=1,9,1
> + ! do y=x,10,1
> + ! call show_1d (some_array (x,y)) ! VARS=x,y
> + ! end do
> + ! end do
> + !
> + ! In this example the test script will automatically expand 'x' and
> + ! 'y' in order to better test different aspects of GDB. Do take
> + ! care, the expansion is not very "smart", so try to avoid clashing
> + ! with other text on the line, in the example above, avoid variables
> + ! named 'some' or 'array', as these will likely clash with
> + ! 'some_array'.
> + call show_str (str_1)
> + call show_str (str_1 (1:20))
> + call show_str (str_1 (10:20))
>
> - do i=LBOUND (other, 2), UBOUND (other, 2), 1
> - do j=LBOUND (other, 1), UBOUND (other, 1), 1
> - other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
> + call show_elem (array1d (11))
> + call show_elem (pointer2d (2,3))
> +
> + call show_1d (array1d)
> + call show_1d (array1d (13:17))
> + call show_1d (array1d (17:13:-1))
> + call show_1d (array (1:5,1))
> + call show_1d (array4d (1,7,3,:))
> + call show_1d (pointer2d (-1:3, 2))
> + call show_1d (pointer2d (-1, 2:4))
> +
> + ! Enclosing the array slice argument in (...) causess gfortran to
> + ! repack the array.
> + call show_1d ((array (1:5,1)))
> +
> + call show_2d (pointer2d)
> + call show_2d (array)
> + call show_2d (array (1:5,1:5))
> + do i=1,10,2
> + do j=1,10,3
> + call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j
> + call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j
> + call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j
> + call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j
> end do
> end do
> + call show_2d (array (6:2:-1,3:9))
> + call show_2d (array (1:10:2, 1:10:2))
> + call show_2d (other)
> + call show_2d (other (-5:0, -2:0))
> + call show_2d (other (-5:4:2, -2:7:3))
> + call show_2d (neg_array)
> + call show_2d (neg_array (-10:-3,-8:-4:2))
> +
> + ! Enclosing the array slice argument in (...) causess gfortran to
> + ! repack the array.
> + call show_2d ((array (1:10:3, 1:10:2)))
> + call show_2d ((neg_array (-10:-3,-8:-4:2)))
>
> - call show ("array", array)
> - call show ("array (1:5,1:5)", array (1:5,1:5))
> - call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
> - call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
> - call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
> + call show_3d (array3d)
> + call show_3d (array3d(-1:1,-1:1,-1:1))
> + call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1))
>
> - call show ("other", other)
> - call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
> - call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
> + ! Enclosing the array slice argument in (...) causess gfortran to
> + ! repack the array.
> + call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1)))
>
> + call show_4d (array4d)
> + call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1))
> + call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1))
> +
> + ! Enclosing the array slice argument in (...) causess gfortran to
> + ! repack the array.
> + call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1)))
> +
> + ! All done. Deallocate.
> deallocate (other)
> +
> + ! GDB catches this final breakpoint to indicate the end of the test.
> print *, "" ! Final Breakpoint.
> +
> +contains
> +
> + ! Fill a 1D array with a unique positive integer in each element.
> + subroutine fill_array_1d (array)
> + integer, dimension (:) :: array
> + integer :: counter
> +
> + counter = 1
> + do j=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (j) = counter
> + counter = counter + 1
> + end do
> + end subroutine fill_array_1d
> +
> + ! Fill a 2D array with a unique positive integer in each element.
> + subroutine fill_array_2d (array)
> + integer, dimension (:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 2), UBOUND (array, 2), 1
> + do j=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end subroutine fill_array_2d
> +
> + ! Fill a 3D array with a unique positive integer in each element.
> + subroutine fill_array_3d (array)
> + integer, dimension (:,:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 3), UBOUND (array, 3), 1
> + do j=LBOUND (array, 2), UBOUND (array, 2), 1
> + do k=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (k, j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end do
> + end subroutine fill_array_3d
> +
> + ! Fill a 4D array with a unique positive integer in each element.
> + subroutine fill_array_4d (array)
> + integer, dimension (:,:,:,:) :: array
> + integer :: counter
> +
> + counter = 1
> + do i=LBOUND (array, 4), UBOUND (array, 4), 1
> + do j=LBOUND (array, 3), UBOUND (array, 3), 1
> + do k=LBOUND (array, 2), UBOUND (array, 2), 1
> + do l=LBOUND (array, 1), UBOUND (array, 1), 1
> + array (l, k, j,i) = counter
> + counter = counter + 1
> + end do
> + end do
> + end do
> + end do
> + print *, ""
> + end subroutine fill_array_4d
> end program test
> diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
> index 04296ac80c9..0ab74fbbe90 100644
> --- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
> +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
> @@ -44,7 +44,7 @@ gdb_continue_to_breakpoint "vla1-allocated"
> gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
> gdb_test "print sizeof(vla1(3,2,1))" "4" \
> "print sizeof element from allocated vla1"
> -gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
> +gdb_test "print sizeof(vla1(3:4,2,1))" "8" \
> "print sizeof sliced vla1"
>
> # Try to access values in undefined pointer to VLA (dangling)
> @@ -61,7 +61,7 @@ gdb_continue_to_breakpoint "pvla-associated"
> gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
> gdb_test "print sizeof(pvla(3,2,1))" "4" \
> "print sizeof element from associated pvla"
> -gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
> +gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla"
>
> gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
> gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
> --
> 2.25.4
>
^ permalink raw reply [flat|nested] 62+ messages in thread
end of thread, other threads:[~2020-11-19 11:56 UTC | newest]
Thread overview: 62+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-08-13 12:58 [PATCH 0/8] Fortran Array Slicing and Striding Support Andrew Burgess
2020-08-13 12:58 ` [PATCH 1/8] gdbsupport: Provide global operators |=, &=, and ^= for enum bit flags Andrew Burgess
2020-08-15 17:16 ` Tom Tromey
2020-08-16 9:13 ` Andrew Burgess
2020-08-17 10:40 ` Andrew Burgess
2020-08-20 16:00 ` Pedro Alves
2020-08-21 14:49 ` Pedro Alves
2020-08-21 15:57 ` Andrew Burgess
2020-08-21 18:10 ` Pedro Alves
2020-08-13 12:58 ` [PATCH 2/8] gdbsupport: Make function arguments constant in enum-flags.h Andrew Burgess
2020-08-15 19:45 ` Tom Tromey
2020-08-16 9:08 ` Andrew Burgess
2020-08-13 12:58 ` [PATCH 3/8] gdb/fortran: Clean up array/string expression evaluation Andrew Burgess
2020-08-13 12:58 ` [PATCH 4/8] gdb/fortran: Move Fortran expression handling into f-lang.c Andrew Burgess
2020-08-13 12:58 ` [PATCH 5/8] gdb/fortran: Change whitespace when printing arrays Andrew Burgess
2020-08-13 12:58 ` [PATCH 6/8] gdb: Convert enum range_type to a bit field enum Andrew Burgess
2020-08-13 12:58 ` [PATCH 7/8] gdb/testsuite: Add missing expected results Andrew Burgess
2020-08-13 12:58 ` [PATCH 8/8] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-08-13 13:31 ` Eli Zaretskii
2020-08-26 14:49 ` [PATCHv2 00/10] Fortran Array Slicing and Striding Support Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 01/10] Rewrite valid-expr.h's internals in terms of the detection idiom (C++17/N4502) Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 02/10] Use type_instance_flags more throughout Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 03/10] Rewrite enum_flags, add unit tests, fix problems Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 04/10] gdb: additional changes to make use of type_instance_flags more Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 05/10] gdb/fortran: Clean up array/string expression evaluation Andrew Burgess
2020-09-19 8:53 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 06/10] gdb/fortran: Move Fortran expression handling into f-lang.c Andrew Burgess
2020-09-19 8:53 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 07/10] gdb/fortran: Change whitespace when printing arrays Andrew Burgess
2020-09-19 8:54 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 08/10] gdb: Convert enum range_type to a bit field enum Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 09/10] gdb/testsuite: Add missing expected results Andrew Burgess
2020-09-18 9:53 ` Andrew Burgess
2020-08-26 14:49 ` [PATCHv2 10/10] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-08-26 17:02 ` Eli Zaretskii
2020-09-19 9:47 ` [PATCHv3 0/2] Fortran Array Slicing and Striding Support Andrew Burgess
2020-09-19 9:48 ` [PATCHv3 1/2] gdb: Convert enum range_type to a bit field enum Andrew Burgess
2020-09-19 13:50 ` Simon Marchi
2020-09-19 9:48 ` [PATCHv3 2/2] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-09-19 10:03 ` Eli Zaretskii
2020-09-28 9:40 ` [PATCHv4 0/3] Fortran Array Slicing and Striding Support Andrew Burgess
2020-09-28 9:40 ` [PATCHv4 1/3] gdb: Convert enum range_type to a bit field enum Andrew Burgess
2020-09-28 9:40 ` [PATCHv4 2/3] gdb: rename 'enum range_type' to 'enum range_flag' Andrew Burgess
2020-09-28 9:40 ` [PATCHv4 3/3] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-09-28 9:52 ` Eli Zaretskii
2020-10-11 18:12 ` [PATCHv5 0/4] Fortran Array Slicing and Striding Support Andrew Burgess
2020-10-11 18:12 ` [PATCHv5 1/4] gdb: Convert enum range_type to a bit field enum Andrew Burgess
2020-10-20 20:16 ` Tom Tromey
2020-10-11 18:12 ` [PATCHv5 2/4] gdb: rename 'enum range_type' to 'enum range_flag' Andrew Burgess
2020-10-20 20:16 ` Tom Tromey
2020-10-11 18:12 ` [PATCHv5 3/4] gdb/fortran: add support for parsing array strides in expressions Andrew Burgess
2020-10-12 13:21 ` Simon Marchi
2020-10-20 20:17 ` Tom Tromey
2020-10-22 10:42 ` Andrew Burgess
2020-10-11 18:12 ` [PATCHv5 4/4] gdb/fortran: Add support for Fortran array slices at the GDB prompt Andrew Burgess
2020-10-12 14:10 ` Simon Marchi
2020-10-20 20:45 ` Tom Tromey
2020-10-29 11:08 ` Andrew Burgess
2020-10-31 22:16 ` [PATCHv6] " Andrew Burgess
2020-11-12 12:09 ` Andrew Burgess
2020-11-12 18:58 ` Tom Tromey
2020-11-19 11:56 ` Andrew Burgess
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).