diff options
author | Andrew Burgess <andrew.burgess@embecosm.com> | 2021-02-25 11:41:57 +0000 |
---|---|---|
committer | Andrew Burgess <andrew.burgess@embecosm.com> | 2021-03-09 09:45:18 +0000 |
commit | e14816a8ba5ecf8d7c0125a08afe87fb7d1a6bba (patch) | |
tree | 718883b66af773f86fc1ef753db65f8e33456f1c /gdb/testsuite | |
parent | 742732c7f0a989eaba7c1acac3ca5eeaa274df0e (diff) | |
download | fsf-binutils-gdb-e14816a8ba5ecf8d7c0125a08afe87fb7d1a6bba.zip fsf-binutils-gdb-e14816a8ba5ecf8d7c0125a08afe87fb7d1a6bba.tar.gz fsf-binutils-gdb-e14816a8ba5ecf8d7c0125a08afe87fb7d1a6bba.tar.bz2 |
gdb/fortran: add support for RANK keyword
gfortran supports the RANK keyword, see:
https://gcc.gnu.org/onlinedocs/gfortran/RANK.html#RANK
this commit adds support for this keyword to GDB's Fortran expression
parser.
gdb/ChangeLog:
* f-exp.h (eval_op_f_rank): Declare.
(expr::fortran_rank_operation): New typedef.
* f-exp.y (exp): Handle UNOP_FORTRAN_RANK after parsing an
UNOP_INTRINSIC.
(f77_keywords): Add "rank" keyword.
* f-lang.c (eval_op_f_rank): New function.
* std-operator.def (UNOP_FORTRAN_RANK): New operator.
gdb/testsuite/ChangeLog:
* gdb.fortran/rank.exp: New file.
* gdb.fortran/rank.f90: New file.
Diffstat (limited to 'gdb/testsuite')
-rw-r--r-- | gdb/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gdb/testsuite/gdb.fortran/rank.exp | 79 | ||||
-rw-r--r-- | gdb/testsuite/gdb.fortran/rank.f90 | 57 |
3 files changed, 141 insertions, 0 deletions
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 5767fa5..f221157 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2021-03-09 Andrew Burgess <andrew.burgess@embecosm.com> + + * gdb.fortran/rank.exp: New file. + * gdb.fortran/rank.f90: New file. + 2021-03-08 Tom Tromey <tom@tromey.com> * gdb.fortran/debug-expr.exp: Update tests. diff --git a/gdb/testsuite/gdb.fortran/rank.exp b/gdb/testsuite/gdb.fortran/rank.exp new file mode 100644 index 0000000..86af711 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/rank.exp @@ -0,0 +1,79 @@ +# 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 RANK 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_rank \\((\[^\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" diff --git a/gdb/testsuite/gdb.fortran/rank.f90 b/gdb/testsuite/gdb.fortran/rank.f90 new file mode 100644 index 0000000..66de2bb --- /dev/null +++ b/gdb/testsuite/gdb.fortran/rank.f90 @@ -0,0 +1,57 @@ +! 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 ask questions about. + integer, target :: array_1d (8:10) = 0 + integer, target :: array_2d (1:3, 4:7) = 0 + integer :: other_1d (4:5, -3:-1, 99:101) = 0 + integer, pointer :: array_1d_p (:) => null () + integer, pointer :: array_2d_p (:,:) => null () + + integer :: an_integer = 0 + real :: a_real = 0.0 + + ! The start of the tests. + call test_rank (rank (array_1d)) + call test_rank (rank (array_2d)) + call test_rank (rank (other_1d)) + call test_rank (rank (array_1d_p)) + call test_rank (rank (array_2d_p)) + + array_1d_p => array_1d + array_2d_p => array_2d + + call test_rank (rank (array_1d_p)) + call test_rank (rank (array_2d_p)) + + call test_rank (rank (an_integer)) + call test_rank (rank (a_real)) + + print *, "" ! Final Breakpoint + +contains + + subroutine test_rank (answer) + integer :: answer + + print *,answer ! Test Breakpoint + end subroutine test_rank + +end program test |