Attachment "lazytest.patch" to
ticket [512214ffff]
added by
dgp
2002-06-06 22:21:21.
Index: doc/tcltest.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/tcltest.n,v
retrieving revision 1.17
diff -u -r1.17 tcltest.n
--- doc/tcltest.n 3 Jun 2002 23:44:32 -0000 1.17
+++ doc/tcltest.n 6 Jun 2002 15:13:54 -0000
@@ -28,7 +28,7 @@
.sp
\fBtcltest::interpreter \fI?interp?\fR
.sp
-\fBtcltest::singleProcess \fI?boolean?\fR
+\fBtcltest::singleProcess \fI?value?\fR
.sp
\fBtcltest::debug \fI?level?\fR
.sp
@@ -40,7 +40,7 @@
.sp
\fBtcltest::testConstraint \fIconstraint ?value?\fR
.sp
-\fBtcltest::limitConstraints \fI?constraintList?\fR
+\fBtcltest::limitConstraints \fI?value?\fR
.sp
\fBtcltest::workingDirectory \fI?dir?\fR
.sp
@@ -151,11 +151,11 @@
if singleProcess is set to false. The default value for interpreter
is the name of the interpreter in which the tests were started.
.TP
-\fBtcltest::singleProcess\fR \fI?boolean?\fR
+\fBtcltest::singleProcess\fR \fI?value?\fR
Sets or returns a boolean indicating whether test files should be sourced
into the current interpreter by runAllTests or run in their own
-processes. If \fIboolean\fR is true (1), tests are sourced into the
-current interpreter. If \fIboolean\fR is false (0), tests are run in
+processes. If \fIvalue\fR is true (1), tests are sourced into the
+current interpreter. If \fIvalue\fR is false (0), tests are run in
the interpreter specified in tcltest::interpreter. The default value
for tcltest::singleProcess is false.
.TP
@@ -232,11 +232,12 @@
Sets or returns the value associated with the named \fIconstraint\fR.
See the section \fI"Test constraints"\fR for more information.
.TP
-\fBtcltest::limitConstraints \fI?constraintList?\fR
+\fBtcltest::limitConstraints \fI?value?\fR
Sets or returns a boolean indicating whether testing is being limited
-to constraints listed in \fIconstraintList\fR.
-If limitConstraints is not false, only those tests with constraints matching
-values in \fIconstraintList\fR will be run.
+to the list of constraints specified by the \fB-constraints\fR
+command line option. If \fIvalue\fR is true, only those tests
+with constraints present in the list specified in the \fB-constraints\fR
+command line option.
.TP
\fBtcltest::workingDirectory\fR \fI?directoryName?\fR
Sets or returns the directory in which the test suite is being run.
@@ -934,10 +935,6 @@
process the additional flags that you told the harness about in
tcltest::processCmdLineArgsFlagHook.
.TP
-\fBtcltest::initConstraintsHook\fR
-used to add additional built-in constraints to those already defined
-by \fBtcltest\fR.
-.TP
\fBtcltest::cleanupTestsHook\fR
do additional cleanup
.PP
@@ -971,19 +968,6 @@
tcltest::PrintUsageInfoHook proc. Within this proc, you should
print out additional usage information for any flags that you've
implemented.
-.PP
-To add new built-in
-constraints to the test harness, define your own version of
-\fBtcltest::initConstraintsHook\fR.
-Within your proc, you can add to the \fBtcltest::testConstraints\fR array.
-For example:
-.DS
-proc tcltest::initConstraintsHook {} {
- set tcltest::testConstraints(win95Or98) \\
- [expr {$tcltest::testConstraints(95) || \\
- $tcltest::testConstraints(98)}]
-}
-.DE
.PP
Finally, if you want to add additional cleanup code to your harness
you can define your own \fBtcltest::cleanupTestsHook\fR. For example:
Index: library/tcltest/tcltest.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/tcltest/tcltest.tcl,v
retrieving revision 1.52
diff -u -r1.52 tcltest.tcl
--- library/tcltest/tcltest.tcl 5 Jun 2002 01:12:38 -0000 1.52
+++ library/tcltest/tcltest.tcl 6 Jun 2002 15:13:56 -0000
@@ -131,9 +131,14 @@
# predefined constraints (see the explanation for the
# InitConstraints proc for more details).
ArrayDefault testConstraints {}
+ Default ConstraintsSpecifiedByCommandLineArgument {}
+
+ # Kept only for compatibility
Default constraintsSpecified {}
+ trace variable constraintsSpecified r {set ::tcltest::constraintsSpecified \
+ [array names ::tcltest::testConstraints] ;# }
- # Don't run only the constrained tests by default
+ # Don't run only the "-constraint" specified tests by default
Default limitConstraints false
# A test application has to know how to load the tested commands
@@ -434,7 +439,7 @@
foreach var {
match skip matchFiles skipFiles matchDirectories
skipDirectories preserveCore debug loadScript singleProcess
- mainThread
+ mainThread ConstraintsSpecifiedByCommandLineArgument
} {
proc $var { {new ""} } [subst -nocommands {
variable $var
@@ -667,25 +672,29 @@
# content of tcltest::testConstraints($constraint)
#
# Side effects:
-# appends the constraint name to tcltest::constraintsSpecified
+# none
proc tcltest::testConstraint {constraint {value ""}} {
variable testConstraints
- variable constraintsSpecified
DebugPuts 3 "entering testConstraint $constraint $value"
if {[llength [info level 0]] == 2} {
return $testConstraints($constraint)
}
- lappend constraintsSpecified $constraint
+ # Check for boolean values
+ if {[catch {expr {$value && $value}} msg]} {
+ return -code error $msg
+ }
set testConstraints($constraint) $value
}
# tcltest::limitConstraints --
#
-# sets the limited constraints to tcltest::limitConstraints
+# sets/gets flag indicating whether tests run are limited only
+# to those matching constraints specified by the -constraints
+# command line option.
#
# Arguments:
-# list of constraint names
+# new boolean value for the flag
#
# Results:
# content of tcltest::limitConstraints
@@ -693,17 +702,22 @@
# Side effects:
# None.
-proc tcltest::limitConstraints { {constraintList ""} } {
- variable constraintsSpecified
+proc tcltest::limitConstraints { {value ""} } {
variable testConstraints
variable limitConstraints
- DebugPuts 3 "entering limitConstraints $constraintList"
+ DebugPuts 3 "entering limitConstraints $value"
if {[llength [info level 0]] == 1} {
return $limitConstraints
}
- set limitConstraints $constraintList
+ # Check for boolean values
+ if {[catch {expr {$value && $value}} msg]} {
+ return -code error $msg
+ }
+ set limitConstraints $value
+ if {!$limitConstraints} {return $limitConstraints}
foreach elt [array names testConstraints] {
- if {[lsearch -exact $constraintsSpecified $elt] == -1} {
+ if {[lsearch -exact [ConstraintsSpecifiedByCommandLineArgument] $elt]
+ == -1} {
testConstraint $elt 0
}
}
@@ -951,10 +965,6 @@
return
}
-if {[llength [info commands tcltest::initConstraintsHook]] == 0} {
- proc tcltest::initConstraintsHook {} {}
-}
-
# tcltest::SafeFetch --
#
# The following trace procedure makes it so that we can safely
@@ -981,16 +991,44 @@
DebugPuts 3 "entering SafeFetch $n1 $n2 $op"
if {[string equal {} $n2]} {return}
if {![info exists testConstraints($n2)]} {
- testConstraint $n2 0
+ if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
+ testConstraint $n2 0
+ }
}
}
+# tcltest::ConstraintInitializer --
+#
+# Get or set a script that when evaluated in the tcltest namespace
+# will return a boolean value with which to initialize the
+# associated constraint.
+#
+# Arguments:
+# constraint - name of the constraint initialized by the script
+# script - the initializer script
+#
+# Results
+# boolean value of the constraint - enabled or disabled
+#
+# Side effects:
+# Constraint is initialized for future reference by [test]
+proc tcltest::ConstraintInitializer {constraint {script ""}} {
+ variable ConstraintInitializer
+ DebugPuts 3 "entering ConstraintInitializer $constraint $script"
+ if {[llength [info level 0]] == 2} {
+ return $ConstraintInitializer($constraint)
+ }
+ # Check for boolean values
+ if {![info complete $script]} {
+ return -code error "ConstraintInitializer must be complete script"
+ }
+ set ConstraintInitializer($constraint) $script
+}
+
# tcltest::InitConstraints --
#
-# Check constraint information that will determine which tests to run.
-# To do this, create an array testConstraints. Each element has a value
-# of 0 or 1. If the element is "true" then tests with that constraint
-# will be run, otherwise tests with that constraint will be skipped.
+# Call all registered constraint initializers to force initialization
+# of all known constraints.
# See the tcltest man page for the list of built-in constraints defined
# in this procedure.
#
@@ -1006,118 +1044,109 @@
#
proc tcltest::InitConstraints {} {
- global tcl_platform tcl_interactive tk_version
- variable testConstraints
-
- # Safely refer to non-existent members of the testConstraints array
- # without causing an error.
- trace variable testConstraints r [namespace code SafeFetch]
-
+ variable ConstraintInitializer
initConstraintsHook
+ foreach constraint [array names ConstraintInitializer] {
+ testConstraint $constraint
+ }
+}
- testConstraint singleTestInterp [singleProcess]
+proc tcltest::DefineConstraintInitializers {} {
+ ConstraintInitializer singleTestInterp {singleProcess}
# All the 'pc' constraints are here for backward compatibility and
# are not documented. They have been replaced with equivalent 'win'
# constraints.
- testConstraint unixOnly [string equal $tcl_platform(platform) unix]
- testConstraint macOnly \
- [string equal $tcl_platform(platform) macintosh]
- testConstraint pcOnly [string equal $tcl_platform(platform) windows]
- testConstraint winOnly \
- [string equal $tcl_platform(platform) windows]
-
- testConstraint unix [testConstraint unixOnly]
- testConstraint mac [testConstraint macOnly]
- testConstraint pc [testConstraint pcOnly]
- testConstraint win [testConstraint winOnly]
-
- testConstraint unixOrPc \
- [expr {[testConstraint unix] || [testConstraint pc]}]
- testConstraint macOrPc \
- [expr {[testConstraint mac] || [testConstraint pc]}]
- testConstraint unixOrWin \
- [expr {[testConstraint unix] || [testConstraint win]}]
- testConstraint macOrWin \
- [expr {[testConstraint mac] || [testConstraint win]}]
- testConstraint macOrUnix \
- [expr {[testConstraint mac] || [testConstraint unix]}]
-
- testConstraint nt [string equal $tcl_platform(os) "Windows NT"]
- testConstraint 95 [string equal $tcl_platform(os) "Windows 95"]
- testConstraint 98 [string equal $tcl_platform(os) "Windows 98"]
+ ConstraintInitializer unixOnly \
+ {string equal $::tcl_platform(platform) unix}
+ ConstraintInitializer macOnly \
+ {string equal $::tcl_platform(platform) macintosh}
+ ConstraintInitializer pcOnly \
+ {string equal $::tcl_platform(platform) windows}
+ ConstraintInitializer winOnly \
+ {string equal $::tcl_platform(platform) windows}
+
+ ConstraintInitializer unix {testConstraint unixOnly}
+ ConstraintInitializer mac {testConstraint macOnly}
+ ConstraintInitializer pc {testConstraint pcOnly}
+ ConstraintInitializer win {testConstraint winOnly}
+
+ ConstraintInitializer unixOrPc \
+ {expr {[testConstraint unix] || [testConstraint pc]}}
+ ConstraintInitializer macOrPc \
+ {expr {[testConstraint mac] || [testConstraint pc]}}
+ ConstraintInitializer unixOrWin \
+ {expr {[testConstraint unix] || [testConstraint win]}}
+ ConstraintInitializer macOrWin \
+ {expr {[testConstraint mac] || [testConstraint win]}}
+ ConstraintInitializer macOrUnix \
+ {expr {[testConstraint mac] || [testConstraint unix]}}
+
+ ConstraintInitializer nt {string equal $tcl_platform(os) "Windows NT"}
+ ConstraintInitializer 95 {string equal $tcl_platform(os) "Windows 95"}
+ ConstraintInitializer 98 {string equal $tcl_platform(os) "Windows 98"}
# The following Constraints switches are used to mark tests that
# should work, but have been temporarily disabled on certain
# platforms because they don't and we haven't gotten around to
# fixing the underlying problem.
- testConstraint tempNotPc [expr {![testConstraint pc]}]
- testConstraint tempNotWin [expr {![testConstraint win]}]
- testConstraint tempNotMac [expr {![testConstraint mac]}]
- testConstraint tempNotUnix [expr {![testConstraint unix]}]
+ ConstraintInitializer tempNotPc {expr {![testConstraint pc]}}
+ ConstraintInitializer tempNotWin {expr {![testConstraint win]}}
+ ConstraintInitializer tempNotMac {expr {![testConstraint mac]}}
+ ConstraintInitializer tempNotUnix {expr {![testConstraint unix]}}
# The following Constraints switches are used to mark tests that
# crash on certain platforms, so that they can be reactivated again
# when the underlying problem is fixed.
- testConstraint pcCrash [expr {![testConstraint pc]}]
- testConstraint winCrash [expr {![testConstraint win]}]
- testConstraint macCrash [expr {![testConstraint mac]}]
- testConstraint unixCrash [expr {![testConstraint unix]}]
+ ConstraintInitializer pcCrash {expr {![testConstraint pc]}}
+ ConstraintInitializer winCrash {expr {![testConstraint win]}}
+ ConstraintInitializer macCrash {expr {![testConstraint mac]}}
+ ConstraintInitializer unixCrash {expr {![testConstraint unix]}}
# Skip empty tests
- testConstraint emptyTest 0
+ ConstraintInitializer emptyTest {format 0}
# By default, tests that expose known bugs are skipped.
- testConstraint knownBug 0
+ ConstraintInitializer knownBug {format 0}
# By default, non-portable tests are skipped.
- testConstraint nonPortable 0
+ ConstraintInitializer nonPortable {format 0}
# Some tests require user interaction.
- testConstraint userInteraction 0
+ ConstraintInitializer userInteraction {format 0}
# Some tests must be skipped if the interpreter is not in
# interactive mode
- if {[info exists tcl_interactive]} {
- testConstraint interactive $tcl_interactive
- } else {
- testConstraint interactive 0
- }
+ ConstraintInitializer interactive \
+ {expr {[info exists ::tcl_interactive] && $::tcl_interactive}}
# Some tests can only be run if the installation came from a CD
# image instead of a web image. Some tests must be skipped if you
# are running as root on Unix. Other tests can only be run if you
# are running as root on Unix.
- testConstraint root 0
- testConstraint notRoot 1
- if {[string equal unix $tcl_platform(platform)]
- && ([string equal root $tcl_platform(user)]
- || [string equal "" $tcl_platform(user)])} {
- testConstraint root 1
- testConstraint notRoot 0
- }
+ ConstraintInitializer root {expr \
+ {[string equal unix $::tcl_platform(platform)]
+ && ([string equal root $::tcl_platform(user)]
+ || [string equal "" $::tcl_platform(user)])}}
+ ConstraintInitializer notRoot {expr {![testConstraint root]}}
# Set nonBlockFiles constraint: 1 means this platform supports
# setting files into nonblocking mode.
- if {[catch {set f [open defs r]}]} {
- testConstraint nonBlockFiles 1
- } else {
- if {[catch {fconfigure $f -blocking off}] == 0} {
- testConstraint nonBlockFiles 1
- } else {
- testConstraint nonBlockFiles 0
- }
- close $f
+ ConstraintInitializer nonBlockFiles {
+ set code [expr {[catch {set f [open defs r]}]
+ || [catch {fconfigure $f -blocking off}]}]
+ catch {close $f}
+ set code
}
# Set asyncPipeClose constraint: 1 means this platform supports
@@ -1127,94 +1156,82 @@
# potential problem with select is apparently interfering.
# (Mark Diekhans).
- testConstraint asyncPipeClose 1
- if {[string equal unix $tcl_platform(platform)] && ([catch {
- exec uname -X | fgrep {Release = 3.2v}}] == 0)} {
- testConstraint asyncPipeClose 0
- }
+ ConstraintInitializer asyncPipeClose {expr {
+ !([string equal unix $::tcl_platform(platform)]
+ && ([catch {exec uname -X | fgrep {Release = 3.2v}}] == 0))}}
# Test to see if we have a broken version of sprintf with respect
# to the "e" format of floating-point numbers.
- testConstraint eformat 1
- if {![string equal [format %g 5e-5] 5e-05]} {
- testConstraint eformat 0
- }
+ ConstraintInitializer eformat {string equal [format %g 5e-5] 5e-05}
# Test to see if execed commands such as cat, echo, rm and so forth
# are present on this machine.
- testConstraint unixExecs 1
- if {[string equal macintosh $tcl_platform(platform)]} {
- testConstraint unixExecs 0
- }
- if {[testConstraint unixExecs]
- && [string equal windows $tcl_platform(platform)]} {
- set file "_tcl_test_remove_me.txt"
- if {[catch {
- set fid [open $file w]
- puts $fid "hello"
- close $fid
- }]} {
- testConstraint unixExecs 0
- } elseif {
- [catch {exec cat $file}] ||
- [catch {exec echo hello}] ||
- [catch {exec sh -c echo hello}] ||
- [catch {exec wc $file}] ||
- [catch {exec sleep 1}] ||
- [catch {exec echo abc > $file}] ||
- [catch {exec chmod 644 $file}] ||
- [catch {exec rm $file}] ||
- [string equal {} [auto_execok mkdir]] ||
- [string equal {} [auto_execok fgrep]] ||
- [string equal {} [auto_execok grep]] ||
- [string equal {} [auto_execok ps]]
+ ConstraintInitializer unixExecs {
+ set code 1
+ if {[string equal macintosh $::tcl_platform(platform)]} {
+ set code 0
+ }
+ if {[string equal windows $::tcl_platform(platform)]} {
+ if {[catch {
+ set file _tcl_test_remove_me.txt
+ makeFile {hello} $file
+ }]} {
+ set code 0
+ } elseif {
+ [catch {exec cat $file}] ||
+ [catch {exec echo hello}] ||
+ [catch {exec sh -c echo hello}] ||
+ [catch {exec wc $file}] ||
+ [catch {exec sleep 1}] ||
+ [catch {exec echo abc > $file}] ||
+ [catch {exec chmod 644 $file}] ||
+ [catch {exec rm $file}] ||
+ [llength [auto_execok mkdir]] == 0 ||
+ [llength [auto_execok fgrep]] == 0 ||
+ [llength [auto_execok grep]] == 0 ||
+ [llength [auto_execok ps]] == 0
} {
- testConstraint unixExecs 0
- }
- file delete -force $file
- }
-
- # Locate tcltest executable
- if {![info exists tk_version]} {
- interpreter [info nameofexecutable]
+ set code 0
+ }
+ removeFile $file
+ }
+ set code
}
- testConstraint stdio 0
- catch {
- catch {file delete -force tmp}
- set f [open tmp w]
- puts $f {
- exit
+ ConstraintInitializer stdio {
+ set code 0
+ if {![catch {set f [open "|[list [interpreter]]" w]}]} {
+ if {![catch {puts $f exit}]} {
+ if {![catch {close $f}]} {
+ set code 1
+ }
+ }
}
- close $f
-
- set f [open "|[list [interpreter] tmp]" r]
- close $f
-
- testConstraint stdio 1
+ set code
}
- catch {file delete -force tmp}
# Deliberately call socket with the wrong number of arguments. The
# error message you get will indicate whether sockets are available
# on this system.
- catch {socket} msg
- testConstraint socket [string compare $msg \
- "sockets are not available on this system"]
+ ConstraintInitializer socket {
+ catch {socket} msg
+ string compare $msg "sockets are not available on this system"
+ }
# Check for internationalization
-
- if {[llength [info commands testlocale]] == 0} {
- # No testlocale command, no tests...
- testConstraint hasIsoLocale 0
- } else {
- testConstraint hasIsoLocale \
- [string length [SetIso8859_1_Locale]]
- RestoreLocale
+ ConstraintInitializer hasIsoLocale {
+ if {[llength [info commands testlocale]] == 0} {
+ set code 0
+ } else {
+ set code [string length [SetIso8859_1_Locale]]
+ RestoreLocale
+ }
+ set code
}
+
}
#####################################################################
@@ -1399,12 +1416,12 @@
# Use the -constraints flag, if given, to turn on constraints that
# are turned off by default: userInteractive knownBug nonPortable.
- # This code fragment must be run after constraints are initialized.
if {[info exists flag(-constraints)]} {
foreach elt $flag(-constraints) {
testConstraint $elt 1
}
+ ConstraintsSpecifiedByCommandLineArgument $flag(-constraints)
}
# Use the -limitconstraints flag, if given, to tell the harness to
@@ -2220,7 +2237,6 @@
variable numTests
variable skip
variable match
- variable limitConstraints
variable testConstraints
variable originalTclPlatform
variable coreModTime
@@ -2264,7 +2280,7 @@
if {[string equal {} $constraints]} {
# If we're limited to the listed constraints and there aren't
# any listed, then we shouldn't run the test.
- if {$limitConstraints} {
+ if {[limitConstraints]} {
AddToSkippedBecause userSpecifiedLimitConstraint
if {$testLevel == 1} {
incr numTests(Skipped)
@@ -3309,7 +3325,25 @@
# Initialize the constraints and set up command line arguments
namespace eval tcltest {
- InitConstraints
+ # Define initializers for all the built-in contraint definitions
+ DefineConstraintInitializers
+
+ # Set up the constraints in the testConstraints array to be lazily
+ # initialized by a registered initializer, or by "false" if no
+ # initializer is registered.
+ trace variable testConstraints r [namespace code SafeFetch]
+
+ # Only initialize constraints at package load time if an
+ # [initConstraintsHook] has been pre-defined. This is only
+ # for compatibility support. The modern way to add a custom
+ # test constraint is to just call the [testConstraint] command
+ # straight away, without all this "hook" nonsense.
+ if {[string equal [namespace current] \
+ [namespace qualifiers [namespace which initConstraintsHook]]]} {
+ InitConstraints
+ } else {
+ proc initConstraintsHook {} {}
+ }
ProcessCmdLineArgs
# Save the names of files that already exist in
Index: tests/tcltest.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/tcltest.test,v
retrieving revision 1.23
diff -u -r1.23 tcltest.test
--- tests/tcltest.test 5 Jun 2002 01:12:38 -0000 1.23
+++ tests/tcltest.test 6 Jun 2002 15:13:57 -0000
@@ -213,7 +213,7 @@
}
# -constraints, -limitconstraints, [testConstraint],
-# [constraintsSpecified], [constraintList], [limitConstraints]
+# $constraintsSpecified, [limitConstraints]
test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} {
set result [catch {exec [interpreter] test.tcl -constraints knownBug -verbose 'ps'} msg]
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
@@ -236,29 +236,31 @@
-cleanup {unset ::tcltest::testConstraints(tcltestFakeConstraint)}
}
-test tcltest-5.4 {tcltest::constraintsSpecified} {
- -setup {
- set constraintlist $::tcltest::constraintsSpecified
- set ::tcltest::constraintsSpecified {}
- }
- -body {
- set r1 $::tcltest::constraintsSpecified
- testConstraint tcltestFakeConstraint1 1
- set r2 $::tcltest::constraintsSpecified
- testConstraint tcltestFakeConstraint2 1
- set r3 $::tcltest::constraintsSpecified
- list $r1 $r2 $r3
- }
- -result {{} tcltestFakeConstraint1 {tcltestFakeConstraint1 tcltestFakeConstraint2}}
- -cleanup {
- set ::tcltest::constraintsSpecified $constraintlist
- unset ::tcltest::testConstraints(tcltestFakeConstraint1)
- unset ::tcltest::testConstraints(tcltestFakeConstraint2)
- }
-}
+# Removed this test of internals of tcltest. Those internals have changed.
+#test tcltest-5.4 {tcltest::constraintsSpecified} {
+# -setup {
+# set constraintlist $::tcltest::constraintsSpecified
+# set ::tcltest::constraintsSpecified {}
+# }
+# -body {
+# set r1 $::tcltest::constraintsSpecified
+# testConstraint tcltestFakeConstraint1 1
+# set r2 $::tcltest::constraintsSpecified
+# testConstraint tcltestFakeConstraint2 1
+# set r3 $::tcltest::constraintsSpecified
+# list $r1 $r2 $r3
+# }
+# -result {{} tcltestFakeConstraint1 {tcltestFakeConstraint1 tcltestFakeConstraint2}}
+# -cleanup {
+# set ::tcltest::constraintsSpecified $constraintlist
+# unset ::tcltest::testConstraints(tcltestFakeConstraint1)
+# unset ::tcltest::testConstraints(tcltestFakeConstraint2)
+# }
+#}
-test tcltest-5.5 {tcltest::constraintList} \
- -constraints {!$::tcltest::testConstraints(singleTestInterp)} \
+test tcltest-5.5 {InitConstraints: list of built-in constraints} \
+ -constraints {!singleTestInterp} \
+ -setup {tcltest::InitConstraints} \
-body { lsort [array names ::tcltest::testConstraints] } \
-result [lsort {
95 98 asyncPipeClose eformat emptyTest hasIsoLocale interactive knownBug
@@ -268,23 +270,26 @@
unixOrWin userInteraction win winCrash winOnly
}]
-test tcltest-5.6 {tcltest::limitConstraints} {
- -setup {
- set keeplc $::tcltest::limitConstraints
- set keepkb [testConstraint knownBug]
- }
- -body {
- set r1 [limitConstraints]
- set r2 [limitConstraints knownBug]
- set r3 [limitConstraints]
- list $r1 $r2 $r3
- }
- -cleanup {
- limitConstraints $keeplc
- testConstraint knownBug $keepkb
- }
- -result {false knownBug knownBug}
-}
+# Removed this broken test. Its usage of [limitConstraints] was not
+# in agreement with the documentation. [limitConstraints] is supposed
+# to take an optional boolean argument, and "knownBug" ain't no boolean!
+#test tcltest-5.6 {tcltest::limitConstraints} {
+# -setup {
+# set keeplc $::tcltest::limitConstraints
+# set keepkb [testConstraint knownBug]
+# }
+# -body {
+# set r1 [limitConstraints]
+# set r2 [limitConstraints knownBug]
+# set r3 [limitConstraints]
+# list $r1 $r2 $r3
+# }
+# -cleanup {
+# limitConstraints $keeplc
+# testConstraint knownBug $keepkb
+# }
+# -result {false knownBug knownBug}
+#}
# -outfile, -errfile, [outputChannel], [outputFile], [errorChannel], [errorFile]
set printerror [makeFile {
