diff options
Diffstat (limited to 'tests/defs.tcl')
| -rw-r--r-- | tests/defs.tcl | 32 |
1 files changed, 20 insertions, 12 deletions
diff --git a/tests/defs.tcl b/tests/defs.tcl index d5aff5c..bc5f1c2 100644 --- a/tests/defs.tcl +++ b/tests/defs.tcl @@ -11,7 +11,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: defs.tcl,v 1.6 1999/06/19 00:59:01 jenn Exp $ +# RCS: @(#) $Id: defs.tcl,v 1.7 1999/12/14 06:53:12 hobbs Exp $ # Initialize wish shell @@ -39,17 +39,12 @@ namespace eval tcltest { namespace export $proc } - # ::tcltest::verbose defaults to "b" - - variable verbose "b" - - # match defaults to the empty list - - variable match {} - - # skip defaults to the empty list - - variable skip {} + # setup ::tcltest default vars + foreach {var default} {verbose b match {} skip {}} { + if {![info exists $var]} { + variable $var $default + } + } # Tests should not rely on the current working directory. # Files that are part of the test suite should be accessed relative to @@ -101,6 +96,7 @@ namespace eval tcltest { variable ::tcltest::mainThread 1 if {[info commands testthread] != {}} { + puts "Tk with threads enabled is known to have problems with X" set ::tcltest::mainThread [testthread names] } } @@ -206,6 +202,18 @@ proc ::tcltest::initConfig {} { if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} { set ::tcltest::testConfig(fonts) 0 } + + # Test to see if we have are running Unix apps on Exceed, + # which won't return font failures (Windows-like), which is + # not what we want from ann X server (other Windows X servers + # operate as expected) + + set ::tcltest::testConfig(noExceed) 1 + if {$::tcltest::testConfig(unixOnly) && \ + [catch {font actual "\{xyz"}] == 0} { + puts "Running X app on Exceed, skipping problematic font tests..." + set ::tcltest::testConfig(noExceed) 0 + } } # Skip empty tests |