diff options
Diffstat (limited to 'gdb/testsuite')
| -rw-r--r-- | gdb/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/associated.exp | 87 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/associated.f90 | 97 |
3 files changed, 189 insertions, 0 deletions
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 2bf9e41..21c98fa 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2021-02-25 Andrew Burgess <andrew.burgess@embecosm.com> + * gdb.fortran/associated.exp: New file. + * gdb.fortran/associated.f90: New file. + +2021-02-25 Andrew Burgess <andrew.burgess@embecosm.com> + * gdb.fortran/dot-ops.exp (dot_operations): Test ".xor.". 2021-02-24 Andrew Burgess <andrew.burgess@embecosm.com> diff --git a/gdb/testsuite/gdb.fortran/associated.exp b/gdb/testsuite/gdb.fortran/associated.exp new file mode 100644 index 0000000..d9976f7 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/associated.exp @@ -0,0 +1,87 @@ +# Copyright 2021 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/> . + +# Testing GDB's implementation of ASSOCIATED keyword. + +if {[skip_fortran_tests]} { return -1 } + +standard_testfile ".f90" +load_lib fortran.exp + +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90}]} { + return -1 +} + +if ![fortran_runto_main] { + untested "could not run to main" + return -1 +} + +gdb_breakpoint [gdb_get_line_number "Test Breakpoint"] +gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] + +# We place a limit on the number of tests that can be run, just in +# case something goes wrong, and GDB gets stuck in an loop here. +set found_final_breakpoint false +set test_count 0 +while { $test_count < 500 } { + with_test_prefix "test $test_count" { + incr test_count + + gdb_test_multiple "continue" "continue" { + -re -wrap "! Test Breakpoint" { + # We can run a test from here. + } + -re "! Final Breakpoint" { + # We're done with the tests. + set found_final_breakpoint true + } + } + + if ($found_final_breakpoint) { + break + } + + # First grab the expected answer. + set answer [get_valueof "" "answer" "**unknown**"] + + # Now move up a frame and figure out a command for us to run + # as a test. + set command "" + gdb_test_multiple "up" "up" { + -re -wrap "\r\n\[0-9\]+\[ \t\]+call test_associated \\((\[^\r\n\]+)\\)" { + set command $expect_out(1,string) + } + } + + gdb_assert { ![string equal $command ""] } "found a command to run" + + gdb_test "p $command" " = $answer" + } +} + +# Ensure we reached the final breakpoint. If more tests have been added +# to the test script, and this starts failing, then the safety 'while' +# loop above might need to be increased. +gdb_assert {$found_final_breakpoint} "ran all compiled in tests" + +# Now perform the final tests. These should all be error condition +# checks, for things that can't be compiled into the test source file. +gdb_test "p associated (array_1d_p, an_integer)" \ + "arguments to associated must be of same type and kind" + +gdb_test "p associated (an_integer_p, a_real)" \ + "arguments to associated must be of same type and kind" diff --git a/gdb/testsuite/gdb.fortran/associated.f90 b/gdb/testsuite/gdb.fortran/associated.f90 new file mode 100644 index 0000000..093af53 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/associated.f90 @@ -0,0 +1,97 @@ +! Copyright 2021 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/>. + +! +! Start of test program. +! +program test + + ! Things to point at. + integer, target :: array_1d (1:10) = 0 + integer, target :: array_2d (1:10, 1:10) = 0 + integer, target :: an_integer = 0 + integer, target :: other_integer = 0 + real, target :: a_real = 0.0 + + ! Things to point with. + integer, pointer :: array_1d_p (:) => null () + integer, pointer :: other_1d_p (:) => null () + integer, pointer :: array_2d_p (:,:) => null () + integer, pointer :: an_integer_p => null () + integer, pointer :: other_integer_p => null () + real, pointer :: a_real_p => null () + + ! The start of the tests. + call test_associated (associated (array_1d_p)) + call test_associated (associated (array_1d_p, array_1d)) + + array_1d_p => array_1d + call test_associated (associated (array_1d_p, array_1d)) + + array_1d_p => array_1d (2:10) + call test_associated (associated (array_1d_p, array_1d)) + + array_1d_p => array_1d (1:9) + call test_associated (associated (array_1d_p, array_1d)) + + array_1d_p => array_2d (3, :) + call test_associated (associated (array_1d_p, array_1d)) + call test_associated (associated (array_1d_p, array_2d (2, :))) + call test_associated (associated (array_1d_p, array_2d (3, :))) + + array_1d_p => null () + call test_associated (associated (array_1d_p)) + call test_associated (associated (array_1d_p, array_2d (3, :))) + + call test_associated (associated (an_integer_p)) + call test_associated (associated (an_integer_p, an_integer)) + an_integer_p => an_integer + call test_associated (associated (an_integer_p)) + call test_associated (associated (an_integer_p, an_integer)) + + call test_associated (associated (an_integer_p, other_integer_p)) + other_integer_p => other_integer + call test_associated (associated (other_integer_p)) + call test_associated (associated (an_integer_p, other_integer_p)) + call test_associated (associated (other_integer_p, an_integer_p)) + call test_associated (associated (other_integer_p, an_integer)) + + other_integer_p = an_integer_p + call test_associated (associated (an_integer_p, other_integer_p)) + call test_associated (associated (other_integer_p, an_integer_p)) + + call test_associated (associated (a_real_p)) + call test_associated (associated (a_real_p, a_real)) + a_real_p => a_real + call test_associated (associated (a_real_p, a_real)) + + ! Setup for final tests, these are performed at the print line + ! below. These final tests are all error conditon checks, + ! i.e. things that can't be compiled into Fortran. + array_1d_p => array_1d + + print *, "" ! Final Breakpoint + print *, an_integer + print *, a_real + +contains + + subroutine test_associated (answer) + logical :: answer + + print *,answer ! Test Breakpoint + end subroutine test_associated + +end program test |