-# Copyright (C) 1994 Free Software Foundation, Inc.
+# Copyright 1994-2013 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 2 of the License, or
+# 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, write to the Free Software
-# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
-
-# Please email any bugs, comments, and/or additions to this file to:
-# bug-gdb@prep.ai.mit.edu
-
-# This file was adapted from Chill tests by Stan Shebs (shebs@cygnus.com).
-
-if $tracelevel then {
- strace $tracelevel
-}
-
-set prms_id 0
-set bug_id 0
-
-# Set the current language to fortran. This counts as a test. If it
-# fails, then we skip the other tests.
-
-proc set_lang_fortran {} {
- global prompt
-
- send "set language fortran\n"
- expect {
- -re ".*$prompt $" {}
- timeout { fail "set language fortran (timeout)" ; return 0 }
- }
-
- send "show language\n"
- expect {
- -re ".* source language is \"fortran\".*$prompt $" {
- pass "set language to \"fortran\""
- return 1
- }
- -re ".*$prompt $" {
- fail "setting language to \"fortran\""
- return 0
- }
- timeout {
- fail "can't show language (timeout)"
- return 0
- }
- }
-}
-
-# Testing printing of a specific value. Increment passcount for
-# success or issue fail message for failure. In both cases, return
-# a 1 to indicate that more tests can proceed. However a timeout
-# is a serious error, generates a special fail message, and causes
-# a 0 to be returned to indicate that more tests are likely to fail
-# as well.
-#
-# Args are:
#
-# First one is string to send to gdb
-# Second one is string to match gdb result to
-# Third one is an optional message to be printed
-
-proc test_print_accept { args } {
- global prompt
- global passcount
- global verbose
-
- if [llength $args]==3 then {
- set message [lindex $args 2]
- } else {
- set message [lindex $args 0]
- }
- set sendthis [lindex $args 0]
- set expectthis [lindex $args 1]
- if $verbose>2 then {
- send_user "Sending \"$sendthis\" to gdb\n"
- send_user "Looking to match \"$expectthis\"\n"
- send_user "Message is \"$message\"\n"
- }
- send "$sendthis\n"
- expect {
- -re ".* = $expectthis\r\n$prompt $" {
- incr passcount
- return 1
- }
- -re ".*$prompt $" {
- if ![string match "" $message] then {
- fail "$sendthis ($message)"
- } else {
- fail "$sendthis"
- }
- return 1
- }
- timeout {
- fail "$sendthis (timeout)"
- return 0
- }
- }
-}
+# 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 printing of a specific value. Increment passcount for
-# success or issue fail message for failure. In both cases, return
-# a 1 to indicate that more tests can proceed. However a timeout
-# is a serious error, generates a special fail message, and causes
-# a 0 to be returned to indicate that more tests are likely to fail
-# as well.
+# This file was adapted from old Chill tests by Stan Shebs
+# (shebs@cygnus.com).
-proc test_print_reject { args } {
- global prompt
- global passcount
- global verbose
+load_lib "fortran.exp"
- if [llength $args]==2 then {
- set expectthis [lindex $args 1]
- } else {
- set expectthis "should never match this bogus string"
- }
- set sendthis [lindex $args 0]
- if $verbose>2 then {
- send_user "Sending \"$sendthis\" to gdb\n"
- send_user "Looking to match \"$expectthis\"\n"
- }
- send "$sendthis\n"
- expect {
- -re ".*A .* in expression.*\\.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*Junk after end of expression.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*No symbol table is loaded.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*$expectthis.*$prompt $" {
- incr passcount
- return 1
- }
- -re ".*$prompt $" {
- fail "$sendthis not properly rejected"
- return 1
- }
- timeout {
- fail "$sendthis (timeout)"
- return 0
- }
- }
-}
+if { [skip_fortran_tests] } { continue }
proc test_integer_literal_types_accepted {} {
- global prompt
- global passcount
-
- set passcount 0
+ global gdb_prompt
# Test various decimal values.
-
- test_print_accept "pt 123" "integer"
-
- if $passcount then {
- pass "$passcount correct integer literal types printed"
- }
+ # Should be integer*4 probably.
+ gdb_test "pt 123" "type = int"
}
proc test_character_literal_types_accepted {} {
- global prompt
- global passcount
-
- set passcount 0
+ global gdb_prompt
# Test various character values.
- test_print_accept "pt 'a'" "character*1"
-
- if $passcount then {
- pass "$passcount correct character literal types printed"
- }
+ gdb_test "pt 'a'" "type = character\\*1"
}
proc test_integer_literal_types_rejected {} {
- global prompt
- global passcount
-
- set passcount 0
+ global gdb_prompt
test_print_reject "pt _"
-
- if $passcount then {
- pass "$passcount incorrect integer literal types rejected"
- }
}
proc test_logical_literal_types_accepted {} {
- global prompt
- global passcount
-
- set passcount 0
+ global gdb_prompt
# Test the only possible values for a logical, TRUE and FALSE.
- test_print_accept "pt .TRUE." "logical*2"
- test_print_accept "pt .FALSE." "logical*2"
-
- if $passcount then {
- pass "$passcount correct logical literal types printed"
- }
+ gdb_test "pt .TRUE." "type = logical\\*2"
+ gdb_test "pt .FALSE." "type = logical\\*2"
}
proc test_float_literal_types_accepted {} {
- global prompt
- global passcount
-
- set passcount 0
+ global gdb_prompt
# Test various floating point formats
- test_print_accept "pt .44" "real*8"
- test_print_accept "pt 44.0" "real*8"
- test_print_accept "pt 10D20" "1"
- test_print_accept "pt 10D20" "0"
- test_print_accept "pt 10d20" "1"
- test_print_accept "pt 10d20" "0"
- test_print_accept "pt 10E20" "real*8"
- test_print_accept "pt 10E20" "real*8"
- test_print_accept "pt 10e20" "real*8"
- test_print_accept "pt 10e20" "real*8"
-
- if $passcount then {
- pass "$passcount correct float literal comparisons"
- }
+ # this used to guess whether to look for "real*4" or
+ # "real*8" based on a target config variable, but noone
+ # maintained it properly.
+
+ gdb_test "pt .44" "type = real\\*\[0-9\]+"
+ gdb_test "pt 44.0" "type = real\\*\[0-9\]+"
+ gdb_test "pt 10D20" "type = real\\*\[0-9\]+"
+ gdb_test "pt 10D20" "type = real\\*\[0-9\]+"
+ gdb_test "pt 10d20" "type = real\\*\[0-9\]+"
+ gdb_test "pt 10d20" "type = real\\*\[0-9\]+"
+ gdb_test "pt 10E20" "type = real\\*\[0-9\]+"
+ gdb_test "pt 10E20" "type = real\\*\[0-9\]+"
+ gdb_test "pt 10e20" "type = real\\*\[0-9\]+"
+ gdb_test "pt 10e20" "type = real\\*\[0-9\]+"
}
# Start with a fresh gdb.
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
-send "set print sevenbit-strings\n" ; expect -re ".*$prompt $"
+gdb_test "set print sevenbit-strings" ""
if [set_lang_fortran] then {
test_integer_literal_types_accepted
test_character_literal_types_accepted
test_float_literal_types_accepted
} else {
- warning "$test_name tests suppressed."
+ warning "$test_name tests suppressed." 0
}
projects / external / binutils.git / blobdiff