diff options
author | jenn <jenn> | 1999-08-27 01:17:01 (GMT) |
---|---|---|
committer | jenn <jenn> | 1999-08-27 01:17:01 (GMT) |
commit | 0d3afa4a15d5f42159aca14b4ebd4cca85b91dfe (patch) | |
tree | 6ae58e358e0f7740049d30a1d2e5db4aa0c8bda0 /library/tcltest/tcltest.tcl | |
parent | 5091b794329105b393227690593b14fbfa6e37bc (diff) | |
download | tcl-0d3afa4a15d5f42159aca14b4ebd4cca85b91dfe.zip tcl-0d3afa4a15d5f42159aca14b4ebd4cca85b91dfe.tar.gz tcl-0d3afa4a15d5f42159aca14b4ebd4cca85b91dfe.tar.bz2 |
* tests/tcltest.test:
* library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a
variable named ::tcltest::parameters based on whatever's being
sent in as the argument to the -args flag.
Diffstat (limited to 'library/tcltest/tcltest.tcl')
-rw-r--r-- | library/tcltest/tcltest.tcl | 17 |
1 files changed, 12 insertions, 5 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 039c560..9d7bccc 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -12,7 +12,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: tcltest.tcl,v 1.9 1999/07/30 01:35:27 jenn Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.10 1999/08/27 01:17:04 jenn Exp $ package provide tcltest 1.0 @@ -64,6 +64,10 @@ namespace eval tcltest { variable debug 0 + # Save any arguments that we might want to pass through to other programs. + # This is used by the -args flag. + variable parameters {} + # Count the number of files tested (0 if all.tcl wasn't called). # The all.tcl file will set testSingleFile to false, so stats will # not be printed until all.tcl calls the cleanupTests proc. @@ -672,7 +676,7 @@ proc ::tcltest::processCmdLineArgs {} { # -help is not listed since it has already been processed lappend defaultFlags -verbose -match -skip -constraints \ -outfile -errfile -debug -tmpdir -file -notfile \ - -preservecore -limitconstraints + -preservecore -limitconstraints -args set defaultFlags [concat $defaultFlags \ [ ::tcltest::processCmdLineArgsAddFlagsHook ]] @@ -685,6 +689,11 @@ proc ::tcltest::processCmdLineArgs {} { } } + # Set ::tcltest::parameters to the arg of the -args flag, if given + if {[info exists flag(-args)]} { + set ::tcltest::parameters $flag(-args) + } + # Set ::tcltest::verbose to the arg of the -verbose flag, if given if {[info exists flag(-verbose)]} { @@ -1135,16 +1144,14 @@ proc ::tcltest::test {name description script expectedAnswer args} { if {[string match {*[$\[]*} $constraints] != 0} { # full expression, e.g. {$foo > [info tclversion]} catch {set doTest [uplevel #0 expr $constraints]} - } elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} { # something like {a || b} should be turned into # $::tcltest::testConstraints(a) || $::tcltest::testConstraints(b). - regsub -all {[.a-zA-Z0-9]+} $constraints \ + regsub -all {[.\w]+} $constraints \ {$::tcltest::testConstraints(&)} c catch {set doTest [eval expr $c]} } else { # just simple constraints such as {unixOnly fonts}. - set doTest 1 foreach constraint $constraints { if {(![info exists ::tcltest::testConstraints($constraint)]) \ |