1 # Copyright (C) 1994 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 2 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, write to the Free Software
15 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
17 # Please email any bugs, comments, and/or additions to this file to:
18 # bug-gdb@prep.ai.mit.edu
20 # This file was adapted from Chill tests by Stan Shebs (shebs@cygnus.com).
29 # Set the current language to fortran. This counts as a test. If it
30 # fails, then we skip the other tests.
32 proc set_lang_fortran {} {
35 send "set language fortran\n"
38 timeout { fail "set language fortran (timeout)" ; return 0 }
41 send "show language\n"
43 -re ".* source language is \"fortran\".*$prompt $" {
44 pass "set language to \"fortran\""
48 fail "setting language to \"fortran\""
52 fail "can't show language (timeout)"
58 # Testing printing of a specific value. Increment passcount for
59 # success or issue fail message for failure. In both cases, return
60 # a 1 to indicate that more tests can proceed. However a timeout
61 # is a serious error, generates a special fail message, and causes
62 # a 0 to be returned to indicate that more tests are likely to fail
67 # First one is string to send to gdb
68 # Second one is string to match gdb result to
69 # Third one is an optional message to be printed
71 proc test_print_accept { args } {
76 if [llength $args]==3 then {
77 set message [lindex $args 2]
79 set message [lindex $args 0]
81 set sendthis [lindex $args 0]
82 set expectthis [lindex $args 1]
84 send_user "Sending \"$sendthis\" to gdb\n"
85 send_user "Looking to match \"$expectthis\"\n"
86 send_user "Message is \"$message\"\n"
90 -re ".* = $expectthis\r\n$prompt $" {
95 if ![string match "" $message] then {
96 fail "$sendthis ($message)"
103 fail "$sendthis (timeout)"
109 # Testing printing of a specific value. Increment passcount for
110 # success or issue fail message for failure. In both cases, return
111 # a 1 to indicate that more tests can proceed. However a timeout
112 # is a serious error, generates a special fail message, and causes
113 # a 0 to be returned to indicate that more tests are likely to fail
116 proc test_print_reject { args } {
121 if [llength $args]==2 then {
122 set expectthis [lindex $args 1]
124 set expectthis "should never match this bogus string"
126 set sendthis [lindex $args 0]
128 send_user "Sending \"$sendthis\" to gdb\n"
129 send_user "Looking to match \"$expectthis\"\n"
133 -re ".*A .* in expression.*\\.*$prompt $" {
137 -re ".*Junk after end of expression.*$prompt $" {
141 -re ".*No symbol table is loaded.*$prompt $" {
145 -re ".*$expectthis.*$prompt $" {
150 fail "$sendthis not properly rejected"
154 fail "$sendthis (timeout)"
160 proc test_integer_literal_types_accepted {} {
166 # Test various decimal values.
168 test_print_accept "pt 123" "integer"
171 pass "$passcount correct integer literal types printed"
175 proc test_character_literal_types_accepted {} {
181 # Test various character values.
183 test_print_accept "pt 'a'" "character*1"
186 pass "$passcount correct character literal types printed"
190 proc test_integer_literal_types_rejected {} {
196 test_print_reject "pt _"
199 pass "$passcount incorrect integer literal types rejected"
203 proc test_logical_literal_types_accepted {} {
209 # Test the only possible values for a logical, TRUE and FALSE.
211 test_print_accept "pt .TRUE." "logical*2"
212 test_print_accept "pt .FALSE." "logical*2"
215 pass "$passcount correct logical literal types printed"
219 proc test_float_literal_types_accepted {} {
225 # Test various floating point formats
227 test_print_accept "pt .44" "real*8"
228 test_print_accept "pt 44.0" "real*8"
229 test_print_accept "pt 10D20" "1"
230 test_print_accept "pt 10D20" "0"
231 test_print_accept "pt 10d20" "1"
232 test_print_accept "pt 10d20" "0"
233 test_print_accept "pt 10E20" "real*8"
234 test_print_accept "pt 10E20" "real*8"
235 test_print_accept "pt 10e20" "real*8"
236 test_print_accept "pt 10e20" "real*8"
239 pass "$passcount correct float literal comparisons"
243 # Start with a fresh gdb.
247 gdb_reinitialize_dir $srcdir/$subdir
249 send "set print sevenbit-strings\n" ; expect -re ".*$prompt $"
251 if [set_lang_fortran] then {
252 test_integer_literal_types_accepted
253 test_integer_literal_types_rejected
254 test_logical_literal_types_accepted
255 test_character_literal_types_accepted
256 test_float_literal_types_accepted
258 warning "$test_name tests suppressed."