This is the mail archive of the gdb-patches@sourceware.org mailing list for the GDB project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [PING][PATCH v2] Logical short circuiting with argument lists


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
> 


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]