# Copyright 2018-2019 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."