[v2] Logical short circuiting with argument lists
Commit Message
When evaluating Fortran expressions such as the following:
print truth_table(1,1) .OR. truth_table(2,1)
where truth_table(1,1) evaluates to true, the debugger would report that
it could not perform substring operations on this type. This patch
addresses this issue.
Investigation revealed that EVAL_SKIP was not being handled correctly
for all types serviced by the OP_F77_UNDETERMINED_ARGLIST case in
evaluate_subexp_standard. While skipping an undetermined argument list
the type is resolved to be an integer (as this is what evaluate_subexp
returns when skipping) and so it was not possible to delegate to the
appropriate case (e.g. array, function call).
The solution implemented here updates OP_VAR_VALUE to return correct
type information when skipping. This way OP_F77_UNDETERMINED_ARGLIST
can delegate the skipping to the appropriate case or routine, which
should know how to skip/evaluate the type in question.
koenig.exp was updated to include a testcase which exercises the
modified skip logic in OP_VAR_VALUE, as it falls through from
OP_ADL_FUNC.
This patch has been tested for regression with GCC 7.3 on aarch64,
ppc64le and x86_64.
2018-08-13 Richard Bunt <richard.bunt@arm.com>
Chris January <chris.january@arm.com>
* eval.c (skip_undetermined_arglist): Skip argument list helper.
(evaluate_subexp_standard): Return a dummy type when
honoring EVAL_SKIP in OP_VAR_VALUE and handle skipping in the
OP_F77_UNDETERMINED_ARGLIST case.
* expression.h (enum noside): Update comment.
gdb/testsuite/ChangeLog:
2018-08-13 Richard Bunt <richard.bunt@arm.com>
Chris January <chris.january@arm.com>
* gdb.cp/koenig.exp: Extend to test logical short circuiting.
* gdb.fortran/short-circuit-argument-list.exp: New file.
* gdb.fortran/short-circuit-argument-list.f90: New test.
---
gdb/eval.c | 42 ++++++--
gdb/expression.h | 4 +-
gdb/testsuite/gdb.cp/koenig.exp | 3 +
.../gdb.fortran/short-circuit-argument-list.exp | 109 +++++++++++++++++++++
.../gdb.fortran/short-circuit-argument-list.f90 | 78 +++++++++++++++
5 files changed, 229 insertions(+), 7 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/short-circuit-argument-list.exp
create mode 100644 gdb/testsuite/gdb.fortran/short-circuit-argument-list.f90
Comments
Ping.
On 08/16/2018 05:02 PM, Richard Bunt wrote:
> When evaluating Fortran expressions such as the following:
>
> print truth_table(1,1) .OR. truth_table(2,1)
>
> where truth_table(1,1) evaluates to true, the debugger would report that
> it could not perform substring operations on this type. This patch
> addresses this issue.
>
> Investigation revealed that EVAL_SKIP was not being handled correctly
> for all types serviced by the OP_F77_UNDETERMINED_ARGLIST case in
> evaluate_subexp_standard. While skipping an undetermined argument list
> the type is resolved to be an integer (as this is what evaluate_subexp
> returns when skipping) and so it was not possible to delegate to the
> appropriate case (e.g. array, function call).
>
> The solution implemented here updates OP_VAR_VALUE to return correct
> type information when skipping. This way OP_F77_UNDETERMINED_ARGLIST
> can delegate the skipping to the appropriate case or routine, which
> should know how to skip/evaluate the type in question.
>
> koenig.exp was updated to include a testcase which exercises the
> modified skip logic in OP_VAR_VALUE, as it falls through from
> OP_ADL_FUNC.
>
> This patch has been tested for regression with GCC 7.3 on aarch64,
> ppc64le and x86_64.
>
> 2018-08-13 Richard Bunt <richard.bunt@arm.com>
> Chris January <chris.january@arm.com>
>
> * eval.c (skip_undetermined_arglist): Skip argument list helper.
> (evaluate_subexp_standard): Return a dummy type when
> honoring EVAL_SKIP in OP_VAR_VALUE and handle skipping in the
> OP_F77_UNDETERMINED_ARGLIST case.
> * expression.h (enum noside): Update comment.
>
> gdb/testsuite/ChangeLog:
>
> 2018-08-13 Richard Bunt <richard.bunt@arm.com>
> Chris January <chris.january@arm.com>
>
> * gdb.cp/koenig.exp: Extend to test logical short circuiting.
> * gdb.fortran/short-circuit-argument-list.exp: New file.
> * gdb.fortran/short-circuit-argument-list.f90: New test.
> ---
> gdb/eval.c | 42 ++++++--
> gdb/expression.h | 4 +-
> gdb/testsuite/gdb.cp/koenig.exp | 3 +
> .../gdb.fortran/short-circuit-argument-list.exp | 109 +++++++++++++++++++++
> .../gdb.fortran/short-circuit-argument-list.f90 | 78 +++++++++++++++
> 5 files changed, 229 insertions(+), 7 deletions(-)
> create mode 100644 gdb/testsuite/gdb.fortran/short-circuit-argument-list.exp
> create mode 100644 gdb/testsuite/gdb.fortran/short-circuit-argument-list.f90
>
> diff --git a/gdb/eval.c b/gdb/eval.c
> index 2e08e9355f5e1ba8bf0ec9818e2291e23676100c..b5fc1c7c7243ea2b05b2cd0f13a33a32e8a7f5a7 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -65,6 +65,9 @@ static LONGEST init_array_element (struct value *, struct value *,
> struct expression *, int *, enum noside,
> LONGEST, LONGEST);
>
> +static void skip_undetermined_arglist (int nargs, struct expression *exp,
> + int *pos, enum noside noside);
> +
> struct value *
> evaluate_subexp (struct type *expect_type, struct expression *exp,
> int *pos, enum noside noside)
> @@ -1234,6 +1237,14 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
> return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
> }
>
> +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);
> +}
> +
> struct value *
> evaluate_subexp_standard (struct type *expect_type,
> struct expression *exp, int *pos,
> @@ -1283,15 +1294,20 @@ evaluate_subexp_standard (struct type *expect_type,
> case OP_ADL_FUNC:
> case OP_VAR_VALUE:
> (*pos) += 3;
> - if (noside == EVAL_SKIP)
> - return eval_skip_value (exp);
> -
> {
> symbol *var = exp->elts[pc + 2].symbol;
> if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_ERROR)
> error_unknown_type (SYMBOL_PRINT_NAME (var));
> -
> - return evaluate_var_value (noside, exp->elts[pc + 1].block, var);
> + if (noside != EVAL_SKIP)
> + {
> + return evaluate_var_value (noside, exp->elts[pc + 1].block, var);
> + }
> + else
> + {
> + /* Return a dummy value of the correct type when skipping, so
> + that parent functions know what is to be skipped. */
> + return allocate_value (SYMBOL_TYPE (var));
> + }
> }
>
> case OP_VAR_MSYM_VALUE:
> @@ -1929,13 +1945,27 @@ evaluate_subexp_standard (struct type *expect_type,
> if (exp->elts[*pos].opcode == OP_RANGE)
> return value_f90_subarray (arg1, exp, pos, noside);
> else
> - goto multi_f77_subscript;
> + {
> + 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));
> }
> diff --git a/gdb/expression.h b/gdb/expression.h
> index 9f26bb8d60ba6905abaf1afd4473dbf5946b958a..bc7625f98427fb3168c2e00053ab947ef8303d55 100644
> --- a/gdb/expression.h
> +++ b/gdb/expression.h
> @@ -118,7 +118,9 @@ extern int parse_completion;
> enum noside
> {
> EVAL_NORMAL,
> - EVAL_SKIP, /* Only effect is to increment pos. */
> + EVAL_SKIP, /* Only effect is to increment pos.
> + Return type information where
> + possible. */
> EVAL_AVOID_SIDE_EFFECTS /* Don't modify any variables or
> call any functions. The value
> returned will have the correct
> diff --git a/gdb/testsuite/gdb.cp/koenig.exp b/gdb/testsuite/gdb.cp/koenig.exp
> index b7dff90e6b4c5ed5b58eda00cbd0eb24681dcd16..0725c1bc91fe165d5819fbf5c0fdd77c09569dad 100644
> --- a/gdb/testsuite/gdb.cp/koenig.exp
> +++ b/gdb/testsuite/gdb.cp/koenig.exp
> @@ -33,6 +33,9 @@ gdb_test "p first(c)" "= 11"
> # the qualifying parameter
> gdb_test "p second(0,0,c,0,0)" "= 33"
>
> +# Test evaluating function under EVAL_SKIP
> +gdb_test "p true || second(0,0,c,0,0)" "= true"
> +
> # Test the name "entry" being used for `variablename@entry' entry values.
> gdb_test "p entry (c)" " = 44"
>
> diff --git a/gdb/testsuite/gdb.fortran/short-circuit-argument-list.exp b/gdb/testsuite/gdb.fortran/short-circuit-argument-list.exp
> new file mode 100644
> index 0000000000000000000000000000000000000000..306ab91534c236e005420f0ec07595c2b318467d
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/short-circuit-argument-list.exp
> @@ -0,0 +1,109 @@
> +# Copyright 2018 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 evaluating logical expressions that contain array references, function
> +# calls and substring operations that are to be skipped due to short
> +# circuiting.
> +
> +if { [skip_fortran_tests] } { return -1 }
> +
> +standard_testfile ".f90"
> +
> +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
> + {debug f90}] } {
> + return -1
> +}
> +
> +if ![runto [gdb_get_line_number "post_truth_table_init"] ] then {
> + perror "couldn't run to breakpoint post_truth_table_init"
> + continue
> +}
> +
> +# Vary conditional and input over the standard truth table.
> +# Test that the debugger can evaluate expressions of the form
> +# a(x,y) .OR./.AND. a(a,b) correctly.
> +foreach_with_prefix truth_table_index {1 2 3 4} {
> + gdb_test "p truth_table($truth_table_index, 1) \
> + .OR. truth_table($truth_table_index, 2)" \
> + "[expr $truth_table_index > 1 ? \".TRUE.\" : \".FALSE.\"]"
> +}
> +
> +foreach_with_prefix truth_table_index {1 2 3 4} {
> + gdb_test "p truth_table($truth_table_index, 1) \
> + .AND. truth_table($truth_table_index, 2)" \
> + "[expr $truth_table_index > 3 ? \".TRUE.\" : \".FALSE.\"]"
> +}
> +
> +# Vary number of function arguments to skip.
> +set argument_list ""
> +foreach_with_prefix arg {"No" "One" "Two"} {
> + set trimmed_args [string trimright $argument_list ,]
> + set arg_lower [string tolower $arg]
> + gdb_test "p function_no_arg_false() .OR. function_${arg_lower}_arg($trimmed_args)" \
> + " $arg, return true.\r\n\\\$$decimal = .TRUE."
> + # Check the skipped function has not printed anything by asserting the
> + # absence of the full stop from its message.
> + gdb_test "p .TRUE. .OR. function_${arg_lower}_arg($trimmed_args)" \
> + "\[^.\]\r\n\\\$$decimal = .TRUE."
> + set argument_list "$argument_list .TRUE.,"
> +}
> +
> +# Check nested calls
> +gdb_test "p function_one_arg(.FALSE. .OR. function_no_arg())" \
> + " No, return true.\r\n One, return true.\r\n\\\$$decimal = .TRUE."
> +
> +gdb_test "p function_one_arg(.TRUE. .OR. function_no_arg())" \
> + "\[^.\]\r\n One, return true.\r\n\\\$$decimal = .TRUE."
> +
> +# Vary number of components in the expression to skip.
> +set expression "p .TRUE."
> +foreach_with_prefix expression_components {1 2 3 4} {
> + set expression "$expression .OR. function_one_arg(.TRUE.)"
> + gdb_test "$expression" \
> + "\\\$$decimal = .TRUE."
> +}
> +
> +# Check parsing skipped substring operations.
> +gdb_test "p .TRUE. .OR. binary_string(1)" "\\\$$decimal = .TRUE."
> +
> +# Check parsing skipped substring operations with ranges. These should all
> +# return true as the result is > 0.
> +# The second binary_string access is important as an incorrect pos update
> +# will not be picked up by a single access.
> +foreach_with_prefix range1 {"1:2" ":" ":2" "1:"} {
> + foreach_with_prefix range2 {"1:2" ":" ":2" "1:"} {
> + gdb_test "p .TRUE. .OR. binary_string($range1) .OR. binary_string($range2)" \
> + "\\\$$decimal = .TRUE."
> + }
> +}
> +
> +# Skip multi-dimensional arrays with ranges.
> +foreach_with_prefix range1 {"1:2" ":" ":2" "1:"} {
> + foreach_with_prefix range2 {"1:2" ":" ":2" "1:"} {
> + gdb_test "p .TRUE. .OR. binary_string($range1) .OR. truth_table($range2, 1)" \
> + "\\\$$decimal = .TRUE."
> + }
> +}
> +
> +# Check evaluation of substring operations in logical expressions.
> +gdb_test "p .FALSE. .OR. binary_string(1)" "\\\$$decimal = .FALSE."
> +
> +# Function call and substring skip.
> +gdb_test "p .TRUE. .OR. function_one_arg(binary_string(1))" \
> + "\\\$$decimal = .TRUE."
> +
> +# Function call and array skip.
> +gdb_test "p .TRUE. .OR. function_array(binary_string)" \
> + "\\\$$decimal = .TRUE."
> diff --git a/gdb/testsuite/gdb.fortran/short-circuit-argument-list.f90 b/gdb/testsuite/gdb.fortran/short-circuit-argument-list.f90
> new file mode 100644
> index 0000000000000000000000000000000000000000..5d8b9c73a705c598b513fd85a8d710c7a7dabebf
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/short-circuit-argument-list.f90
> @@ -0,0 +1,78 @@
> +! Copyright 2018 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/> .
> +
> +! Source code for short-circuit-argument-list.exp.
> +
> +logical function function_no_arg()
> + print *, "No, return true."
> + function_no_arg = .TRUE.
> +end function function_no_arg
> +
> +logical function function_no_arg_false()
> + function_no_arg_false = .FALSE.
> +end function function_no_arg_false
> +
> +logical function function_one_arg(x)
> + logical, intent(in) :: x
> + print *, "One, return true."
> + function_one_arg = .TRUE.
> +end function function_one_arg
> +
> +logical function function_two_arg(x, y)
> + logical, intent(in) :: x, y
> + print *, "Two, return true."
> + function_two_arg = .TRUE.
> +end function function_two_arg
> +
> +logical function function_array(logical_array)
> + logical, dimension(4,2), target, intent(in) :: logical_array
> + logical, dimension(:,:), pointer :: p
> + p => logical_array
> + print *, "Array, return true.", p(1,1), logical_array(1,1)
> + function_array = .TRUE.
> +end function function_array
> +
> +program generate_truth_table
> + implicit none
> + interface
> + logical function function_no_arg()
> + end function function_no_arg
> + logical function function_no_arg_false()
> + end function
> + logical function function_one_arg(x)
> + logical, intent(in) :: x
> + end function
> + logical function function_two_arg(x, y)
> + logical, intent(in) :: x, y
> + end function
> + logical function function_array(logical_array)
> + logical, dimension(4,2), target, intent(in) :: logical_array
> + end function function_array
> + end interface
> + logical, dimension (4,2) :: truth_table
> + logical :: a, b, c, d, e
> + character(2) :: binary_string
> + binary_string = char(0) // char(1)
> + truth_table = .FALSE.
> + truth_table(3:4,1) = .TRUE.
> + truth_table(2::2,2) = .TRUE.
> + a = function_no_arg() ! post_truth_table_init
> + b = function_no_arg_false()
> + c = function_one_arg(b)
> + d = function_two_arg(a, b)
> + e = function_array(truth_table)
> + print *, truth_table(:, 1), a, b, e
> + print *, truth_table(:, 2), c, d
> +end program generate_truth_table
>
>>>>> "Richard" == Richard Bunt <richard.bunt@arm.com> writes:
Thank you for the patch.
Richard> koenig.exp was updated to include a testcase which exercises the
Richard> modified skip logic in OP_VAR_VALUE, as it falls through from
Richard> OP_ADL_FUNC.
Nice, thanks.
Richard> +void
Richard> +skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
Richard> + enum noside noside)
This needs an introductory comment.
Richard> @@ -1283,15 +1294,20 @@ evaluate_subexp_standard (struct type *expect_type,
Richard> case OP_ADL_FUNC:
Richard> case OP_VAR_VALUE:
Richard> (*pos) += 3;
Richard> - if (noside == EVAL_SKIP)
Richard> - return eval_skip_value (exp);
Richard> -
Richard> {
Richard> symbol *var = exp->elts[pc + 2].symbol;
Richard> if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_ERROR)
Richard> error_unknown_type (SYMBOL_PRINT_NAME (var));
With this change I think it would read more nicely if you sunk the
"(*pos) += 3;" into the block.
I wonder if we really want this to error in the case where the symbol
isn't found. But I suppose it is necessary for your patch to work.
I tend to think it is fine; I couldn't think of a plausible,
non-pathological way that I would want to use the non-erroring behavior.
Though, another option is to do this in a fortran-specific way.
Richard> +if ![runto [gdb_get_line_number "post_truth_table_init"] ] then {
I usually brace the conditions and cuddle the brackets, so
if {!runto [gdb...]]} then {
The bracing is super Tcl nerdery.
Richard> +# Vary conditional and input over the standard truth table.
Richard> +# Test that the debugger can evaluate expressions of the form
Richard> +# a(x,y) .OR./.AND. a(a,b) correctly.
Richard> +foreach_with_prefix truth_table_index {1 2 3 4} {
Richard> + gdb_test "p truth_table($truth_table_index, 1) \
Richard> + .OR. truth_table($truth_table_index, 2)" \
I think it's better to just have a longer line here than to split a
string in the middle.
Richard> + set argument_list "$argument_list .TRUE.,"
You can write this as
append argument_list " .TRUE.,"
Richard> + gdb_test "p .TRUE. .OR. binary_string($range1) .OR. truth_table($range2, 1)" \
For some of the tests -- I'm afraid I didn't enumerate them -- you will
need to supply a different (and unique) test name to gdb_test, because
there is a rule against tests having parenthesized text at the end of
their name:
https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Do_not_use_.22tail_parentheses.22_on_test_messages
Tom
On 2018-09-07 23:23, Tom Tromey wrote:
> For some of the tests -- I'm afraid I didn't enumerate them -- you will
> need to supply a different (and unique) test name to gdb_test, because
> there is a rule against tests having parenthesized text at the end of
> their name:
>
> https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Do_not_use_.22tail_parentheses.22_on_test_messages
This says "... and space before parentheses" and it is the case here,
though.
Simon
On 2018-09-07 23:29, Simon Marchi wrote:
> On 2018-09-07 23:23, Tom Tromey wrote:
>> For some of the tests -- I'm afraid I didn't enumerate them -- you
>> will
>> need to supply a different (and unique) test name to gdb_test, because
>> there is a rule against tests having parenthesized text at the end of
>> their name:
>>
>> https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Do_not_use_.22tail_parentheses.22_on_test_messages
>
> This says "... and space before parentheses" and it is the case here,
> though.
I meant "NOT the case", of course.
>>>>> "Simon" == Simon Marchi <simon.marchi@polymtl.ca> writes:
Simon> This says "... and space before parentheses" and it is the case here,
Simon> though.
Thanks for noticing that, I agree it's no issue here.
Tom
On 2018-09-07 11:23 PM, Tom Tromey wrote:
>>>>>> "Richard" == Richard Bunt <richard.bunt@arm.com> writes:
>
> Thank you for the patch.
>
> Richard> koenig.exp was updated to include a testcase which exercises the
> Richard> modified skip logic in OP_VAR_VALUE, as it falls through from
> Richard> OP_ADL_FUNC.
>
> Nice, thanks.
>
> Richard> +void
> Richard> +skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
> Richard> + enum noside noside)
>
> This needs an introductory comment.
Also, you can get rid of the forward-declaration of skip_undetermined_arglist,
and the definition should be made static.
Simon
On 09/07/2018 11:23 PM, Tom Tromey wrote:
>>>>>> "Richard" == Richard Bunt <richard.bunt@arm.com> writes:
>
> I wonder if we really want this to error in the case where the symbol
> isn't found. But I suppose it is necessary for your patch to work.
>
> I tend to think it is fine; I couldn't think of a plausible,
> non-pathological way that I would want to use the non-erroring behavior.
If I understand correctly the concern here is that the evaluation will
report an error if the symbol is not found, even if it is supposed to be
evaluated in a lazy manner. I considered a similar issue when testing
with the following expression:
print k .OR. array(1,2,3,4)
where k == .TRUE. and array only has 3 dimensions. The debugger still
reports that this is invalid even though the array access is not needed
for the truth value. I considered this to be acceptable as this code
wouldn't compile anyway and I would rather it failed fast than at some
point later (when k becomes false). I believe a similar justification
holds for the case where array is an invalid symbol.
>
> Though, another option is to do this in a fortran-specific way.
Are you able to provide some more details on this approach please?
>
> Richard> + gdb_test "p .TRUE. .OR. binary_string($range1) .OR. truth_table($range2, 1)" \
>
> For some of the tests -- I'm afraid I didn't enumerate them -- you will
> need to supply a different (and unique) test name to gdb_test, because
> there is a rule against tests having parenthesized text at the end of
> their name:
>
> https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Do_not_use_.22tail_parentheses.22_on_test_messages
>
> Tom
>
Based on the discussion with Simon I understand that there is no issue
here. However, if I had used a space between the array symbol name
and the parenthesizes this would have been a problem. This is useful to
know.
Missing comments, style errors and non-idiomatic code have been fixed
in v3.
Many thanks for the comments,
Rich.
>>>>> "Rich" == Rich Bunt <richard.bunt@arm.com> writes:
>> Though, another option is to do this in a fortran-specific way.
Rich> Are you able to provide some more details on this approach please?
Sure. Each language provides its own evaluation function. These
functions can change the interpretation -- or even, in collusion with
the language's expression parser the layout in memory -- of a given
opcode. Most languages just defer to the generic evaluator.
E.g., look at rust-lang.c:rust_evaluate_subexp. It changes UNOP_IND to
handle Rust trait objects, among other things.
Fortran doesn't have one of these as f_language_defn refers to
exp_descriptor_standard.
The whole expression data structure and approach is bad and should be
rewritten.
Anyway, doing this may be overkill, unless we think of some downside to
your approach.
Rich> However, if I had used a space between the array symbol name
Rich> and the parenthesizes this would have been a problem. This is
Rich> useful to know.
Yeah. A bit subtle for my taste, I feel certain I'll break this rule by
accident.
Tom
On 09/12/2018 12:38 PM, Tom Tromey wrote:
> Rich> However, if I had used a space between the array symbol name
> Rich> and the parenthesizes this would have been a problem. This is
> Rich> useful to know.
>
> Yeah. A bit subtle for my taste, I feel certain I'll break this rule by
> accident.
I've extended the wiki section to hopefully clarify things and make it
more obvious with an example. Please take a look:
https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Do_not_use_.22tail_parentheses.22_on_test_messages
Thanks,
Pedro Alves
>>>>> "Pedro" == Pedro Alves <palves@redhat.com> writes:
Pedro> On 09/12/2018 12:38 PM, Tom Tromey wrote:
Rich> However, if I had used a space between the array symbol name
Rich> and the parenthesizes this would have been a problem. This is
Rich> useful to know.
>>
>> Yeah. A bit subtle for my taste, I feel certain I'll break this rule by
>> accident.
Pedro> I've extended the wiki section to hopefully clarify things and make it
Pedro> more obvious with an example. Please take a look:
Pedro> https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Do_not_use_.22tail_parentheses.22_on_test_messages
Thanks for doing that.
Tom
On 09/12/2018 12:38 PM, Tom Tromey wrote:
>>>>>> "Rich" == Rich Bunt <richard.bunt@arm.com> writes:
>
>>> Though, another option is to do this in a fortran-specific way.
>
> Rich> Are you able to provide some more details on this approach please?
>
> Sure. Each language provides its own evaluation function. These
> functions can change the interpretation -- or even, in collusion with
> the language's expression parser the layout in memory -- of a given
> opcode. Most languages just defer to the generic evaluator.
>
> E.g., look at rust-lang.c:rust_evaluate_subexp. It changes UNOP_IND to
> handle Rust trait objects, among other things.
>
> Fortran doesn't have one of these as f_language_defn refers to
> exp_descriptor_standard.
>
> The whole expression data structure and approach is bad and should be
> rewritten.
>
> Anyway, doing this may be overkill, unless we think of some downside to
> your approach.
Thanks for this. It's good to know this is an option as I work through
other Fortran additions.
Rich.
@@ -65,6 +65,9 @@ static LONGEST init_array_element (struct value *, struct value *,
struct expression *, int *, enum noside,
LONGEST, LONGEST);
+static void skip_undetermined_arglist (int nargs, struct expression *exp,
+ int *pos, enum noside noside);
+
struct value *
evaluate_subexp (struct type *expect_type, struct expression *exp,
int *pos, enum noside noside)
@@ -1234,6 +1237,14 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
}
+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);
+}
+
struct value *
evaluate_subexp_standard (struct type *expect_type,
struct expression *exp, int *pos,
@@ -1283,15 +1294,20 @@ evaluate_subexp_standard (struct type *expect_type,
case OP_ADL_FUNC:
case OP_VAR_VALUE:
(*pos) += 3;
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
-
{
symbol *var = exp->elts[pc + 2].symbol;
if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_ERROR)
error_unknown_type (SYMBOL_PRINT_NAME (var));
-
- return evaluate_var_value (noside, exp->elts[pc + 1].block, var);
+ if (noside != EVAL_SKIP)
+ {
+ return evaluate_var_value (noside, exp->elts[pc + 1].block, var);
+ }
+ else
+ {
+ /* Return a dummy value of the correct type when skipping, so
+ that parent functions know what is to be skipped. */
+ return allocate_value (SYMBOL_TYPE (var));
+ }
}
case OP_VAR_MSYM_VALUE:
@@ -1929,13 +1945,27 @@ evaluate_subexp_standard (struct type *expect_type,
if (exp->elts[*pos].opcode == OP_RANGE)
return value_f90_subarray (arg1, exp, pos, noside);
else
- goto multi_f77_subscript;
+ {
+ 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));
}
@@ -118,7 +118,9 @@ extern int parse_completion;
enum noside
{
EVAL_NORMAL,
- EVAL_SKIP, /* Only effect is to increment pos. */
+ EVAL_SKIP, /* Only effect is to increment pos.
+ Return type information where
+ possible. */
EVAL_AVOID_SIDE_EFFECTS /* Don't modify any variables or
call any functions. The value
returned will have the correct
@@ -33,6 +33,9 @@ gdb_test "p first(c)" "= 11"
# the qualifying parameter
gdb_test "p second(0,0,c,0,0)" "= 33"
+# Test evaluating function under EVAL_SKIP
+gdb_test "p true || second(0,0,c,0,0)" "= true"
+
# Test the name "entry" being used for `variablename@entry' entry values.
gdb_test "p entry (c)" " = 44"
new file mode 100644
@@ -0,0 +1,109 @@
+# Copyright 2018 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 evaluating logical expressions that contain array references, function
+# calls and substring operations that are to be skipped due to short
+# circuiting.
+
+if { [skip_fortran_tests] } { return -1 }
+
+standard_testfile ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}] } {
+ return -1
+}
+
+if ![runto [gdb_get_line_number "post_truth_table_init"] ] then {
+ perror "couldn't run to breakpoint post_truth_table_init"
+ continue
+}
+
+# Vary conditional and input over the standard truth table.
+# Test that the debugger can evaluate expressions of the form
+# a(x,y) .OR./.AND. a(a,b) correctly.
+foreach_with_prefix truth_table_index {1 2 3 4} {
+ gdb_test "p truth_table($truth_table_index, 1) \
+ .OR. truth_table($truth_table_index, 2)" \
+ "[expr $truth_table_index > 1 ? \".TRUE.\" : \".FALSE.\"]"
+}
+
+foreach_with_prefix truth_table_index {1 2 3 4} {
+ gdb_test "p truth_table($truth_table_index, 1) \
+ .AND. truth_table($truth_table_index, 2)" \
+ "[expr $truth_table_index > 3 ? \".TRUE.\" : \".FALSE.\"]"
+}
+
+# Vary number of function arguments to skip.
+set argument_list ""
+foreach_with_prefix arg {"No" "One" "Two"} {
+ set trimmed_args [string trimright $argument_list ,]
+ set arg_lower [string tolower $arg]
+ gdb_test "p function_no_arg_false() .OR. function_${arg_lower}_arg($trimmed_args)" \
+ " $arg, return true.\r\n\\\$$decimal = .TRUE."
+ # Check the skipped function has not printed anything by asserting the
+ # absence of the full stop from its message.
+ gdb_test "p .TRUE. .OR. function_${arg_lower}_arg($trimmed_args)" \
+ "\[^.\]\r\n\\\$$decimal = .TRUE."
+ set argument_list "$argument_list .TRUE.,"
+}
+
+# Check nested calls
+gdb_test "p function_one_arg(.FALSE. .OR. function_no_arg())" \
+ " No, return true.\r\n One, return true.\r\n\\\$$decimal = .TRUE."
+
+gdb_test "p function_one_arg(.TRUE. .OR. function_no_arg())" \
+ "\[^.\]\r\n One, return true.\r\n\\\$$decimal = .TRUE."
+
+# Vary number of components in the expression to skip.
+set expression "p .TRUE."
+foreach_with_prefix expression_components {1 2 3 4} {
+ set expression "$expression .OR. function_one_arg(.TRUE.)"
+ gdb_test "$expression" \
+ "\\\$$decimal = .TRUE."
+}
+
+# Check parsing skipped substring operations.
+gdb_test "p .TRUE. .OR. binary_string(1)" "\\\$$decimal = .TRUE."
+
+# Check parsing skipped substring operations with ranges. These should all
+# return true as the result is > 0.
+# The second binary_string access is important as an incorrect pos update
+# will not be picked up by a single access.
+foreach_with_prefix range1 {"1:2" ":" ":2" "1:"} {
+ foreach_with_prefix range2 {"1:2" ":" ":2" "1:"} {
+ gdb_test "p .TRUE. .OR. binary_string($range1) .OR. binary_string($range2)" \
+ "\\\$$decimal = .TRUE."
+ }
+}
+
+# Skip multi-dimensional arrays with ranges.
+foreach_with_prefix range1 {"1:2" ":" ":2" "1:"} {
+ foreach_with_prefix range2 {"1:2" ":" ":2" "1:"} {
+ gdb_test "p .TRUE. .OR. binary_string($range1) .OR. truth_table($range2, 1)" \
+ "\\\$$decimal = .TRUE."
+ }
+}
+
+# Check evaluation of substring operations in logical expressions.
+gdb_test "p .FALSE. .OR. binary_string(1)" "\\\$$decimal = .FALSE."
+
+# Function call and substring skip.
+gdb_test "p .TRUE. .OR. function_one_arg(binary_string(1))" \
+ "\\\$$decimal = .TRUE."
+
+# Function call and array skip.
+gdb_test "p .TRUE. .OR. function_array(binary_string)" \
+ "\\\$$decimal = .TRUE."
new file mode 100644
@@ -0,0 +1,78 @@
+! Copyright 2018 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/> .
+
+! Source code for short-circuit-argument-list.exp.
+
+logical function function_no_arg()
+ print *, "No, return true."
+ function_no_arg = .TRUE.
+end function function_no_arg
+
+logical function function_no_arg_false()
+ function_no_arg_false = .FALSE.
+end function function_no_arg_false
+
+logical function function_one_arg(x)
+ logical, intent(in) :: x
+ print *, "One, return true."
+ function_one_arg = .TRUE.
+end function function_one_arg
+
+logical function function_two_arg(x, y)
+ logical, intent(in) :: x, y
+ print *, "Two, return true."
+ function_two_arg = .TRUE.
+end function function_two_arg
+
+logical function function_array(logical_array)
+ logical, dimension(4,2), target, intent(in) :: logical_array
+ logical, dimension(:,:), pointer :: p
+ p => logical_array
+ print *, "Array, return true.", p(1,1), logical_array(1,1)
+ function_array = .TRUE.
+end function function_array
+
+program generate_truth_table
+ implicit none
+ interface
+ logical function function_no_arg()
+ end function function_no_arg
+ logical function function_no_arg_false()
+ end function
+ logical function function_one_arg(x)
+ logical, intent(in) :: x
+ end function
+ logical function function_two_arg(x, y)
+ logical, intent(in) :: x, y
+ end function
+ logical function function_array(logical_array)
+ logical, dimension(4,2), target, intent(in) :: logical_array
+ end function function_array
+ end interface
+ logical, dimension (4,2) :: truth_table
+ logical :: a, b, c, d, e
+ character(2) :: binary_string
+ binary_string = char(0) // char(1)
+ truth_table = .FALSE.
+ truth_table(3:4,1) = .TRUE.
+ truth_table(2::2,2) = .TRUE.
+ a = function_no_arg() ! post_truth_table_init
+ b = function_no_arg_false()
+ c = function_one_arg(b)
+ d = function_two_arg(a, b)
+ e = function_array(truth_table)
+ print *, truth_table(:, 1), a, b, e
+ print *, truth_table(:, 2), c, d
+end program generate_truth_table