Logical short circuiting with argument lists

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 regressions with GCC 7.3 on aarch64,
ppc64le and x86_64.

gdb/ChangeLog:

	* 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:

	* 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.
This commit is contained in:
Richard Bunt 2018-09-19 10:43:56 +01:00
parent 7307a73aed
commit 23be8da739
7 changed files with 243 additions and 8 deletions

View file

@ -1,3 +1,12 @@
2018-09-19 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.
2018-09-19 George Vasick <george.vasick@oracle.com>
* solib-svr4.c (svr4_same_1): Also handle amd64 ld.so.1.

View file

@ -1238,6 +1238,19 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
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);
}
struct value *
evaluate_subexp_standard (struct type *expect_type,
struct expression *exp, int *pos,
@ -1286,16 +1299,19 @@ 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);
{
(*pos) += 3;
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:
@ -1933,13 +1949,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));
}

View file

@ -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

View file

@ -1,3 +1,10 @@
2018-09-19 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.
2018-09-18 Sergio Durigan Junior <sergiodj@redhat.com>
* gdb.arch/amd64-invalid-stack-top.exp: Expect optional

View file

@ -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"

View file

@ -0,0 +1,106 @@
# 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."
append 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."

View file

@ -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