[PATCH] Logical short circuiting with Fortran argument lists

[Richard Bunt <richard.bunt@arm.com>]

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 proposed here is to hoist the skip from the function call
case to apply to all types of argument list.

While this patch allows a wider range of expressions to be evaluated, it
should be noted that this patch does not allow the skipping of arrays
which use Fortran array slicing, due to the inability of the debugger
to skip OP_RANGE.

This patch has been tested with GCC 7.3 on x86_64, aarch64 and ppc64le.

2018-06-06  Richard Bunt  <richard.bunt@arm.com>
	Chris January  <chris.january@arm.com>

	* eval.c (evaluate_subexp_standard): Skip evaluation of Fortran
	argument lists when requested.

gdb/testsuite/ChangeLog:

2018-06-06  Richard Bunt  <richard.bunt@arm.com>
	Chris January  <chris.january@arm.com>

	* gdb.fortran/short-circuit-argument-list.exp: New file.
	* gdb.fortran/short-circuit-argument-list.f90: New test.
---
 gdb/eval.c                                         | 13 +++-
 .../gdb.fortran/short-circuit-argument-list.exp    | 80
++++++++++++++++++++++
 .../gdb.fortran/short-circuit-argument-list.f90    | 66 ++++++++++++++++++
 3 files changed, 157 insertions(+), 2 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
9db6e7c69dad9e674f66991e2aee7dd8d66d80c7..2350c7faaf6221a5990cf5264fe7fe93b4f4be4c
100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -1902,6 +1902,17 @@ evaluate_subexp_standard (struct type *expect_type,

       /* First determine the type code we are dealing with.  */
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+
+      /* Allow the short-circuiting of array accesses, function calls
+	 and substring operations in logical expressions.  */
+      if (noside == EVAL_SKIP)
+	{
+	  /* Skip all the array subscripts.  */
+	  for (int i = 0; i < nargs; ++i)
+	    evaluate_subexp (NULL_TYPE, exp, pos, noside);
+	  return eval_skip_value (exp);
+	}
+
       type = check_typedef (value_type (arg1));
       code = TYPE_CODE (type);

@@ -1952,8 +1963,6 @@ evaluate_subexp_standard (struct type *expect_type,
 	  for (; tem <= nargs; tem++)
 	    argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 	  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:
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..294d808d99e6debfde5b802dd34aa17e3a136cd0
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/short-circuit-argument-list.exp
@@ -0,0 +1,80 @@
+# 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."
+    gdb_test "p .TRUE. .OR. function_${arg_lower}_arg($trimmed_args)" \
+	     "\\\$$decimal = .TRUE."
+    set argument_list "$argument_list .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 evaluation of substring operations in logical expressions.
+gdb_test "p .FALSE. .OR. binary_string(1)" "\\\$$decimal = .FALSE."
+
+# 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())" \
+	 " One, return true.\r\n\\\$$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..28386d029c1db0afa503d77804fc2c4bb6881dad
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/short-circuit-argument-list.f90
@@ -0,0 +1,66 @@
+! 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
+
+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
+    end interface
+    logical, dimension (4,2) :: truth_table
+    logical :: a, b, c, d
+    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)
+    print *, truth_table(:, 1), a, b
+    print *, truth_table(:, 2), c, d
+end program generate_truth_table
-- 
2.7.4