diff options
Diffstat (limited to 'tests/defs')
| -rw-r--r-- | tests/defs | 45 |
1 files changed, 23 insertions, 22 deletions
@@ -4,16 +4,17 @@ # and initially implemented by Mary Ann May-Pumphrey of Sun Microsystems. # # Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998 by Scriptics Corporation # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: defs,v 1.2 1998/09/14 18:23:45 stanton Exp $ +# RCS: @(#) $Id: defs,v 1.3 1998/12/04 04:19:12 hershey Exp $ -if ![info exists VERBOSE] { +if {![info exists VERBOSE]} { set VERBOSE 0 } -if ![info exists TESTS] { +if {![info exists TESTS]} { set TESTS {} } @@ -55,11 +56,11 @@ set testConfig(unix) $testConfig(unixOnly) set testConfig(mac) $testConfig(macOnly) set testConfig(pc) $testConfig(pcOnly) -set testConfig(unixOrPc) [expr $testConfig(unixOnly) || $testConfig(pcOnly)] -set testConfig(macOrPc) [expr $testConfig(macOnly) || $testConfig(pcOnly)] -set testConfig(macOrUnix) [expr $testConfig(macOnly) || $testConfig(unixOnly)] +set testConfig(unixOrPc) [expr {$testConfig(unixOnly) || $testConfig(pcOnly)}] +set testConfig(macOrPc) [expr {$testConfig(macOnly) || $testConfig(pcOnly)}] +set testConfig(macOrUnix) [expr {$testConfig(macOnly) || $testConfig(unixOnly)}] -set testConfig(nonPortable) [expr [file exists doAllTests] || [file exists DOALLT~1]] +set testConfig(nonPortable) [expr {[file exists doAllTests] || [file exists DOALLT~1]}] set testConfig(nt) [expr {$tcl_platform(os) == "Windows NT"}] set testConfig(95) [expr {$tcl_platform(os) == "Windows 95"}] @@ -68,18 +69,18 @@ set testConfig(win32s) [expr {$tcl_platform(os) == "Win32s"}] # The following config switches are used to mark tests that should work, # but have been temporarily disabled on certain platforms because they don't. -set testConfig(tempNotPc) [expr !$testConfig(pc)] -set testConfig(tempNotMac) [expr !$testConfig(mac)] -set testConfig(tempNotUnix) [expr !$testConfig(unix)] +set testConfig(tempNotPc) [expr {!$testConfig(pc)}] +set testConfig(tempNotMac) [expr {!$testConfig(mac)}] +set testConfig(tempNotUnix) [expr {!$testConfig(unix)}] # The following config switches are used to mark tests that crash on # certain platforms, so that they can be reactivated again when the # underlying problem is fixed. -set testConfig(pcCrash) [expr !$testConfig(pc)] -set testConfig(win32sCrash) [expr !$testConfig(win32s)] -set testConfig(macCrash) [expr !$testConfig(mac)] -set testConfig(unixCrash) [expr !$testConfig(unix)] +set testConfig(pcCrash) [expr {!$testConfig(pc)}] +set testConfig(win32sCrash) [expr {!$testConfig(win32s)}] +set testConfig(macCrash) [expr {!$testConfig(mac)}] +set testConfig(unixCrash) [expr {!$testConfig(unix)}] set testConfig(fonts) 1 catch {destroy .e} @@ -100,10 +101,10 @@ if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} { } if {$testConfig(nonPortable) == 0} { - puts "(will skip non-portable tests)" + puts stdout "(will skip non-portable tests)" } if {$testConfig(fonts) == 0} { - puts "(will skip font-sensitive tests: this system has unexpected font geometries)" + puts stdout "(will skip font-sensitive tests: this system has unexpected font geometries)" } trace variable testConfig r safeFetch @@ -231,7 +232,7 @@ proc test {name description script answer args} { if {$code != 0} { print_verbose $name $description $script $code $result } elseif {[string compare $result $answer] == 0} { - if {$VERBOSE} then { + if {$VERBOSE} { if {$VERBOSE > 0} { print_verbose $name $description $script $code $result } @@ -272,12 +273,12 @@ if {![winfo ismapped .]} { set tktest [info nameofexecutable] if {$tktest == "{}"} { set tktest {} - puts "Unable to find tktest executable, skipping multiple process tests." + puts stdout "Unable to find tktest executable, skipping multiple process tests." } # Create background process -proc setupbg {{args ""}} { +proc setupbg args { global tktest fd bgData if {$tktest == ""} { error "you're not running tktest so setupbg should not have been called" @@ -291,7 +292,7 @@ proc setupbg {{args ""}} { if {[gets $fd data] < 0} { error "unexpected EOF from \"$tktest\"" } - if [string compare $data foo] { + if {[string compare $data foo]} { error "unexpected output from background process \"$data\"" } fileevent $fd readable bgReady @@ -315,7 +316,7 @@ proc dobg {command} { proc bgReady {} { global fd bgData bgDone set x [gets $fd] - if [eof $fd] { + if {[eof $fd]} { fileevent $fd readable {} set bgDone 1 } elseif {$x == "**DONE**"} { @@ -354,7 +355,7 @@ proc fixfocus {} { proc makeFile {contents name} { set fd [open $name w] fconfigure $fd -translation lf - if {[string index $contents [expr [string length $contents] - 1]] == "\n"} { + if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} { puts -nonewline $fd $contents } else { puts $fd $contents |