From patchwork Fri Sep 14 08:08:58 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Richard Bunt X-Patchwork-Id: 29373 Received: (qmail 118629 invoked by alias); 14 Sep 2018 08:10:05 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 117959 invoked by uid 89); 14 Sep 2018 08:10:04 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-22.8 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_LOTSOFHASH, KAM_SHORT, KAM_STOCKGEN, RCVD_IN_DNSWL_NONE, SPF_HELO_PASS, SPF_PASS autolearn=ham version=3.3.2 spammy=ab, UD:eval.c, eval.c, evalc X-HELO: EUR02-HE1-obe.outbound.protection.outlook.com Received: from mail-eopbgr10053.outbound.protection.outlook.com (HELO EUR02-HE1-obe.outbound.protection.outlook.com) (40.107.1.53) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 14 Sep 2018 08:10:00 +0000 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=armh.onmicrosoft.com; s=selector1-arm-com; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=NpoFt7FRPvMhu56rSDOcgDr2D71NVCaCsYs0IZ/dBUM=; b=QIqsMT3ERKmBEwT95kXlcdTob+IU5u0ycS76gOpt2fVP+FJk/twKQLwk+Qzo/Z0mUWh9E3JJsxU7mHcIVmTZH9EhOnYnO5Tn7R9/eTTIPJmJsg0ZzBJr8BeAfPEMa3z+KQx4lDyPGW7fU5FG3mpoQVQTYueVdFqcr89MjkkzMO4= Authentication-Results: spf=none (sender IP is ) smtp.mailfrom=Richard.Bunt@arm.com; Received: from [10.37.9.76] (217.140.96.140) by DB7PR08MB3196.eurprd08.prod.outlook.com (2603:10a6:5:1e::30) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.1122.16; Fri, 14 Sep 2018 08:09:55 +0000 From: Richard Bunt Subject: [PATCH v3] Logical short circuiting with argument lists To: gdb-patches@sourceware.org Cc: nd@arm.com Message-ID: <833f15b2-48da-fe83-86c8-3c2bce46b01c@arm.com> Date: Fri, 14 Sep 2018 09:08:58 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.9.1 MIME-Version: 1.0 Return-Path: richard.bunt@arm.com Received-SPF: None (protection.outlook.com: arm.com does not designate permitted sender hosts) X-IsSubscribed: yes Version 3 addresses review comments: * Removed forward declaration of skip_undetermined_arglist. * Made definition of skip_undetermined_arglist static. * Added introductory comment to skip_undetermined_arglist. * Dropped (*pos)+=3 into the block. * Adjusted Tcl bracing. * Removed string splitting in the test case. --- 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. 2018-08-13 Richard Bunt Chris January * 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 Chris January * 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 | 46 +++++++-- gdb/expression.h | 4 +- gdb/testsuite/gdb.cp/koenig.exp | 3 + .../gdb.fortran/short-circuit-argument-list.exp | 106 +++++++++++++++++++++ .../gdb.fortran/short-circuit-argument-list.f90 | 78 +++++++++++++++ 5 files changed, 229 insertions(+), 8 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..991c6f505cf648d40938e3033564f42d6ea661f3 100644 --- a/gdb/eval.c +++ b/gdb/eval.c @@ -1234,6 +1234,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, @@ -1282,16 +1295,21 @@ 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: @@ -1929,13 +1947,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..1b948bb19d289e5327cb2caa3bf665e33cd6d98d --- /dev/null +++ b/gdb/testsuite/gdb.fortran/short-circuit-argument-list.exp @@ -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 . + +# 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." 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 . + +! 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