1 # Copyright 2021 Free Software Foundation, Inc.
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 3 of the License, or
6 # (at your option) any later version.
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
13 # You should have received a copy of the GNU General Public License
14 # along with this program. If not, see <http://www.gnu.org/licenses/> .
16 # Testing GDB's implementation of RANK keyword.
18 if {[skip_fortran_tests]} { return -1 }
20 standard_testfile ".f90"
23 if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
28 if ![fortran_runto_main] {
29 untested "could not run to main"
33 gdb_breakpoint [gdb_get_line_number "Test Breakpoint"]
34 gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
36 # We place a limit on the number of tests that can be run, just in
37 # case something goes wrong, and GDB gets stuck in an loop here.
38 set found_final_breakpoint false
40 while { $test_count < 500 } {
41 with_test_prefix "test $test_count" {
44 gdb_test_multiple "continue" "continue" {
45 -re -wrap "! Test Breakpoint" {
46 # We can run a test from here.
48 -re "! Final Breakpoint" {
49 # We're done with the tests.
50 set found_final_breakpoint true
54 if ($found_final_breakpoint) {
58 # First grab the expected answer.
59 set answer [get_valueof "" "answer" "**unknown**"]
61 # Now move up a frame and figure out a command for us to run
64 gdb_test_multiple "up" "up" {
65 -re -wrap "\r\n\[0-9\]+\[ \t\]+call test_rank \\((\[^\r\n\]+)\\)" {
66 set command $expect_out(1,string)
70 gdb_assert { ![string equal $command ""] } "found a command to run"
72 gdb_test "p $command" " = $answer"
76 # Ensure we reached the final breakpoint. If more tests have been added
77 # to the test script, and this starts failing, then the safety 'while'
78 # loop above might need to be increased.
79 gdb_assert {$found_final_breakpoint} "ran all compiled in tests"