diff options
Diffstat (limited to 'tests')
121 files changed, 597 insertions, 1872 deletions
diff --git a/tests/README b/tests/README index e8fb992..0c3b3cf 100644 --- a/tests/README +++ b/tests/README @@ -1,19 +1,12 @@ README -- Tcl test suite design document. -RCS: @(#) $Id: README,v 1.5 1999/04/21 21:50:29 rjohnson Exp $ +RCS: @(#) $Id: README,v 1.6 1999/06/26 03:54:09 jenn Exp $ Contents: --------- 1. Introduction - 2. Definitions file - 3. Writing a new test - 4. Constraints - 5. Adding a New Test File - 6. Test output - 7. Selecting tests for execution within a file - 8. Selecting files to be sourced by all.tcl - 9. Incompatibilities with prior Tcl versions + 2. Incompatibilities with prior Tcl versions 1. Introduction: ---------------- @@ -64,229 +57,17 @@ You can run the tests in three ways: ::tcltest::testConfig(knownBug) ::tcltest::testConfig(userInteractive) -In all cases, no output will be generated if all goes well, except for -a listing of the test files and a statistical summary. If there are -errors, then additional messages will appear in the format described -below. Note that some tests will be skipped if you run as superuser. +Please see the tcltest man page for more information regarding how to +write and run tests. -This approach to testing was designed and initially implemented by -Mary Ann May-Pumphrey of Sun Microsystems in the early 1990's. Many -thanks to her for donating her work back to the public Tcl release. - - -2. Definitions file: --------------------- - -The file "defs.tcl" defines the "tcltest" namespace which contains a -collection of procedures and variables used to run the tests. It is -read in automatically by each of the .test files if needed, but once -it has been read once it will not be read again by the .test files. -Currently, the following procedures are exported from the "tcltest" -namespace and automatically imported: - - test Run a test script. - - cleanupTests Print stats and remove files created by tests. - - dotests Source a test file and run tests of the - specified pattern. - - makeFile Create a file--the file will automatically - be removed by cleanupTests. - - removeFile Force a file to be removed. - - makeDirectory Create a directory--the directory will - automatically be removed by cleanupTests. - - removeDirectory Force a directory to be removed. - - viewFile Returns the contents of a file. - - normalizeMsg Remove extra newlines from a string. - - bytestring Construct a string that consists of the - requested sequence of bytes, as opposed to a - string of properly formed UTF-8 characters. - - set_iso8859_1_locale Set the locale to iso8859_1. - - restore_locale Restore the locale to its original setting. - - saveState Save the procedure and global variable names. - - restoreState Restore the procedure and global variable names. - - threadReap Kill all threads except for the main thread. - -Please refer to the defs.tcl file for more documentation on these -procedures. - - -3. Writing a new test: ----------------------- - -The test procedure runs a test script and prints an error message if -the script's result does not match the expected result. The following -is the spec for the "test" command: - - test <name> <description> ?<constraint>? <script> <expectedAnswer> - -The <name> argument should follow the pattern, -"<target>-<majorNum>.<minorNum>". For white-box (regression) tests, -the target should be the name of the c function or Tcl procedure being -tested. For black-box tests, the target should be the name of the -feature being tested. Related tests should share a major number. - -The <description> argument is a short textual description of the test, -to help humans understand what it does. - -The optional <constraints> argument is list of one or more keywords, -each of which must be the name of an element in the array -"::tcltest::testConfig". If any of these elements is false or does -not exist, the test is skipped. Add appropriate constraints (e.g., -unixOnly) to any tests that should not always be run. For example, a -test that should only be run on Unix should look like the following: - - test getAttribute-1.1 {testing file permissions} {unixOnly} { - lindex [file attributes foo.tcl] 5 - } {00644} - -See the "Constraints" section for a list of built-in -constraints and information on how to add your own constraints. - -The <script> argument contains the script to run to carry out the -test. It must return a result that can be checked for correctness. -If your script requires that a file be created on the fly, please use -the ::tcltest::makeFile procedure. If your test requires that a small -file (<50 lines) be checked in, please consider creating the file on -the fly using the ::tcltest::makeFile procedure. Files created by the -::tcltest::makeFile procedure will automatically be removed by the -::tcltest::cleanupTests call at the end of each test file. - -The <expectedAnswer> argument will be compared against the result of -evaluating the <script> argument. If they match, the test passes, -otherwise the test fails. - - -4. Constraints: ---------------- - -Constraints are used to determine whether a test should be skipped. -Each constraint is stored as an index in the array -::tcltest::testConfig. For example, the unixOnly constraint is -defined as the following: - - set ::tcltest::testConfig(unixOnly) \ - [expr {$tcl_platform(platform) == "unix"}] - -If a test is constrained by "unixOnly", then it will only be run if -the value of ::tcltest::testConfig(unixOnly) is true. - -The following is a list of constraints defined in the defs.tcl file: - -unix test can only be run on any UNIX platform -pc test can only be run on any Windows platform -nt test can only be run on any Windows NT platform -95 test can only be run on any Windows 95 platform -mac test can only be run on any Mac platform -unixOrPc test can only be run on a UNIX or PC platform -macOrPc test can only be run on a Mac or PC platform -macOrUnix test can only be run on a Mac or UNIX platform -tempNotPc test can not be run on Windows. This flag is used - to temporarily disable a test. -tempNotMac test can not be run on a Mac. This flag is used - to temporarily disable a test. -unixCrash test crashes if it's run on UNIX. This flag is used - to temporarily disable a test. -pcCrash test crashes if it's run on Windows. This flag is - used to temporarily disable a test. -macCrash test crashes if it's run on a Mac. This flag is used - to temporarily disable a test. - -emptyTest test is empty, and so not worth running, but - it remains as a place-holder for a test to be - written in the future. This constraint always - causes tests to be skipped. - -knownBug test is known to fail and the bug is not yet - fixed. This constraint always causes tests to be - skipped unless the user specifies otherwise. See the - "Introduction" section for more details. - -nonPortable test can only be run in the master Tcl/Tk - development environment. Some tests are inherently - non-portable because they depend on things like word - length, file system configuration, window manager, - etc. These tests are only run in the main Tcl - development directory where the configuration is - well known. This constraint always causes tests to be - skipped unless the user specifies otherwise. See the - "Introduction" section for more details. - -userInteraction test requires interaction from the user. This - constraint always causes tests to be skipped unless - the user specifies otherwise. See the "Introduction" - section for more details. - -interactive test can only be run in if the interpreter is in - interactive mode, that is the global tcl_interactive - variable is set to 1. - -nonBlockFiles test can only be run if platform supports setting - files into nonblocking mode - -asyncPipeClose test can only be run if platform supports async - flush and async close on a pipe - -unixExecs test can only be run if this machine has commands - such as 'cat', 'echo', etc. available. - -hasIsoLocale test can only be run if can switch to an ISO locale - -fonts test can only be run if the wish app's fonts can - be controlled by Tk. - -root test can only run if Unix user is root - -notRoot test can only run if Unix user is not root - -eformat test can only run if app has a working version of - sprintf with respect to the "e" format of - floating-point numbers. - -stdio test can only be run if the current app can be - spawned via a pipe - - -5. Adding a new test file: --------------------------- - -Tests files should begin by sourcing the defs.tcl file: - - if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] - } - -Test files sould end by cleaning up after themselves and calling -::tcltest::cleanupTests. The ::tcltest::cleanupTests procedure prints -statistics about the number of tests that passed, skipped, and failed, -and removes all files that were created using the ::tcltest::makeFile -and ::tcltest::makeDirectory procedures. - - # Remove files created by these tests - # Change to original working directory - # Unset global arrays - ::tcltest::cleanupTests - return - -The all.tcl file will source your new test file if the filename -matches the tests/*.test pattern (as it should). The names of test -files that contain regression (or glass-box) tests should correspond -to the Tcl or C code file that they are testing. For example, the -test file for the C file "tclCmdAH.c" is "cmdAH.test". Test files -that contain black-box tests may not correspond to any Tcl or C code -file so they should match the pattern "*_bb.test". +Please note that the all.tcl file will source your new test file if +the filename matches the tests/*.test pattern (as it should). The +names of test files that contain regression (or glass-box) tests +should correspond to the Tcl or C code file that they are testing. +For example, the test file for the C file "tclCmdAH.c" is +"cmdAH.test". Test files that contain black-box tests may not +correspond to any Tcl or C code file so they should match the pattern +"*_bb.test". Be sure your new test file can be run from any working directory. @@ -297,99 +78,7 @@ as well as an installation environment. If your test file contains tests that should not be run in one or more of those cases, please use the constraints mechanism to skip those tests. - -6. Test output: ---------------- - -After all specified test files are sourced, the number of tests -passed, skipped, and failed is printed to stdout. Aside from this -statistical information, output can be controlled on a per-test basis -by the ::tcltest::verbose variable. - -::tcltest::verbose can be set to any substring or permutation of "bps". -In the string "bps", the 'b' stands for a test's "body", the 'p' -stands for "passed" tests, and the 's' stands for "skipped" tests. -The default value of ::tcltest::verbose is "b". If 'b' is present, then -the entire body of the test is printed for each failed test, otherwise -only the test's name, desired output, and actual output, are printed -for each failed test. If 'p' is present, then a line is printed for -each passed test, otherwise no line is printed for passed tests. If -'s' is present, then a line (containing the consraints that cause the -test to be skipped) is printed for each skipped test, otherwise no -line is printed for skipped tests. - -You can set ::tcltest::verbose either interactively (after the defs.tcl -file has been sourced) or by the command line argument -verbose, for -example: - - tcltest socket.test -verbose bps - - -7. Selecting tests for execution within a file: ------------------------------------------------ - -Normally, all the tests in a file are run whenever the file is -sourced. An individual test will be skipped if one of the following -conditions is met: - - 1) the "name" of the tests does not match (using glob style - matching) one or more elements in the ::tcltest::match - variable - - 2) the "name" of the tests matches (using glob style matching) one - or more elements in the ::tcltest::skip variable - - 3) the "constraints" argument to the "test" call, if given, - contains one or more false elements. - -You can set ::tcltest::match and/or ::tcltest::skip -either interactively (after the defs.tcl file has been sourced), or by -the command line arguments -match and -skip, for example: - - tcltest info.test -match '*-5.* *-7.*' -skip '*-7.1*' - -Be sure to use the proper quoting convention so that your shell does -not perform the glob substitution on the match or skip patterns you -specify. - -The two predefined constraints (knownBug and nonPortable) can be -overridden either interactively (after the defs.tcl file has been -sourced) by setting the ::tcltest::testConfig(<constraint>) variable, -or by using the -constraints command line option with the name of the -constraint in the argument. The following example shows how to run -tests that are constrained by the knownBug and nonPortable -restricions: - - tcltest all.tcl -constraints "knownBug nonPortable" - -See the defs.tcl file for information about each of these constraints. -Other constraints can be added at any time. See the "Writing a new -test" section below for more details about using built-in constraints -and adding new ones. - - -8. Selecting files to be sourced by all.tcl: --------------------------------------------- - -You can specify the files you want all.tcl to source on the command -line with the -file options. For example, if you call the -following: - - tcltest all.tcl -file 'unix*.test' - -all files in "tests" directory that match the pattern unix*.test will -be sourced by the all.tcl file. Another useful example is if a -particular test hangs, say "get.test", and you just want to run the -remaining tests, then you can call the following: - - tcltest all.tcl -file '[h-z]*.test' - -Note that the argument to -file will be substituted relative to the -"tests" directory. Be sure to use the proper quoting convention so -that your shell does not perform the glob substitution. - - -9. Incompatibilities with prior Tcl versions: +2. Incompatibilities with prior Tcl versions: --------------------------------------------- 1) Global variables such as VERBOSE, TESTS, and testConfig are now @@ -415,10 +104,12 @@ that your shell does not perform the glob substitution. other or with existing files. All tests must now run independently of their working directory. -4) The "all", "defs", and "visual" files are now called "all.tcl", - "defs.tcl", and "visual_bb.test", respectively. +4) The "all" and "visual" files are now called "all.tcl" ane + "visual_bb.test". + +5) The "defs" file no longer exists. -5) Instead of creating a doAllTests file in the tests directory, to +6) Instead of creating a doAllTests file in the tests directory, to run all nonPortable tests, just use the "-constraints nonPortable" command line flag. If you are running interactively, you can set the ::tcltest::testConfig(nonPortable) variable to 1 (after diff --git a/tests/all.tcl b/tests/all.tcl index d6d898c..7eedd16 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -7,15 +7,17 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: all.tcl,v 1.4 1999/04/21 21:50:30 rjohnson Exp $ +# RCS: @(#) $Id: all.tcl,v 1.5 1999/06/26 03:54:09 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } +info commands set ::tcltest::testSingleFile false puts stdout "Tcl $tcl_patchLevel tests running in interp: [info nameofexecutable]" -puts stdout "Tests running in working dir: $::tcltest::workingDir" +puts stdout "Tests running in working dir: $::tcltest::workingDirectory" if {[llength $::tcltest::skip] > 0} { puts stdout "Skipping tests that match: $::tcltest::skip" } @@ -33,10 +35,10 @@ if {($fileIndex < 1) || ($fIndex > $fileIndex)} { set fileIndex $fIndex } if {$fileIndex > 0} { - set globPattern [file join $::tcltest::testsDir [lindex $argv $fileIndex]] + set globPattern [file join $::tcltest::testsDirectory [lindex $argv $fileIndex]] puts stdout "Sourcing files that match: $globPattern" } else { - set globPattern [file join $::tcltest::testsDir *.test] + set globPattern [file join $::tcltest::testsDirectory *.test] } set fileList [glob -nocomplain $globPattern] if {[llength $fileList] < 1} { diff --git a/tests/append.test b/tests/append.test index e64df06..818ee1c 100644 --- a/tests/append.test +++ b/tests/append.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: append.test,v 1.3 1999/04/16 00:47:23 stanton Exp $ +# RCS: @(#) $Id: append.test,v 1.4 1999/06/26 03:54:09 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {unset x} diff --git a/tests/assocd.test b/tests/assocd.test index a618606..9fc3871 100644 --- a/tests/assocd.test +++ b/tests/assocd.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: assocd.test,v 1.3 1999/04/16 00:47:23 stanton Exp $ +# RCS: @(#) $Id: assocd.test,v 1.4 1999/06/26 03:54:10 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[string compare testsetassocdata [info commands testsetassocdata]] != 0} { diff --git a/tests/async.test b/tests/async.test index 4b4d655..7869775 100644 --- a/tests/async.test +++ b/tests/async.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: async.test,v 1.3 1999/04/16 00:47:23 stanton Exp $ +# RCS: @(#) $Id: async.test,v 1.4 1999/06/26 03:54:10 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testasync] == {}} { diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test index 452eed6..b034077 100644 --- a/tests/autoMkindex.test +++ b/tests/autoMkindex.test @@ -9,15 +9,17 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: autoMkindex.test,v 1.5 1999/04/16 00:47:23 stanton Exp $ +# RCS: @(#) $Id: autoMkindex.test,v 1.6 1999/06/26 03:54:10 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } -# temporarily copy the autoMkindex.tcl file from testsDir to tmpDir -set origMkindexFile [file join $::tcltest::testsDir autoMkindex.tcl] -set newMkindexFile [file join $::tcltest::workingDir autoMkindex.tcl] +# temporarily copy the autoMkindex.tcl file from testsDirectory to +# temporaryDirectory +set origMkindexFile [file join $::tcltest::testsDirectory autoMkindex.tcl] +set newMkindexFile [file join $::tcltest::temporaryDirectory autoMkindex.tcl] if {![catch {file copy $origMkindexFile $newMkindexFile}]} { set removeAutoMkindex 1 } diff --git a/tests/basic.test b/tests/basic.test index f56a331..3ecb544 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -15,11 +15,12 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: basic.test,v 1.6 1999/06/25 23:29:53 welch Exp $ +# RCS: @(#) $Id: basic.test,v 1.7 1999/06/26 03:54:10 jenn Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {namespace delete test_ns_basic} diff --git a/tests/binary.test b/tests/binary.test index c0da86b..c890f4e 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: binary.test,v 1.4 1999/05/03 19:19:04 stanton Exp $ +# RCS: @(#) $Id: binary.test,v 1.5 1999/06/26 03:54:10 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test binary-2.1 {DupByteArrayInternalRep} { diff --git a/tests/case.test b/tests/case.test index ee0b97f..838def9 100644 --- a/tests/case.test +++ b/tests/case.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: case.test,v 1.3 1999/04/16 00:47:23 stanton Exp $ +# RCS: @(#) $Id: case.test,v 1.4 1999/06/26 03:54:10 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test case-1.1 {simple pattern} { diff --git a/tests/clock.test b/tests/clock.test index d0072ad..d0192cd 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: clock.test,v 1.3 1999/04/16 00:47:24 stanton Exp $ +# RCS: @(#) $Id: clock.test,v 1.4 1999/06/26 03:54:10 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test clock-1.1 {clock tests} { diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 0ae7156..d4bb056 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdAH.test,v 1.6 1999/05/22 01:20:14 stanton Exp $ +# RCS: @(#) $Id: cmdAH.test,v 1.7 1999/06/26 03:54:10 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } global env diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 6911da0..f4fc9a3 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -8,10 +8,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdIL.test,v 1.8 1999/05/06 18:46:43 stanton Exp $ +# RCS: @(#) $Id: cmdIL.test,v 1.9 1999/06/26 03:54:11 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test cmdIL-1.1 {Tcl_LsortObjCmd procedure} { diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test index ad18e70..8802c9c 100644 --- a/tests/cmdInfo.test +++ b/tests/cmdInfo.test @@ -13,10 +13,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdInfo.test,v 1.3 1999/04/16 00:47:24 stanton Exp $ +# RCS: @(#) $Id: cmdInfo.test,v 1.4 1999/06/26 03:54:11 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testcmdinfo] == {}} { diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index f533d6c..d97c5da 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdMZ.test,v 1.5 1999/05/06 18:46:43 stanton Exp $ +# RCS: @(#) $Id: cmdMZ.test,v 1.6 1999/06/26 03:54:11 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Tcl_PwdObjCmd diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index 5e1fa9a..6188c17 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -12,10 +12,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compExpr-old.test,v 1.2 1999/04/16 00:47:24 stanton Exp $ +# RCS: @(#) $Id: compExpr-old.test,v 1.3 1999/06/26 03:54:11 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { diff --git a/tests/compExpr.test b/tests/compExpr.test index 17728b9..0a1404d 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -8,10 +8,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compExpr.test,v 1.2 1999/04/16 00:47:25 stanton Exp $ +# RCS: @(#) $Id: compExpr.test,v 1.3 1999/06/26 03:54:11 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { diff --git a/tests/compile.test b/tests/compile.test index 382e85e..da70c8c 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compile.test,v 1.6 1999/04/16 00:47:25 stanton Exp $ +# RCS: @(#) $Id: compile.test,v 1.7 1999/06/26 03:54:11 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # The following tests are very incomplete, although the rest of the diff --git a/tests/concat.test b/tests/concat.test index 69a4f21..ad9a4c4 100644 --- a/tests/concat.test +++ b/tests/concat.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: concat.test,v 1.3 1999/04/16 00:47:25 stanton Exp $ +# RCS: @(#) $Id: concat.test,v 1.4 1999/06/26 03:54:11 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test concat-1.1 {simple concatenation} { diff --git a/tests/dcall.test b/tests/dcall.test index 2114071..d15b537 100644 --- a/tests/dcall.test +++ b/tests/dcall.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dcall.test,v 1.3 1999/04/16 00:47:25 stanton Exp $ +# RCS: @(#) $Id: dcall.test,v 1.4 1999/06/26 03:54:11 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testdcall] == {}} { diff --git a/tests/defs.tcl b/tests/defs.tcl deleted file mode 100644 index 839d358..0000000 --- a/tests/defs.tcl +++ /dev/null @@ -1,1087 +0,0 @@ -# defs.tcl -- -# -# This file contains support code for the Tcl/Tk test suite.It is -# It is normally sourced by the individual files in the test suite -# before they run their tests. This improved approach to testing -# was designed and initially implemented by Mary Ann May-Pumphrey -# of Sun Microsystems. -# -# Copyright (c) 1990-1994 The Regents of the University of California. -# Copyright (c) 1994-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# All rights reserved. -# -# RCS: @(#) $Id: defs.tcl,v 1.6 1999/06/19 00:57:57 jenn Exp $ - -# Initialize wish shell - -if {[info exists tk_version]} { - tk appname tktest - wm title . tktest -} else { - # Ensure that we have a minimal auto_path so we don't pick up extra junk. - set auto_path [list [info library]] -} - -# create the "tcltest" namespace for all testing variables and procedures - -namespace eval tcltest { - set procList [list test cleanupTests dotests saveState restoreState \ - normalizeMsg makeFile removeFile makeDirectory removeDirectory \ - viewFile bytestring set_iso8859_1_locale restore_locale \ - safeFetch threadReap] - if {[info exists tk_version]} { - lappend procList setupbg dobg bgReady cleanupbg fixfocus - } - foreach proc $procList { - 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 {} - - # Tests should not rely on the current working directory. - # Files that are part of the test suite should be accessed relative to - # ::tcltest::testsDir. - - set originalDir [pwd] - set tDir [file join $originalDir [file dirname [info script]]] - cd $tDir - variable testsDir [pwd] - cd $originalDir - - # 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. - # The currentFailure var stores the boolean value of whether the - # current test file has had any failures. The failFiles list - # stores the names of test files that had failures. - - variable numTestFiles 0 - variable testSingleFile true - variable currentFailure false - variable failFiles {} - - # Tests should remove all files they create. The test suite will - # check the current working dir for files created by the tests. - # ::tcltest::filesMade keeps track of such files created using the - # ::tcltest::makeFile and ::tcltest::makeDirectory procedures. - # ::tcltest::filesExisted stores the names of pre-existing files. - - variable filesMade {} - variable filesExisted {} - - # ::tcltest::numTests will store test files as indices and the list - # of files (that should not have been) left behind by the test files. - - array set ::tcltest::createdNewFiles {} - - # initialize ::tcltest::numTests array to keep track fo the number of - # tests that pass, fial, and are skipped. - - array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0] - - # initialize ::tcltest::skippedBecause array to keep track of - # constraints that kept tests from running - - array set ::tcltest::skippedBecause {} - - # tests that use thread need to know which is the main thread - - variable ::tcltest::mainThread 1 - if {[info commands testthread] != {}} { - set ::tcltest::mainThread [testthread names] - } -} - -# If there is no "memory" command (because memory debugging isn't -# enabled), generate a dummy command that does nothing. - -if {[info commands memory] == ""} { - proc memory args {} -} - -# ::tcltest::initConfig -- -# -# Check configuration information that will determine which tests -# to run. To do this, create an array ::tcltest::testConfig. Each -# element has a 0 or 1 value. If the element is "true" then tests -# with that constraint will be run, otherwise tests with that constraint -# will be skipped. See the README file for the list of built-in -# constraints defined in this procedure. -# -# Arguments: -# none -# -# Results: -# The ::tcltest::testConfig array is reset to have an index for -# each built-in test constraint. - -proc ::tcltest::initConfig {} { - - global tcl_platform tcl_interactive tk_version - - catch {unset ::tcltest::testConfig} - - # The following trace procedure makes it so that we can safely refer to - # non-existent members of the ::tcltest::testConfig array without causing an - # error. Instead, reading a non-existent member will return 0. This is - # necessary because tests are allowed to use constraint "X" without ensuring - # that ::tcltest::testConfig("X") is defined. - - trace variable ::tcltest::testConfig r ::tcltest::safeFetch - - proc ::tcltest::safeFetch {n1 n2 op} { - if {($n2 != {}) && ([info exists ::tcltest::testConfig($n2)] == 0)} { - set ::tcltest::testConfig($n2) 0 - } - } - - set ::tcltest::testConfig(unixOnly) \ - [expr {$tcl_platform(platform) == "unix"}] - set ::tcltest::testConfig(macOnly) \ - [expr {$tcl_platform(platform) == "macintosh"}] - set ::tcltest::testConfig(pcOnly) \ - [expr {$tcl_platform(platform) == "windows"}] - - set ::tcltest::testConfig(unix) $::tcltest::testConfig(unixOnly) - set ::tcltest::testConfig(mac) $::tcltest::testConfig(macOnly) - set ::tcltest::testConfig(pc) $::tcltest::testConfig(pcOnly) - - set ::tcltest::testConfig(unixOrPc) \ - [expr {$::tcltest::testConfig(unix) || $::tcltest::testConfig(pc)}] - set ::tcltest::testConfig(macOrPc) \ - [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(pc)}] - set ::tcltest::testConfig(macOrUnix) \ - [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(unix)}] - - set ::tcltest::testConfig(nt) [expr {$tcl_platform(os) == "Windows NT"}] - set ::tcltest::testConfig(95) [expr {$tcl_platform(os) == "Windows 95"}] - - # The following config 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. - - set ::tcltest::testConfig(tempNotPc) [expr {!$::tcltest::testConfig(pc)}] - set ::tcltest::testConfig(tempNotMac) [expr {!$::tcltest::testConfig(mac)}] - set ::tcltest::testConfig(tempNotUnix) [expr {!$::tcltest::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 ::tcltest::testConfig(pcCrash) [expr {!$::tcltest::testConfig(pc)}] - set ::tcltest::testConfig(macCrash) [expr {!$::tcltest::testConfig(mac)}] - set ::tcltest::testConfig(unixCrash) [expr {!$::tcltest::testConfig(unix)}] - - # Set the "fonts" constraint for wish apps - - if {[info exists tk_version]} { - set ::tcltest::testConfig(fonts) 1 - catch {destroy .e} - entry .e -width 0 -font {Helvetica -12} -bd 1 - .e insert end "a.bcd" - if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} { - set ::tcltest::testConfig(fonts) 0 - } - destroy .e - catch {destroy .t} - text .t -width 80 -height 20 -font {Times -14} -bd 1 - pack .t - .t insert end "This is\na dot." - update - set x [list [.t bbox 1.3] [.t bbox 2.5]] - destroy .t - if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} { - set ::tcltest::testConfig(fonts) 0 - } - } - - # Skip empty tests - - set ::tcltest::testConfig(emptyTest) 0 - - # By default, tests that expost known bugs are skipped. - - set ::tcltest::testConfig(knownBug) 0 - - # By default, non-portable tests are skipped. - - set ::tcltest::testConfig(nonPortable) 0 - - # Some tests require user interaction. - - set ::tcltest::testConfig(userInteraction) 0 - - # Some tests must be skipped if the interpreter is not in interactive mode - - set ::tcltest::testConfig(interactive) $tcl_interactive - - # 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. - - set ::tcltest::testConfig(root) 0 - set ::tcltest::testConfig(notRoot) 1 - set user {} - if {$tcl_platform(platform) == "unix"} { - catch {set user [exec whoami]} - if {$user == ""} { - catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} - } - if {($user == "root") || ($user == "")} { - set ::tcltest::testConfig(root) 1 - set ::tcltest::testConfig(notRoot) 0 - } - } - - # Set nonBlockFiles constraint: 1 means this platform supports - # setting files into nonblocking mode. - - if {[catch {set f [open defs r]}]} { - set ::tcltest::testConfig(nonBlockFiles) 1 - } else { - if {[catch {fconfigure $f -blocking off}] == 0} { - set ::tcltest::testConfig(nonBlockFiles) 1 - } else { - set ::tcltest::testConfig(nonBlockFiles) 0 - } - close $f - } - - # Set asyncPipeClose constraint: 1 means this platform supports - # async flush and async close on a pipe. - # - # Test for SCO Unix - cannot run async flushing tests because a - # potential problem with select is apparently interfering. - # (Mark Diekhans). - - if {$tcl_platform(platform) == "unix"} { - if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} { - set ::tcltest::testConfig(asyncPipeClose) 0 - } else { - set ::tcltest::testConfig(asyncPipeClose) 1 - } - } else { - set ::tcltest::testConfig(asyncPipeClose) 1 - } - - # Test to see if we have a broken version of sprintf with respect - # to the "e" format of floating-point numbers. - - set ::tcltest::testConfig(eformat) 1 - if {[string compare "[format %g 5e-5]" "5e-05"] != 0} { - set ::tcltest::testConfig(eformat) 0 - } - - # Test to see if execed commands such as cat, echo, rm and so forth are - # present on this machine. - - set ::tcltest::testConfig(unixExecs) 1 - if {$tcl_platform(platform) == "macintosh"} { - set ::tcltest::testConfig(unixExecs) 0 - } - if {($::tcltest::testConfig(unixExecs) == 1) && \ - ($tcl_platform(platform) == "windows")} { - if {[catch {exec cat defs}] == 1} { - set ::tcltest::testConfig(unixExecs) 0 - } - if {($::tcltest::testConfig(unixExecs) == 1) && \ - ([catch {exec echo hello}] == 1)} { - set ::tcltest::testConfig(unixExecs) 0 - } - if {($::tcltest::testConfig(unixExecs) == 1) && \ - ([catch {exec sh -c echo hello}] == 1)} { - set ::tcltest::testConfig(unixExecs) 0 - } - if {($::tcltest::testConfig(unixExecs) == 1) && \ - ([catch {exec wc defs}] == 1)} { - set ::tcltest::testConfig(unixExecs) 0 - } - if {$::tcltest::testConfig(unixExecs) == 1} { - exec echo hello > removeMe - if {[catch {exec rm removeMe}] == 1} { - set ::tcltest::testConfig(unixExecs) 0 - } - } - if {($::tcltest::testConfig(unixExecs) == 1) && \ - ([catch {exec sleep 1}] == 1)} { - set ::tcltest::testConfig(unixExecs) 0 - } - if {($::tcltest::testConfig(unixExecs) == 1) && \ - ([catch {exec fgrep unixExecs defs}] == 1)} { - set ::tcltest::testConfig(unixExecs) 0 - } - if {($::tcltest::testConfig(unixExecs) == 1) && \ - ([catch {exec ps}] == 1)} { - set ::tcltest::testConfig(unixExecs) 0 - } - if {($::tcltest::testConfig(unixExecs) == 1) && \ - ([catch {exec echo abc > removeMe}] == 0) && \ - ([catch {exec chmod 644 removeMe}] == 1) && \ - ([catch {exec rm removeMe}] == 0)} { - set ::tcltest::testConfig(unixExecs) 0 - } else { - catch {exec rm -f removeMe} - } - if {($::tcltest::testConfig(unixExecs) == 1) && \ - ([catch {exec mkdir removeMe}] == 1)} { - set ::tcltest::testConfig(unixExecs) 0 - } else { - catch {exec rm -r removeMe} - } - } -} - -::tcltest::initConfig - - -# ::tcltest::processCmdLineArgs -- -# -# Use command line args to set the verbose, skip, and -# match variables. This procedure must be run after -# constraints are initialized, because some constraints can be -# overridden. -# -# Arguments: -# none -# -# Results: -# ::tcltest::verbose is set to <value> - -proc ::tcltest::processCmdLineArgs {} { - global argv - - # The "argv" var doesn't exist in some cases, so use {} - # The "argv" var doesn't exist in some cases. - - if {(![info exists argv]) || ([llength $argv] < 2)} { - set flagArray {} - } else { - set flagArray $argv - } - - if {[catch {array set flag $flagArray}]} { - puts stderr "Error: odd number of command line args specified:" - puts stderr " $argv" - exit - } - - # Allow for 1-char abbreviations, where applicable (e.g., -match == -m). - # Note that -verbose cannot be abbreviated to -v in wish because it - # conflicts with the wish option -visual. - - foreach arg {-verbose -match -skip -constraints} { - set abbrev [string range $arg 0 1] - if {([info exists flag($abbrev)]) && \ - ([lsearch -exact $flagArray $arg] < \ - [lsearch -exact $flagArray $abbrev])} { - set flag($arg) $flag($abbrev) - } - } - - # Set ::tcltest::workingDir to [pwd]. - # Save the names of files that already exist in ::tcltest::workingDir. - - set ::tcltest::workingDir [pwd] - foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] { - lappend ::tcltest::filesExisted [file tail $file] - } - - # Set ::tcltest::verbose to the arg of the -verbose flag, if given - - if {[info exists flag(-verbose)]} { - set ::tcltest::verbose $flag(-verbose) - } - - # Set ::tcltest::match to the arg of the -match flag, if given - - if {[info exists flag(-match)]} { - set ::tcltest::match $flag(-match) - } - - # Set ::tcltest::skip to the arg of the -skip flag, if given - - if {[info exists flag(-skip)]} { - set ::tcltest::skip $flag(-skip) - } - - # 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) { - set ::tcltest::testConfig($elt) 1 - } - } -} - -::tcltest::processCmdLineArgs - - -# ::tcltest::cleanupTests -- -# -# Remove files and dirs created using the makeFile and makeDirectory -# commands since the last time this proc was invoked. -# -# Print the names of the files created without the makeFile command -# since the tests were invoked. -# -# Print the number tests (total, passed, failed, and skipped) since the -# tests were invoked. -# - -proc ::tcltest::cleanupTests {{calledFromAllFile 0}} { - set tail [file tail [info script]] - - # Remove files and directories created by the :tcltest::makeFile and - # ::tcltest::makeDirectory procedures. - # Record the names of files in ::tcltest::workingDir that were not - # pre-existing, and associate them with the test file that created them. - - if {!$calledFromAllFile} { - - foreach file $::tcltest::filesMade { - if {[file exists $file]} { - catch {file delete -force $file} - } - } - set currentFiles {} - foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] { - lappend currentFiles [file tail $file] - } - set newFiles {} - foreach file $currentFiles { - if {[lsearch -exact $::tcltest::filesExisted $file] == -1} { - lappend newFiles $file - } - } - set ::tcltest::filesExisted $currentFiles - if {[llength $newFiles] > 0} { - set ::tcltest::createdNewFiles($tail) $newFiles - } - } - - if {$calledFromAllFile || $::tcltest::testSingleFile} { - - # print stats - - puts -nonewline stdout "$tail:" - foreach index [list "Total" "Passed" "Skipped" "Failed"] { - puts -nonewline stdout "\t$index\t$::tcltest::numTests($index)" - } - puts stdout "" - - # print number test files sourced - # print names of files that ran tests which failed - - if {$calledFromAllFile} { - puts stdout "Sourced $::tcltest::numTestFiles Test Files." - set ::tcltest::numTestFiles 0 - if {[llength $::tcltest::failFiles] > 0} { - puts stdout "Files with failing tests: $::tcltest::failFiles" - set ::tcltest::failFiles {} - } - } - - # if any tests were skipped, print the constraints that kept them - # from running. - - set constraintList [array names ::tcltest::skippedBecause] - if {[llength $constraintList] > 0} { - puts stdout "Number of tests skipped for each constraint:" - foreach constraint [lsort $constraintList] { - puts stdout \ - "\t$::tcltest::skippedBecause($constraint)\t$constraint" - unset ::tcltest::skippedBecause($constraint) - } - } - - # report the names of test files in ::tcltest::createdNewFiles, and - # reset the array to be empty. - - set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]] - if {[llength $testFilesThatTurded] > 0} { - puts stdout "Warning: test files left files behind:" - foreach testFile $testFilesThatTurded { - puts "\t$testFile:\t$::tcltest::createdNewFiles($testFile)" - unset ::tcltest::createdNewFiles($testFile) - } - } - - # reset filesMade, filesExisted, and numTests - - set ::tcltest::filesMade {} - foreach index [list "Total" "Passed" "Skipped" "Failed"] { - set ::tcltest::numTests($index) 0 - } - - # exit only if running Tk in non-interactive mode - - global tk_version tcl_interactive - if {[info exists tk_version] && !$tcl_interactive} { - exit - } - } else { - - # if we're deferring stat-reporting until all files are sourced, - # then add current file to failFile list if any tests in this file - # failed - - incr ::tcltest::numTestFiles - if {($::tcltest::currentFailure) && \ - ([lsearch -exact $::tcltest::failFiles $tail] == -1)} { - lappend ::tcltest::failFiles $tail - } - set ::tcltest::currentFailure false - } -} - - -# test -- -# -# This procedure runs a test and prints an error message if the test fails. -# If ::tcltest::verbose has been set, it also prints a message even if the -# test succeeds. The test will be skipped if it doesn't match the -# ::tcltest::match variable, if it matches an element in -# ::tcltest::skip, or if one of the elements of "constraints" turns -# out not to be true. -# -# Arguments: -# name - Name of test, in the form foo-1.2. -# description - Short textual description of the test, to -# help humans understand what it does. -# constraints - A list of one or more keywords, each of -# which must be the name of an element in -# the array "::tcltest::testConfig". If any of these -# elements is zero, the test is skipped. -# This argument may be omitted. -# script - Script to run to carry out the test. It must -# return a result that can be checked for -# correctness. -# expectedAnswer - Expected result from script. - -proc ::tcltest::test {name description script expectedAnswer args} { - incr ::tcltest::numTests(Total) - - # skip the test if it's name matches an element of skip - - foreach pattern $::tcltest::skip { - if {[string match $pattern $name]} { - incr ::tcltest::numTests(Skipped) - return - } - } - # skip the test if it's name doesn't match any element of match - - if {[llength $::tcltest::match] > 0} { - set ok 0 - foreach pattern $::tcltest::match { - if {[string match $pattern $name]} { - set ok 1 - break - } - } - if {!$ok} { - incr ::tcltest::numTests(Skipped) - return - } - } - set i [llength $args] - if {$i == 0} { - set constraints {} - } elseif {$i == 1} { - - # "constraints" argument exists; shuffle arguments down, then - # make sure that the constraints are satisfied. - - set constraints $script - set script $expectedAnswer - set expectedAnswer [lindex $args 0] - set doTest 0 - 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::testConfig(a) || $::tcltest::testConfig(b). - - regsub -all {[.a-zA-Z0-9]+} $constraints \ - {$::tcltest::testConfig(&)} 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::testConfig($constraint)] - || !$::tcltest::testConfig($constraint)} { - set doTest 0 - - # store the constraint that kept the test from running - - set constraints $constraint - break - } - } - } - if {$doTest == 0} { - incr ::tcltest::numTests(Skipped) - if {[string first s $::tcltest::verbose] != -1} { - puts stdout "++++ $name SKIPPED: $constraints" - } - - # add the constraint to the list of constraints the kept tests - # from running - - if {[info exists ::tcltest::skippedBecause($constraints)]} { - incr ::tcltest::skippedBecause($constraints) - } else { - set ::tcltest::skippedBecause($constraints) 1 - } - return - } - } else { - error "wrong # args: must be \"test name description ?constraints? script expectedAnswer\"" - } - memory tag $name - set code [catch {uplevel $script} actualAnswer] - if {$code != 0 || [string compare $actualAnswer $expectedAnswer] != 0} { - incr ::tcltest::numTests(Failed) - set ::tcltest::currentFailure true - if {[string first b $::tcltest::verbose] == -1} { - set script "" - } - puts stdout "\n==== $name $description FAILED" - if {$script != ""} { - puts stdout "==== Contents of test case:" - puts stdout $script - } - if {$code != 0} { - if {$code == 1} { - puts stdout "==== Test generated error:" - puts stdout $actualAnswer - } elseif {$code == 2} { - puts stdout "==== Test generated return exception; result was:" - puts stdout $actualAnswer - } elseif {$code == 3} { - puts stdout "==== Test generated break exception" - } elseif {$code == 4} { - puts stdout "==== Test generated continue exception" - } else { - puts stdout "==== Test generated exception $code; message was:" - puts stdout $actualAnswer - } - } else { - puts stdout "---- Result was:\n$actualAnswer" - } - puts stdout "---- Result should have been:\n$expectedAnswer" - puts stdout "==== $name FAILED\n" - } else { - incr ::tcltest::numTests(Passed) - if {[string first p $::tcltest::verbose] != -1} { - puts stdout "++++ $name PASSED" - } - } -} - -# ::tcltest::dotests -- -# -# takes two arguments--the name of the test file (such -# as "parse.test"), and a pattern selecting the tests you want to -# execute. It sets ::tcltest::matching to the second argument, calls -# "source" on the file specified in the first argument, and restores -# ::tcltest::matching to its pre-call value at the end. -# -# Arguments: -# file name of tests file to source -# args pattern selecting the tests you want to execute -# -# Results: -# none - -proc ::tcltest::dotests {file args} { - set savedTests $::tcltest::match - set ::tcltest::match $args - source $file - set ::tcltest::match $savedTests -} - -proc ::tcltest::openfiles {} { - if {[catch {testchannel open} result]} { - return {} - } - return $result -} - -proc ::tcltest::leakfiles {old} { - if {[catch {testchannel open} new]} { - return {} - } - set leak {} - foreach p $new { - if {[lsearch $old $p] < 0} { - lappend leak $p - } - } - return $leak -} - -set ::tcltest::saveState {} - -proc ::tcltest::saveState {} { - uplevel #0 {set ::tcltest::saveState [list [info procs] [info vars]]} -} - -proc ::tcltest::restoreState {} { - foreach p [info procs] { - if {[lsearch [lindex $::tcltest::saveState 0] $p] < 0} { - rename $p {} - } - } - foreach p [uplevel #0 {info vars}] { - if {[lsearch [lindex $::tcltest::saveState 1] $p] < 0} { - uplevel #0 "unset $p" - } - } -} - -proc ::tcltest::normalizeMsg {msg} { - regsub "\n$" [string tolower $msg] "" msg - regsub -all "\n\n" $msg "\n" msg - regsub -all "\n\}" $msg "\}" msg - return $msg -} - -# makeFile -- -# -# Create a new file with the name <name>, and write <contents> to it. -# -# If this file hasn't been created via makeFile since the last time -# cleanupTests was called, add it to the $filesMade list, so it will -# be removed by the next call to cleanupTests. -# -proc ::tcltest::makeFile {contents name} { - set fd [open $name w] - fconfigure $fd -translation lf - if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} { - puts -nonewline $fd $contents - } else { - puts $fd $contents - } - close $fd - - set fullName [file join [pwd] $name] - if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} { - lappend ::tcltest::filesMade $fullName - } -} - -proc ::tcltest::removeFile {name} { - file delete $name -} - -# makeDirectory -- -# -# Create a new dir with the name <name>. -# -# If this dir hasn't been created via makeDirectory since the last time -# cleanupTests was called, add it to the $directoriesMade list, so it will -# be removed by the next call to cleanupTests. -# -proc ::tcltest::makeDirectory {name} { - file mkdir $name - - set fullName [file join [pwd] $name] - if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} { - lappend ::tcltest::filesMade $fullName - } -} - -proc ::tcltest::removeDirectory {name} { - file delete -force $name -} - -proc ::tcltest::viewFile {name} { - global tcl_platform - if {($tcl_platform(platform) == "macintosh") || \ - ($::tcltest::testConfig(unixExecs) == 0)} { - set f [open $name] - set data [read -nonewline $f] - close $f - return $data - } else { - exec cat $name - } -} - -# -# Construct a string that consists of the requested sequence of bytes, -# as opposed to a string of properly formed UTF-8 characters. -# This allows the tester to -# 1. Create denormalized or improperly formed strings to pass to C procedures -# that are supposed to accept strings with embedded NULL bytes. -# 2. Confirm that a string result has a certain pattern of bytes, for instance -# to confirm that "\xe0\0" in a Tcl script is stored internally in -# UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80". -# -# Generally, it's a bad idea to examine the bytes in a Tcl string or to -# construct improperly formed strings in this manner, because it involves -# exposing that Tcl uses UTF-8 internally. - -proc ::tcltest::bytestring {string} { - encoding convertfrom identity $string -} - -# Locate tcltest executable - -if {![info exists tk_version]} { - set tcltest [info nameofexecutable] - - if {$tcltest == "{}"} { - set tcltest {} - } -} - -set ::tcltest::testConfig(stdio) 0 -catch { - catch {file delete -force tmp} - set f [open tmp w] - puts $f { - exit - } - close $f - - set f [open "|[list $tcltest tmp]" r] - close $f - - set ::tcltest::testConfig(stdio) 1 -} -catch {file delete -force tmp} - -# Deliberately call the socket with the wrong number of arguments. The error -# message you get will indicate whether sockets are available on this system. - -catch {socket} msg -set ::tcltest::testConfig(socket) \ - [expr {$msg != "sockets are not available on this system"}] - -# -# Internationalization / ISO support procs -- dl -# - -if {[info commands testlocale]==""} { - - # No testlocale command, no tests... - # (it could be that we are a sub interp and we could just load - # the Tcltest package but that would interfere with tests - # that tests packages/loading in slaves...) - - set ::tcltest::testConfig(hasIsoLocale) 0 -} else { - proc ::tcltest::set_iso8859_1_locale {} { - set ::tcltest::previousLocale [testlocale ctype] - testlocale ctype $::tcltest::isoLocale - } - - proc ::tcltest::restore_locale {} { - testlocale ctype $::tcltest::previousLocale - } - - if {![info exists ::tcltest::isoLocale]} { - set ::tcltest::isoLocale fr - switch $tcl_platform(platform) { - "unix" { - - # Try some 'known' values for some platforms: - - switch -exact -- $tcl_platform(os) { - "FreeBSD" { - set ::tcltest::isoLocale fr_FR.ISO_8859-1 - } - HP-UX { - set ::tcltest::isoLocale fr_FR.iso88591 - } - Linux - - IRIX { - set ::tcltest::isoLocale fr - } - default { - - # Works on SunOS 4 and Solaris, and maybe others... - # define it to something else on your system - #if you want to test those. - - set ::tcltest::isoLocale iso_8859_1 - } - } - } - "windows" { - set ::tcltest::isoLocale French - } - } - } - - set ::tcltest::testConfig(hasIsoLocale) \ - [string length [::tcltest::set_iso8859_1_locale]] - ::tcltest::restore_locale -} - -# -# procedures that are Tk specific -# - -if {[info exists tk_version]} { - - # If the main window isn't already mapped (e.g. because the tests are - # being run automatically) , specify a precise size for it so that the - # user won't have to position it manually. - - if {![winfo ismapped .]} { - wm geometry . +0+0 - update - } - - # The following code can be used to perform tests involving a second - # process running in the background. - - # Locate the tktest executable - - set ::tcltest::tktest [info nameofexecutable] - if {$::tcltest::tktest == "{}"} { - set ::tcltest::tktest {} - puts stdout \ - "Unable to find tktest executable, skipping multiple process tests." - } - - # Create background process - - proc ::tcltest::setupbg args { - if {$::tcltest::tktest == ""} { - error "you're not running tktest so setupbg should not have been called" - } - if {[info exists ::tcltest::fd] && ($::tcltest::fd != "")} { - cleanupbg - } - - # The following code segment cannot be run on Windows prior - # to Tk 8.1b3 due to a channel I/O bug (bugID 1495). - - global tcl_platform - set ::tcltest::fd [open "|[list $::tcltest::tktest -geometry +0+0 -name tktest] $args" r+] - puts $::tcltest::fd "puts foo; flush stdout" - flush $::tcltest::fd - if {[gets $::tcltest::fd data] < 0} { - error "unexpected EOF from \"$::tcltest::tktest\"" - } - if {[string compare $data foo]} { - error "unexpected output from background process \"$data\"" - } - fileevent $::tcltest::fd readable bgReady - } - - # Send a command to the background process, catching errors and - # flushing I/O channels - - proc ::tcltest::dobg {command} { - puts $::tcltest::fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout" - flush $::tcltest::fd - set ::tcltest::bgDone 0 - set ::tcltest::bgData {} - tkwait variable ::tcltest::bgDone - set ::tcltest::bgData - } - - # Data arrived from background process. Check for special marker - # indicating end of data for this command, and make data available - # to dobg procedure. - - proc ::tcltest::bgReady {} { - set x [gets $::tcltest::fd] - if {[eof $::tcltest::fd]} { - fileevent $::tcltest::fd readable {} - set ::tcltest::bgDone 1 - } elseif {$x == "**DONE**"} { - set ::tcltest::bgDone 1 - } else { - append ::tcltest::bgData $x - } - } - - # Exit the background process, and close the pipes - - proc ::tcltest::cleanupbg {} { - catch { - puts $::tcltest::fd "exit" - close $::tcltest::fd - } - set ::tcltest::fd "" - } - - # Clean up focus after using generate event, which - # can leave the window manager with the wrong impression - # about who thinks they have the focus. (BW) - - proc ::tcltest::fixfocus {} { - catch {destroy .focus} - toplevel .focus - wm geometry .focus +0+0 - entry .focus.e - .focus.e insert 0 "fixfocus" - pack .focus.e - update - focus -force .focus.e - destroy .focus - } -} - -# threadReap -- -# -# Kill all threads except for the main thread. -# Do nothing if testthread is not defined. -# -# Arguments: -# none. -# -# Results: -# Returns the number of existing threads. - -if {[info commands testthread] != {}} { - proc ::tcltest::threadReap {} { - testthread errorproc ThreadNullError - while {[llength [testthread names]] > 1} { - foreach tid [testthread names] { - if {$tid != $::tcltest::mainThread} { - catch {testthread send -async $tid {testthread exit}} - update - } - } - } - testthread errorproc ThreadError - return [llength [testthread names]] - } -} else { - proc ::tcltest::threadReap {} { - return 1 - } -} - -# Need to catch the import because it fails if defs.tcl is sourced -# more than once. - -catch {namespace import ::tcltest::*} -return diff --git a/tests/dstring.test b/tests/dstring.test index e614b97..afa3b4e 100644 --- a/tests/dstring.test +++ b/tests/dstring.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dstring.test,v 1.3 1999/04/16 00:47:26 stanton Exp $ +# RCS: @(#) $Id: dstring.test,v 1.4 1999/06/26 03:54:12 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testdstring] == {}} { diff --git a/tests/encoding.test b/tests/encoding.test index 3852749..34cd506 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -8,10 +8,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: encoding.test,v 1.2 1999/04/16 00:47:26 stanton Exp $ +# RCS: @(#) $Id: encoding.test,v 1.3 1999/06/26 03:54:12 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } proc toutf {args} { diff --git a/tests/env.test b/tests/env.test index 543a939..164e634 100644 --- a/tests/env.test +++ b/tests/env.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: env.test,v 1.5 1999/04/30 22:45:02 stanton Exp $ +# RCS: @(#) $Id: env.test,v 1.6 1999/06/26 03:54:12 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # @@ -88,7 +89,7 @@ close $f proc getenv {} { global printenv tcltest - catch {exec $tcltest printenv} out + catch {exec $::tcltest::tcltest printenv} out if {$out == "child process exited abnormally"} { set out {} } diff --git a/tests/error.test b/tests/error.test index 5427816..e09bbb3 100644 --- a/tests/error.test +++ b/tests/error.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: error.test,v 1.5 1999/05/06 18:46:43 stanton Exp $ +# RCS: @(#) $Id: error.test,v 1.6 1999/06/26 03:54:12 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } proc foo {} { diff --git a/tests/eval.test b/tests/eval.test index 6c53bb8..c140a05 100644 --- a/tests/eval.test +++ b/tests/eval.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: eval.test,v 1.3 1999/04/16 00:47:26 stanton Exp $ +# RCS: @(#) $Id: eval.test,v 1.4 1999/06/26 03:54:12 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test eval-1.1 {single argument} { diff --git a/tests/event.test b/tests/event.test index e6667ab..e633507 100644 --- a/tests/event.test +++ b/tests/event.test @@ -9,10 +9,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: event.test,v 1.6 1999/04/21 21:50:30 rjohnson Exp $ +# RCS: @(#) $Id: event.test,v 1.7 1999/06/26 03:54:12 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } set ::tcltest::testConfig(testfilehandler) \ diff --git a/tests/exec.test b/tests/exec.test index ceb677b..b55176f 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: exec.test,v 1.3 1999/04/16 00:47:27 stanton Exp $ +# RCS: @(#) $Id: exec.test,v 1.4 1999/06/26 03:54:12 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # All tests require the "exec" command. @@ -102,144 +103,144 @@ close $f # Basic operations. test exec-1.1 {basic exec operation} {execCommandExists stdio} { - exec $tcltest echo a b c + exec $::tcltest::tcltest echo a b c } "a b c" test exec-1.2 {pipelining} {execCommandExists stdio} { - exec $tcltest echo a b c d | $tcltest cat | $tcltest cat + exec $::tcltest::tcltest echo a b c d | $::tcltest::tcltest cat | $::tcltest::tcltest cat } "a b c d" test exec-1.3 {pipelining} {execCommandExists stdio} { - set a [exec $tcltest echo a b c d | $tcltest cat | $tcltest wc] + set a [exec $::tcltest::tcltest echo a b c d | $::tcltest::tcltest cat | $::tcltest::tcltest wc] list [scan $a "%d %d %d" b c d] $b $c } {3 1 4} set arg {12345678901234567890123456789012345678901234567890} set arg "$arg$arg$arg$arg$arg$arg" test exec-1.4 {long command lines} {execCommandExists stdio} { - exec $tcltest echo $arg + exec $::tcltest::tcltest echo $arg } $arg set arg {} # I/O redirection: input from Tcl command. test exec-2.1 {redirecting input from immediate source} {execCommandExists stdio} { - exec $tcltest cat << "Sample text" + exec $::tcltest::tcltest cat << "Sample text" } {Sample text} test exec-2.2 {redirecting input from immediate source} {execCommandExists stdio} { - exec << "Sample text" $tcltest cat | $tcltest cat + exec << "Sample text" $::tcltest::tcltest cat | $::tcltest::tcltest cat } {Sample text} test exec-2.3 {redirecting input from immediate source} {execCommandExists stdio} { - exec $tcltest cat << "Sample text" | $tcltest cat + exec $::tcltest::tcltest cat << "Sample text" | $::tcltest::tcltest cat } {Sample text} test exec-2.4 {redirecting input from immediate source} {execCommandExists stdio} { - exec $tcltest cat | $tcltest cat << "Sample text" + exec $::tcltest::tcltest cat | $::tcltest::tcltest cat << "Sample text" } {Sample text} test exec-2.5 {redirecting input from immediate source} {execCommandExists stdio} { - exec $tcltest cat "<<Joined to arrows" + exec $::tcltest::tcltest cat "<<Joined to arrows" } {Joined to arrows} # I/O redirection: output to file. file delete gorp.file test exec-3.1 {redirecting output to file} {execCommandExists stdio} { - exec $tcltest echo "Some simple words" > gorp.file - exec $tcltest cat gorp.file + exec $::tcltest::tcltest echo "Some simple words" > gorp.file + exec $::tcltest::tcltest cat gorp.file } "Some simple words" test exec-3.2 {redirecting output to file} {execCommandExists stdio} { - exec $tcltest echo "More simple words" | >gorp.file $tcltest cat | $tcltest cat - exec $tcltest cat gorp.file + exec $::tcltest::tcltest echo "More simple words" | >gorp.file $::tcltest::tcltest cat | $::tcltest::tcltest cat + exec $::tcltest::tcltest cat gorp.file } "More simple words" test exec-3.3 {redirecting output to file} {execCommandExists stdio} { - exec > gorp.file $tcltest echo "Different simple words" | $tcltest cat | $tcltest cat - exec $tcltest cat gorp.file + exec > gorp.file $::tcltest::tcltest echo "Different simple words" | $::tcltest::tcltest cat | $::tcltest::tcltest cat + exec $::tcltest::tcltest cat gorp.file } "Different simple words" test exec-3.4 {redirecting output to file} {execCommandExists stdio} { - exec $tcltest echo "Some simple words" >gorp.file - exec $tcltest cat gorp.file + exec $::tcltest::tcltest echo "Some simple words" >gorp.file + exec $::tcltest::tcltest cat gorp.file } "Some simple words" test exec-3.5 {redirecting output to file} {execCommandExists stdio} { - exec $tcltest echo "First line" >gorp.file - exec $tcltest echo "Second line" >> gorp.file - exec $tcltest cat gorp.file + exec $::tcltest::tcltest echo "First line" >gorp.file + exec $::tcltest::tcltest echo "Second line" >> gorp.file + exec $::tcltest::tcltest cat gorp.file } "First line\nSecond line" test exec-3.6 {redirecting output to file} {execCommandExists stdio} { - exec $tcltest echo "First line" >gorp.file - exec $tcltest echo "Second line" >>gorp.file - exec $tcltest cat gorp.file + exec $::tcltest::tcltest echo "First line" >gorp.file + exec $::tcltest::tcltest echo "Second line" >>gorp.file + exec $::tcltest::tcltest cat gorp.file } "First line\nSecond line" test exec-3.7 {redirecting output to file} {execCommandExists stdio} { set f [open gorp.file w] puts $f "Line 1" flush $f - exec $tcltest echo "More text" >@ $f - exec $tcltest echo >@$f "Even more" + exec $::tcltest::tcltest echo "More text" >@ $f + exec $::tcltest::tcltest echo >@$f "Even more" puts $f "Line 3" close $f - exec $tcltest cat gorp.file + exec $::tcltest::tcltest cat gorp.file } "Line 1\nMore text\nEven more\nLine 3" # I/O redirection: output and stderr to file. file delete gorp.file test exec-4.1 {redirecting output and stderr to file} {execCommandExists stdio} { - exec $tcltest echo "test output" >& gorp.file - exec $tcltest cat gorp.file + exec $::tcltest::tcltest echo "test output" >& gorp.file + exec $::tcltest::tcltest cat gorp.file } "test output" test exec-4.2 {redirecting output and stderr to file} {execCommandExists stdio} { - list [exec $tcltest sh -c "echo foo bar 1>&2" >&gorp.file] \ - [exec $tcltest cat gorp.file] + list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" >&gorp.file] \ + [exec $::tcltest::tcltest cat gorp.file] } {{} {foo bar}} test exec-4.3 {redirecting output and stderr to file} {execCommandExists stdio} { - exec $tcltest echo "first line" > gorp.file - list [exec $tcltest sh -c "echo foo bar 1>&2" >>&gorp.file] \ - [exec $tcltest cat gorp.file] + exec $::tcltest::tcltest echo "first line" > gorp.file + list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" >>&gorp.file] \ + [exec $::tcltest::tcltest cat gorp.file] } "{} {first line\nfoo bar}" test exec-4.4 {redirecting output and stderr to file} {execCommandExists stdio} { set f [open gorp.file w] puts $f "Line 1" flush $f - exec $tcltest echo "More text" >&@ $f - exec $tcltest echo >&@$f "Even more" + exec $::tcltest::tcltest echo "More text" >&@ $f + exec $::tcltest::tcltest echo >&@$f "Even more" puts $f "Line 3" close $f - exec $tcltest cat gorp.file + exec $::tcltest::tcltest cat gorp.file } "Line 1\nMore text\nEven more\nLine 3" test exec-4.5 {redirecting output and stderr to file} {execCommandExists stdio} { set f [open gorp.file w] puts $f "Line 1" flush $f - exec >&@ $f $tcltest sh -c "echo foo bar 1>&2" - exec >&@$f $tcltest sh -c "echo xyzzy 1>&2" + exec >&@ $f $::tcltest::tcltest sh -c "echo foo bar 1>&2" + exec >&@$f $::tcltest::tcltest sh -c "echo xyzzy 1>&2" puts $f "Line 3" close $f - exec $tcltest cat gorp.file + exec $::tcltest::tcltest cat gorp.file } "Line 1\nfoo bar\nxyzzy\nLine 3" # I/O redirection: input from file. -exec $tcltest echo "Just a few thoughts" > gorp.file +exec $::tcltest::tcltest echo "Just a few thoughts" > gorp.file test exec-5.1 {redirecting input from file} {execCommandExists stdio} { - exec $tcltest cat < gorp.file + exec $::tcltest::tcltest cat < gorp.file } {Just a few thoughts} test exec-5.2 {redirecting input from file} {execCommandExists stdio} { - exec $tcltest cat | $tcltest cat < gorp.file + exec $::tcltest::tcltest cat | $::tcltest::tcltest cat < gorp.file } {Just a few thoughts} test exec-5.3 {redirecting input from file} {execCommandExists stdio} { - exec $tcltest cat < gorp.file | $tcltest cat + exec $::tcltest::tcltest cat < gorp.file | $::tcltest::tcltest cat } {Just a few thoughts} test exec-5.4 {redirecting input from file} {execCommandExists stdio} { - exec < gorp.file $tcltest cat | $tcltest cat + exec < gorp.file $::tcltest::tcltest cat | $::tcltest::tcltest cat } {Just a few thoughts} test exec-5.5 {redirecting input from file} {execCommandExists stdio} { - exec $tcltest cat <gorp.file + exec $::tcltest::tcltest cat <gorp.file } {Just a few thoughts} test exec-5.6 {redirecting input from file} {execCommandExists stdio} { set f [open gorp.file r] - set result [exec $tcltest cat <@ $f] + set result [exec $::tcltest::tcltest cat <@ $f] close $f set result } {Just a few thoughts} test exec-5.7 {redirecting input from file} {execCommandExists stdio} { set f [open gorp.file r] - set result [exec <@$f $tcltest cat] + set result [exec <@$f $::tcltest::tcltest cat] close $f set result } {Just a few thoughts} @@ -247,25 +248,25 @@ test exec-5.7 {redirecting input from file} {execCommandExists stdio} { # I/O redirection: standard error through a pipeline. test exec-6.1 {redirecting stderr through a pipeline} {execCommandExists stdio} { - exec $tcltest sh -c "echo foo bar" |& $tcltest cat + exec $::tcltest::tcltest sh -c "echo foo bar" |& $::tcltest::tcltest cat } "foo bar" test exec-6.2 {redirecting stderr through a pipeline} {execCommandExists stdio} { - exec $tcltest sh -c "echo foo bar 1>&2" |& $tcltest cat + exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" |& $::tcltest::tcltest cat } "foo bar" test exec-6.3 {redirecting stderr through a pipeline} {execCommandExists stdio} { - exec $tcltest sh -c "echo foo bar 1>&2" \ - |& $tcltest sh -c "echo second msg 1>&2 ; cat" |& $tcltest cat + exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" \ + |& $::tcltest::tcltest sh -c "echo second msg 1>&2 ; cat" |& $::tcltest::tcltest cat } "second msg\nfoo bar" # I/O redirection: combinations. file delete gorp.file2 test exec-7.1 {multiple I/O redirections} {execCommandExists stdio} { - exec << "command input" > gorp.file2 $tcltest cat < gorp.file - exec $tcltest cat gorp.file2 + exec << "command input" > gorp.file2 $::tcltest::tcltest cat < gorp.file + exec $::tcltest::tcltest cat gorp.file2 } {Just a few thoughts} test exec-7.2 {multiple I/O redirections} {execCommandExists stdio} { - exec < gorp.file << "command input" $tcltest cat + exec < gorp.file << "command input" $::tcltest::tcltest cat } {command input} # Long input to command and output from command. @@ -276,13 +277,13 @@ set a [concat $a $a $a $a] set a [concat $a $a $a $a] set a [concat $a $a $a $a] test exec-8.1 {long input and output} {execCommandExists stdio} { - exec $tcltest cat << $a + exec $::tcltest::tcltest cat << $a } $a # More than 20 arguments to exec. test exec-8.1 {long input and output} {execCommandExists stdio} { - exec $tcltest echo 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 + exec $::tcltest::tcltest echo 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 } {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23} # Commands that return errors. @@ -292,24 +293,24 @@ test exec-9.1 {commands returning errors} {execCommandExists stdio} { list $x [string tolower $msg] [string tolower $errorCode] } {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}} test exec-9.2 {commands returning errors} {execCommandExists stdio} { - string tolower [list [catch {exec $tcltest echo foo | foo123} msg] $msg $errorCode] + string tolower [list [catch {exec $::tcltest::tcltest echo foo | foo123} msg] $msg $errorCode] } {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}} test exec-9.3 {commands returning errors} {execCommandExists stdio} { - list [catch {exec $tcltest sleep 1 | $tcltest exit 43 | $tcltest sleep 1} msg] $msg + list [catch {exec $::tcltest::tcltest sleep 1 | $::tcltest::tcltest exit 43 | $::tcltest::tcltest sleep 1} msg] $msg } {1 {child process exited abnormally}} test exec-9.4 {commands returning errors} {execCommandExists stdio} { - list [catch {exec $tcltest exit 43 | $tcltest echo "foo bar"} msg] $msg + list [catch {exec $::tcltest::tcltest exit 43 | $::tcltest::tcltest echo "foo bar"} msg] $msg } {1 {foo bar child process exited abnormally}} test exec-9.5 {commands returning errors} {execCommandExists stdio} { - list [catch {exec gorp456 | $tcltest echo a b c} msg] [string tolower $msg] + list [catch {exec gorp456 | $::tcltest::tcltest echo a b c} msg] [string tolower $msg] } {1 {couldn't execute "gorp456": no such file or directory}} test exec-9.6 {commands returning errors} {execCommandExists stdio} { - list [catch {exec $tcltest sh -c "echo error msg 1>&2"} msg] $msg + list [catch {exec $::tcltest::tcltest sh -c "echo error msg 1>&2"} msg] $msg } {1 {error msg}} test exec-9.7 {commands returning errors} {execCommandExists stdio} { - list [catch {exec $tcltest sh -c "echo error msg 1>&2" \ - | $tcltest sh -c "echo error msg 1>&2"} msg] $msg + list [catch {exec $::tcltest::tcltest sh -c "echo error msg 1>&2" \ + | $::tcltest::tcltest sh -c "echo error msg 1>&2"} msg] $msg } {1 {error msg error msg}} test exec-9.8 {commands returning errors} {execCommandExists stdio} { @@ -319,7 +320,7 @@ test exec-9.8 {commands returning errors} {execCommandExists stdio} { puts stderr err } close $f - list [catch {exec $tcltest err} msg] $msg + list [catch {exec $::tcltest::tcltest err} msg] $msg } {1 {out err}} @@ -391,35 +392,35 @@ test exec-10.20 {errors in exec invocation} {execCommandExists stdio} { list [catch {exec ~non_existent_user/foo/bar} msg] $msg } {1 {user "non_existent_user" doesn't exist}} test exec-10.21 {errors in exec invocation} {execCommandExists stdio} { - list [catch {exec $tcltest true | ~xyzzy_bad_user/x | false} msg] $msg + list [catch {exec $::tcltest::tcltest true | ~xyzzy_bad_user/x | false} msg] $msg } {1 {user "xyzzy_bad_user" doesn't exist}} # Commands in background. test exec-11.1 {commands in background} {execCommandExists stdio} { - set x [lindex [time {exec $tcltest sleep 2 &}] 0] + set x [lindex [time {exec $::tcltest::tcltest sleep 2 &}] 0] expr $x<1000000 } 1 test exec-11.2 {commands in background} {execCommandExists stdio} { - list [catch {exec $tcltest echo a &b} msg] $msg + list [catch {exec $::tcltest::tcltest echo a &b} msg] $msg } {0 {a &b}} test exec-11.3 {commands in background} {execCommandExists stdio} { - llength [exec $tcltest sleep 1 &] + llength [exec $::tcltest::tcltest sleep 1 &] } 1 test exec-11.4 {commands in background} {execCommandExists stdio} { - llength [exec $tcltest sleep 1 | $tcltest sleep 1 | $tcltest sleep 1 &] + llength [exec $::tcltest::tcltest sleep 1 | $::tcltest::tcltest sleep 1 | $::tcltest::tcltest sleep 1 &] } 3 test exec-11.5 {commands in background} {execCommandExists stdio} { set f [open gorp.file w] puts $f { catch { exec [info nameofexecutable] echo foo & } } close $f - string compare "foo" [exec $tcltest gorp.file] + string compare "foo" [exec $::tcltest::tcltest gorp.file] } 0 # Make sure that background commands are properly reaped when # they eventually die. -exec $tcltest sleep 3 +exec $::tcltest::tcltest sleep 3 test exec-12.1 {reaping background processes} \ {execCommandExists stdio unixOnly nonPortable} { for {set i 0} {$i < 20} {incr i} { @@ -463,10 +464,10 @@ test exec-12.3 {reaping background processes} \ # Make sure "errorCode" is set correctly. test exec-13.1 {setting errorCode variable} {execCommandExists stdio} { - list [catch {exec $tcltest cat < a/b/c} msg] [string tolower $errorCode] + list [catch {exec $::tcltest::tcltest cat < a/b/c} msg] [string tolower $errorCode] } {1 {posix enoent {no such file or directory}}} test exec-13.2 {setting errorCode variable} {execCommandExists stdio} { - list [catch {exec $tcltest cat > a/b/c} msg] [string tolower $errorCode] + list [catch {exec $::tcltest::tcltest cat > a/b/c} msg] [string tolower $errorCode] } {1 {posix enoent {no such file or directory}}} test exec-13.3 {setting errorCode variable} {execCommandExists stdio} { set x [catch {exec _weird_cmd_} msg] @@ -477,7 +478,7 @@ test exec-13.3 {setting errorCode variable} {execCommandExists stdio} { # Switches before the first argument test exec-14.1 {-keepnewline switch} {execCommandExists stdio} { - exec -keepnewline $tcltest echo foo + exec -keepnewline $::tcltest::tcltest echo foo } "foo\n" test exec-14.2 {-keepnewline switch} {execCommandExists stdio} { list [catch {exec -keepnewline} msg] $msg @@ -492,62 +493,62 @@ test exec-14.4 {-- switch} {execCommandExists stdio} { # Redirecting standard error separately from standard output test exec-15.1 {standard error redirection} {execCommandExists stdio} { - exec $tcltest echo "First line" > gorp.file - list [exec $tcltest sh -c "echo foo bar 1>&2" 2> gorp.file] \ - [exec $tcltest cat gorp.file] + exec $::tcltest::tcltest echo "First line" > gorp.file + list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" 2> gorp.file] \ + [exec $::tcltest::tcltest cat gorp.file] } {{} {foo bar}} test exec-15.2 {standard error redirection} {execCommandExists stdio} { - list [exec $tcltest sh -c "echo foo bar 1>&2" \ - | $tcltest echo biz baz >gorp.file 2> gorp.file2] \ - [exec $tcltest cat gorp.file] \ - [exec $tcltest cat gorp.file2] + list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" \ + | $::tcltest::tcltest echo biz baz >gorp.file 2> gorp.file2] \ + [exec $::tcltest::tcltest cat gorp.file] \ + [exec $::tcltest::tcltest cat gorp.file2] } {{} {biz baz} {foo bar}} test exec-15.3 {standard error redirection} {execCommandExists stdio} { - list [exec $tcltest sh -c "echo foo bar 1>&2" \ - | $tcltest echo biz baz 2>gorp.file > gorp.file2] \ - [exec $tcltest cat gorp.file] \ - [exec $tcltest cat gorp.file2] + list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" \ + | $::tcltest::tcltest echo biz baz 2>gorp.file > gorp.file2] \ + [exec $::tcltest::tcltest cat gorp.file] \ + [exec $::tcltest::tcltest cat gorp.file2] } {{} {foo bar} {biz baz}} test exec-15.4 {standard error redirection} {execCommandExists stdio} { set f [open gorp.file w] puts $f "Line 1" flush $f - exec $tcltest sh -c "echo foo bar 1>&2" 2>@ $f + exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" 2>@ $f puts $f "Line 3" close $f - exec $tcltest cat gorp.file + exec $::tcltest::tcltest cat gorp.file } {Line 1 foo bar Line 3} test exec-15.5 {standard error redirection} {execCommandExists stdio} { - exec $tcltest echo "First line" > gorp.file - exec $tcltest sh -c "echo foo bar 1>&2" 2>> gorp.file - exec $tcltest cat gorp.file + exec $::tcltest::tcltest echo "First line" > gorp.file + exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" 2>> gorp.file + exec $::tcltest::tcltest cat gorp.file } {First line foo bar} test exec-15.6 {standard error redirection} {execCommandExists stdio} { - exec $tcltest sh -c "echo foo bar 1>&2" > gorp.file2 2> gorp.file \ - >& gorp.file 2> gorp.file2 | $tcltest echo biz baz - list [exec $tcltest cat gorp.file] [exec $tcltest cat gorp.file2] + exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" > gorp.file2 2> gorp.file \ + >& gorp.file 2> gorp.file2 | $::tcltest::tcltest echo biz baz + list [exec $::tcltest::tcltest cat gorp.file] [exec $::tcltest::tcltest cat gorp.file2] } {{biz baz} {foo bar}} test exec-16.1 {flush output before exec} {execCommandExists stdio} { set f [open gorp.file w] puts $f "First line" - exec $tcltest echo "Second line" >@ $f + exec $::tcltest::tcltest echo "Second line" >@ $f puts $f "Third line" close $f - exec $tcltest cat gorp.file + exec $::tcltest::tcltest cat gorp.file } {First line Second line Third line} test exec-16.2 {flush output before exec} {execCommandExists stdio} { set f [open gorp.file w] puts $f "First line" - exec $tcltest << {puts stderr {Second line}} >&@ $f > gorp.file2 + exec $::tcltest::tcltest << {puts stderr {Second line}} >&@ $f > gorp.file2 puts $f "Third line" close $f - exec $tcltest cat gorp.file + exec $::tcltest::tcltest cat gorp.file } {First line Second line Third line} @@ -561,7 +562,7 @@ test exec-17.1 { inheriting standard I/O } {execCommandExists stdio} { close $f } close $f - catch {exec $tcltest script} result + catch {exec $::tcltest::tcltest script} result set f [open gorp.file r] lappend result [read $f] close $f diff --git a/tests/execute.test b/tests/execute.test index 71cc822..03040dc 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -14,10 +14,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: execute.test,v 1.4 1999/06/16 21:56:33 stanton Exp $ +# RCS: @(#) $Id: execute.test,v 1.5 1999/06/26 03:54:13 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {eval namespace delete [namespace children :: test_ns_*]} @@ -66,7 +67,6 @@ test execute-1.2 {TclExecuteByteCode, INST_LOAD_SCALAR1, large opnd} { } proc foo {} $body - foo } 1 test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} { proc foo {} { diff --git a/tests/expr-old.test b/tests/expr-old.test index aa5e035..e04aa95 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -13,10 +13,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr-old.test,v 1.5 1999/04/16 00:47:27 stanton Exp $ +# RCS: @(#) $Id: expr-old.test,v 1.6 1999/06/26 03:54:13 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { diff --git a/tests/expr.test b/tests/expr.test index 7b0135a..4a62a30 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr.test,v 1.3 1999/04/16 00:47:27 stanton Exp $ +# RCS: @(#) $Id: expr.test,v 1.4 1999/06/26 03:54:13 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { diff --git a/tests/fCmd.test b/tests/fCmd.test index e1fc391..dfd64a6 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -10,11 +10,12 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: fCmd.test,v 1.4 1999/04/16 00:47:27 stanton Exp $ +# RCS: @(#) $Id: fCmd.test,v 1.5 1999/06/26 03:54:13 jenn Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[string compare testgetplatform [info commands testgetplatform]] != 0} { diff --git a/tests/fileName.test b/tests/fileName.test index 426fd10..b16ad46 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: fileName.test,v 1.3 1999/04/16 00:47:27 stanton Exp $ +# RCS: @(#) $Id: fileName.test,v 1.4 1999/06/26 03:54:13 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testsetplatform] == {}} { diff --git a/tests/for-old.test b/tests/for-old.test index b2e2d39..cee66b6 100644 --- a/tests/for-old.test +++ b/tests/for-old.test @@ -12,10 +12,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: for-old.test,v 1.3 1999/04/16 00:47:27 stanton Exp $ +# RCS: @(#) $Id: for-old.test,v 1.4 1999/06/26 03:54:13 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Check "for" and its use of continue and break. diff --git a/tests/for.test b/tests/for.test index e60f17a..bdffa15 100644 --- a/tests/for.test +++ b/tests/for.test @@ -9,10 +9,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: for.test,v 1.4 1999/05/22 01:20:14 stanton Exp $ +# RCS: @(#) $Id: for.test,v 1.5 1999/06/26 03:54:13 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Basic "for" operation. diff --git a/tests/foreach.test b/tests/foreach.test index 66e626e..5a13035 100644 --- a/tests/foreach.test +++ b/tests/foreach.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: foreach.test,v 1.3 1999/04/16 00:47:27 stanton Exp $ +# RCS: @(#) $Id: foreach.test,v 1.4 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {unset a} diff --git a/tests/format.test b/tests/format.test index 2b52187..9e4a412 100644 --- a/tests/format.test +++ b/tests/format.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: format.test,v 1.4 1999/04/16 00:47:28 stanton Exp $ +# RCS: @(#) $Id: format.test,v 1.5 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespae import ::tcltest::* } # The following code is needed because some versions of SCO Unix have diff --git a/tests/get.test b/tests/get.test index 261cf19..45dd5d6 100644 --- a/tests/get.test +++ b/tests/get.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: get.test,v 1.3 1999/04/16 00:47:28 stanton Exp $ +# RCS: @(#) $Id: get.test,v 1.4 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test get-1.1 {Tcl_GetInt procedure} { diff --git a/tests/history.test b/tests/history.test index c7f7d20..76117f6 100644 --- a/tests/history.test +++ b/tests/history.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: history.test,v 1.3 1999/04/16 00:47:28 stanton Exp $ +# RCS: @(#) $Id: history.test,v 1.4 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[catch {history}]} { diff --git a/tests/http.test b/tests/http.test index 41ffd0b..2015c8e 100644 --- a/tests/http.test +++ b/tests/http.test @@ -12,10 +12,11 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # -# RCS: @(#) $Id: http.test,v 1.8 1999/06/08 18:06:51 hershey Exp $ +# RCS: @(#) $Id: http.test,v 1.9 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[catch {package require http 2.0}]} { @@ -39,13 +40,13 @@ catch {unset data} # Ensure httpd file exists -set origFile [file join $::tcltest::testsDir httpd] -set newFile [file join $::tcltest::workingDir httpd] +set origFile [file join $::tcltest::testsDirectory httpd] +set newFile [file join $::tcltest::workingDirectory httpd] if {![file exists $newFile]} { file copy $origFile $newFile set removeHttpd 1 } -set httpdFile [file join $::tcltest::workingDir httpd] +set httpdFile [file join $::tcltest::workingDirectory httpd] if {[info commands testthread] == "testthread" && [file exists $httpdFile]} { set httpthread [testthread create " diff --git a/tests/httpold.test b/tests/httpold.test index 7264023..50bb152 100644 --- a/tests/httpold.test +++ b/tests/httpold.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: httpold.test,v 1.4 1999/06/08 18:06:51 hershey Exp $ +# RCS: @(#) $Id: httpold.test,v 1.5 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[catch {package require http 1.0}]} { diff --git a/tests/if-old.test b/tests/if-old.test index d21b568..767d088 100644 --- a/tests/if-old.test +++ b/tests/if-old.test @@ -13,10 +13,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: if-old.test,v 1.3 1999/04/16 00:47:28 stanton Exp $ +# RCS: @(#) $Id: if-old.test,v 1.4 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test if-old-1.1 {taking proper branch} { diff --git a/tests/if.test b/tests/if.test index 99e7c37..cc3bb77 100644 --- a/tests/if.test +++ b/tests/if.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: if.test,v 1.3 1999/04/16 00:47:28 stanton Exp $ +# RCS: @(#) $Id: if.test,v 1.4 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Basic "if" operation. diff --git a/tests/incr-old.test b/tests/incr-old.test index 64b2012..789daa5 100644 --- a/tests/incr-old.test +++ b/tests/incr-old.test @@ -13,10 +13,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: incr-old.test,v 1.3 1999/04/16 00:47:28 stanton Exp $ +# RCS: @(#) $Id: incr-old.test,v 1.4 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {unset x} diff --git a/tests/incr.test b/tests/incr.test index 02ccf37..533b002 100644 --- a/tests/incr.test +++ b/tests/incr.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: incr.test,v 1.3 1999/04/16 00:47:28 stanton Exp $ +# RCS: @(#) $Id: incr.test,v 1.4 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Basic "incr" operation. diff --git a/tests/indexObj.test b/tests/indexObj.test index 979e5a8..9219a2c 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -8,10 +8,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: indexObj.test,v 1.3 1999/04/16 00:47:29 stanton Exp $ +# RCS: @(#) $Id: indexObj.test,v 1.4 1999/06/26 03:54:14 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testindexobj] == {}} { diff --git a/tests/info.test b/tests/info.test index 68690d9..cd90144 100644 --- a/tests/info.test +++ b/tests/info.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: info.test,v 1.7 1999/05/28 00:01:08 surles Exp $ +# RCS: @(#) $Id: info.test,v 1.8 1999/06/26 03:54:15 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Set up namespaces needed to test operation of "info args", "info body", diff --git a/tests/init.test b/tests/init.test index 4172606..bd9b486 100644 --- a/tests/init.test +++ b/tests/init.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: init.test,v 1.3 1999/04/16 00:47:29 stanton Exp $ +# RCS: @(#) $Id: init.test,v 1.4 1999/06/26 03:54:15 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Clear out any namespaces called test_ns_* @@ -61,12 +62,13 @@ test init-1.8 {auto_qualify - multiple colons 2} { set testInterp [interp create] interp eval $testInterp [list set argv $argv] -interp eval $testInterp [list source [file join $::tcltest::testsDir defs.tcl]] +interp eval $testInterp [list package require tcltest] +interp eval $testInterp [list namespace import ::tcltest::*] interp eval $testInterp { if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest } auto_reset diff --git a/tests/interp.test b/tests/interp.test index 817ef99..f4fe2ce 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.7 1999/04/16 00:47:29 stanton Exp $ +# RCS: @(#) $Id: interp.test,v 1.8 1999/06/26 03:54:15 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # The set of hidden commands is platform dependent: diff --git a/tests/io.test b/tests/io.test index aba370b..7b89bda 100644 --- a/tests/io.test +++ b/tests/io.test @@ -12,10 +12,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.8 1999/06/09 17:06:00 hershey Exp $ +# RCS: @(#) $Id: io.test,v 1.9 1999/06/26 03:54:15 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {"[info commands testchannel]" != "testchannel"} { @@ -114,7 +115,7 @@ test io-1.4 {unsupported0 command} {knownBug unixOrPc} { puts $f1 {puts [read $f1 100]} puts $f1 {close $f1} close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] gets $f1 puts $f1 ready flush $f1 @@ -450,7 +451,7 @@ test io-6.6 {Tcl_GetsObj: loop test} { test io-6.7 {Tcl_GetsObj: error in input} {stdio} { # if (FilterInputBytes(chanPtr, &gs) != 0) - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] puts -nonewline $f "hi\nwould" flush $f gets $f @@ -712,7 +713,7 @@ test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} { test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio} { # (FilterInputBytes() != 0) - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -translation {crlf lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r" fconfigure $f -buffersize 16 @@ -851,7 +852,7 @@ test io-6.42 {Tcl_GetsObj: auto mode: several chars} { test io-6.43 {Tcl_GetsObj: input saw cr} {stdio} { # if (chanPtr->flags & INPUT_SAW_CR) - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 @@ -868,7 +869,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio} { test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio} { # not (*eol == '\n') - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 @@ -885,7 +886,7 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio} { test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio} { # Tcl_ExternalToUtf() - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -translation {auto lf} -buffering none fconfigure $f -encoding unicode puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" @@ -902,7 +903,7 @@ test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio} { test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio} { # memmove() - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 @@ -1026,7 +1027,7 @@ test io-6.55 {Tcl_GetsObj: overconverted} { } [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"] test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio} { update - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -buffering none puts -nonewline $f "foobar" fconfigure $f -blocking 0 @@ -1085,7 +1086,7 @@ test io-7.3 {FilterInputBytes: split up character at EOF} { set x } [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""] test io-7.4 {FilterInputBytes: recover from split up character} {stdio} { - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -encoding binary -buffering none puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82" fconfigure $f -encoding shiftjis -blocking 0 @@ -1121,7 +1122,7 @@ test io-8.1 {PeekAhead: only go to device if no more cached data} { test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio} { # not (bufPtr->nextPtr == NULL) - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -translation lf -encoding ascii -buffering none puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz" set x {} @@ -1140,7 +1141,7 @@ test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio} { test io-8.3 {PeekAhead: no cached data available} {stdio} { # (bytesLeft == 0) - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -translation {auto binary} puts -nonewline $f "abcdefghijklmno\r" flush $f @@ -1173,7 +1174,7 @@ unset a test io-8.5 {PeekAhead: don't peek if last read was short} {stdio} { # (bufPtr->nextAdded < bufPtr->length) - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -translation {auto binary} puts -nonewline $f "abcdefghijklmno\r" flush $f @@ -1185,7 +1186,7 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio} { test io-8.6 {PeekAhead: change to non-blocking mode} {stdio} { # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -translation {auto binary} -buffersize 16 puts -nonewline $f "abcdefghijklmno\r" flush $f @@ -1197,7 +1198,7 @@ test io-8.6 {PeekAhead: change to non-blocking mode} {stdio} { test io-8.7 {PeekAhead: cleanup} {stdio} { # Make sure bytes are removed from buffer. - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -translation {auto binary} -buffering none puts -nonewline $f "abcdefghijklmno\r" # here @@ -1363,7 +1364,7 @@ test io-12.3 {ReadChars: allocate more space} { test io-12.4 {ReadChars: split-up char} {stdio} { # (srcRead == 0) - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -encoding binary -buffering none -buffersize 16 puts -nonewline $f "123456789012345\x96" fconfigure $f -encoding shiftjis -blocking 0 @@ -1391,7 +1392,7 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio} { gets stdin; puts -nonewline "\x89" gets stdin; puts -nonewline "\xa6" } test1 - set f [open "|[list $tcltest test1]" r+] + set f [open "|[list $::tcltest::tcltest test1]" r+] fileevent $f readable { lappend x [read $f] if {[eof $f]} { @@ -1483,7 +1484,7 @@ test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio} { # (chanPtr->flags & INPUT_SAW_CR) # This test may fail on slower machines. - set f [open "|[list $tcltest cat]" w+] + set f [open "|[list $::tcltest::tcltest cat]" w+] fconfigure $f -blocking 0 -buffering none -translation {auto lf} fileevent $f read "ready $f" @@ -1623,7 +1624,7 @@ test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {stdio} { close $f3 } close $f - set result [exec $tcltest test1] + set result [exec $::tcltest::tcltest test1] set f [open test2 r] set f2 [open test3 r] lappend result [read $f] [read $f2] @@ -1651,7 +1652,7 @@ test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOnly} { close $f3 } close $f - set result [exec $tcltest test1] + set result [exec $::tcltest::tcltest test1] set f [open test2 r] set f2 [open test3 r] lappend result [read $f] [read $f2] @@ -1706,7 +1707,7 @@ test io-14.8 {reuse of stdio special channels} {stdio} { puts [gets $f] } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] set c [gets $f] close $f set c @@ -1724,7 +1725,7 @@ test io-14.9 {reuse of stdio special channels} {stdio} { puts [gets $f] } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] set c [gets $f] close $f set c @@ -1901,7 +1902,7 @@ test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio} { puts stderr [fconfigure stdout -buffersize] } close $f - set f [open "|[list $tcltest script]"] + set f [open "|[list $::tcltest::tcltest script]"] catch {close $f} msg set msg } {777} @@ -1968,7 +1969,7 @@ test io-26.1 {Tcl_GetChannelInstanceData} {stdio} { # "pid" command uses Tcl_GetChannelInstanceData # Don't care what pid is (but must be a number), just want to exercise it. - set f [open "|[list $tcltest << exit]"] + set f [open "|[list $::tcltest::tcltest << exit]"] expr [pid $f] close $f } {} @@ -2059,7 +2060,7 @@ test io-27.6 {FlushChannel, async flushing, async close} \ } set f [open output w] close $f - set f [open "|[list $tcltest pipe]" w] + set f [open "|[list $::tcltest::tcltest pipe]" w] fconfigure $f -blocking off puts -nonewline $f $x close $f @@ -2135,7 +2136,7 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \ } set f [open output w] close $f - set f [open "|[list $tcltest pipe]" r+] + set f [open "|[list $::tcltest::tcltest pipe]" r+] fconfigure $f -blocking off -eofchar {} puts -nonewline $f $x @@ -2173,7 +2174,7 @@ test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly} { puts [testchannel open] } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] set l [gets $f] close $f set l @@ -2316,7 +2317,7 @@ test io-29.12 {Tcl_WriteChars on a pipe} {stdio} { } } close $f1 - set f1 [open "|[list $tcltest pipe]" r] + set f1 [open "|[list $::tcltest::tcltest pipe]" r] set f2 [open longfile r] set y ok for {set x 0} {$x < 10} {incr x} { @@ -2340,7 +2341,7 @@ test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio} { } close $f1 set y ok - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] fconfigure $f1 -buffering line set f2 [open longfile r] set line [gets $f2] @@ -2382,7 +2383,7 @@ test io-29.15 {Tcl_Flush, channel not open for writing} { [list 1 "channel \"$fd\" wasn't opened for writing"] } 0 test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio} { - set fd [open "|[list $tcltest cat longfile]" r] + set fd [open "|[list $::tcltest::tcltest cat longfile]" r] set x [list [catch {flush $fd} msg] $msg] catch {close $fd} string compare $x \ @@ -2462,7 +2463,7 @@ test io-29.21 {Tcl_Flush to pipe} {stdio} { puts $f1 {set cnt [string length $x]} puts $f1 {puts "read $cnt characters"} close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] puts $f1 hello flush $f1 set x [gets $f1] @@ -2482,7 +2483,7 @@ test io-29.22 {Tcl_Flush called at other end of pipe} {stdio} { flush stdout } close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] set x "" lappend x [gets $f1] lappend x [gets $f1] @@ -2502,7 +2503,7 @@ test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio} { puts bye } close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] set x "" lappend x [gets $f1] lappend x [gets $f1] @@ -2529,7 +2530,7 @@ test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} { } "{} {Line 1\nLine 2}" test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} { removeFile test3 - set f [open "|[list $tcltest cat | $tcltest cat > test3]" w] + set f [open "|[list $::tcltest::tcltest cat | $::tcltest::tcltest cat > test3]" w] puts $f "Line 1" puts $f "Line 2" close $f @@ -2552,7 +2553,7 @@ test io-29.27 {Tcl_Flush on closed pipeline} {stdio} { set f [open pipe w] puts $f {exit} close $f - set f [open "|[list $tcltest pipe]" r+] + set f [open "|[list $::tcltest::tcltest pipe]" r+] gets $f puts $f output after 50 @@ -2621,7 +2622,7 @@ test io-29.31 {Tcl_WriteChars, background flush} {stdio} { } set f [open output w] close $f - set f [open "|[list $tcltest pipe]" r+] + set f [open "|[list $::tcltest::tcltest pipe]" r+] fconfigure $f -blocking off puts -nonewline $f $x close $f @@ -2659,7 +2660,7 @@ test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ } set f [open output w] close $f - set f [open "|[list $tcltest pipe]" r+] + set f [open "|[list $::tcltest::tcltest pipe]" r+] fconfigure $f -blocking off puts -nonewline $f $x close $f @@ -2685,7 +2686,7 @@ test io-29.33 {Tcl_Flush, implicit flush on exit} {stdio} { puts $f strange } close $f - exec $tcltest script + exec $::tcltest::tcltest script set f [open test1 r] set r [read $f] close $f @@ -3886,7 +3887,7 @@ test io-32.10 {Tcl_Read from a pipe} {stdio} { set f1 [open pipe w] puts $f1 {puts [gets stdin]} close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] puts $f1 hello flush $f1 set x [read $f1] @@ -3899,7 +3900,7 @@ test io-32.11 {Tcl_Read from a pipe} {stdio} { puts $f1 {puts [gets stdin]} puts $f1 {puts [gets stdin]} close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] puts $f1 hello flush $f1 set x "" @@ -4008,7 +4009,7 @@ test io-33.3 {Tcl_Gets from pipe} {stdio} { set f1 [open pipe w] puts $f1 {puts [gets stdin]} close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] puts $f1 hello flush $f1 set x [gets $f1] @@ -4201,7 +4202,7 @@ test io-34.7 {Tcl_Seek to offset from end of file, then to current position} { list $c1 $r1 $c2 } {44 rstuv 49} test io-34.8 {Tcl_Seek on pipes: not supported} {stdio} { - set f1 [open "|[list $tcltest]" r+] + set f1 [open "|[list $::tcltest::tcltest]" r+] set x [list [catch {seek $f1 0 current} msg] $msg] close $f1 regsub {".*":} $x {"":} x @@ -4308,13 +4309,13 @@ test io-34.15 {Tcl_Tell combined with seeking} { list $c1 $c2 } {10 20} test io-34.16 {Tcl_tell on pipe: always -1} {stdio} { - set f1 [open "|[list $tcltest]" r+] + set f1 [open "|[list $::tcltest::tcltest]" r+] set c [tell $f1] close $f1 set c } -1 test io-34.17 {Tcl_Tell on pipe: always -1} {stdio} { - set f1 [open "|[list $tcltest]" r+] + set f1 [open "|[list $::tcltest::tcltest]" r+] puts $f1 {puts hello} flush $f1 set c [tell $f1] @@ -4396,7 +4397,7 @@ test io-35.2 {Tcl_Eof with pipe} {stdio} { puts $f1 {gets stdin} puts $f1 {puts hello} close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] puts $f1 hello set x [eof $f1] flush $f1 @@ -4414,7 +4415,7 @@ test io-35.3 {Tcl_Eof with pipe} {stdio} { puts $f1 {gets stdin} puts $f1 {puts hello} close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] puts $f1 hello set x [eof $f1] flush $f1 @@ -4449,7 +4450,7 @@ test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio} { exit } close $f - set f [open "|[list $tcltest pipe]" r] + set f [open "|[list $::tcltest::tcltest pipe]" r] set l "" lappend l [gets $f] lappend l [eof $f] @@ -4634,7 +4635,7 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} { # Test Tcl_InputBlocked test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio} { - set f1 [open "|[list $tcltest]" r+] + set f1 [open "|[list $::tcltest::tcltest]" r+] puts $f1 {puts hello_from_pipe} flush $f1 gets $f1 @@ -4653,7 +4654,7 @@ test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio} { set x } {{} 1 hello 0 {} 1} test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio} { - set f1 [open "|[list $tcltest]" r+] + set f1 [open "|[list $::tcltest::tcltest]" r+] fconfigure $f1 -buffering line puts $f1 {puts hello_from_pipe} set x "" @@ -4913,7 +4914,7 @@ test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio} { } close $f1 set x "" - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] fconfigure $f1 -blocking off -buffering line lappend x [fconfigure $f1 -blocking] lappend x [gets $f1] @@ -4994,7 +4995,7 @@ test io-39.16 {Tcl_SetChannelOption: -encoding, errors} { set result } {1 {unknown encoding "foobar"}} test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio} { - set f [open "|[list $tcltest cat]" r+] + set f [open "|[list $::tcltest::tcltest cat]" r+] fconfigure $f -encoding binary puts -nonewline $f "\xe7" flush $f @@ -5377,7 +5378,7 @@ test io-44.4 {FileEventProc procedure: eror in write event} {stdio unixExecs} { list $x [fileevent $f2 writable] } {bad-write {}} test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs} { - set f4 [open "|[list $tcltest cat << foo]" r] + set f4 [open "|[list $::tcltest::tcltest cat << foo]" r] fileevent $f4 readable { if {[gets $f4 line] < 0} { lappend x eof @@ -5670,7 +5671,7 @@ test io-48.3 {testing readability conditions} {unixOnly nonBlockFiles} { } } close $f - set f [open "|[list $tcltest]" r+] + set f [open "|[list $::tcltest::tcltest]" r+] fileevent $f readable [list consume $f] fconfigure $f -buffering line fconfigure $f -blocking off @@ -6422,7 +6423,7 @@ test io-52.8 {TclCopyChannel} {stdio} { close \$f1 " close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] fconfigure $f1 -translation lf gets $f1 puts $f1 ready @@ -6480,7 +6481,7 @@ test io-53.3 {CopyData: background read underflow} {unixOnly} { close $f } close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] set result [gets $f1] puts $f1 line1 flush $f1 @@ -6513,7 +6514,7 @@ test io-53.4 {CopyData: background write overflow} {unixOnly} { close $f } close $f1 - set f1 [open "|[list $tcltest pipe]" r+] + set f1 [open "|[list $::tcltest::tcltest pipe]" r+] set result [gets $f1] fconfigure $f1 -blocking 0 puts $f1 $big @@ -6566,7 +6567,7 @@ test io-53.6 {CopyData: error during fcopy} {stdio} { set f1 [open pipe w] puts $f1 "exit 1" close $f1 - set in [open "|[list $tcltest pipe]" r+] + set in [open "|[list $::tcltest::tcltest pipe]" r+] set out [open test1 w] fcopy $in $out -command [list FcopyTestDone] if ![info exists fcopyTestDone] { @@ -6780,7 +6781,7 @@ test io-58.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} { } } close $out - set pipe [open "|[list $tcltest] script" r] + set pipe [open "|[list $::tcltest::tcltest] script" r] fileevent $pipe readable [list readit $pipe] set x "" set result "" @@ -6793,7 +6794,7 @@ foreach file [list fooBar longfile script output test1 pipe my_script foo \ bar test2 test3 cat stdout] { ::tcltest::removeFile $file } -restoreState +::tcltest::restoreState ::tcltest::cleanupTests return diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 3ff3cb5..eaec167 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -12,10 +12,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioCmd.test,v 1.5 1999/05/18 20:18:38 hershey Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.6 1999/06/26 03:54:15 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } removeFile test1 diff --git a/tests/ioUtil.test b/tests/ioUtil.test index 5bb8c35..78b5094 100644 --- a/tests/ioUtil.test +++ b/tests/ioUtil.test @@ -8,10 +8,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioUtil.test,v 1.6 1999/04/16 00:47:29 stanton Exp $ +# RCS: @(#) $Id: ioUtil.test,v 1.7 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } set unsetScript { diff --git a/tests/join.test b/tests/join.test index 6194c7d..2c98c40 100644 --- a/tests/join.test +++ b/tests/join.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: join.test,v 1.3 1999/04/16 00:47:29 stanton Exp $ +# RCS: @(#) $Id: join.test,v 1.4 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test join-1.1 {basic join commands} { diff --git a/tests/lindex.test b/tests/lindex.test index a19fde4..625d8dc 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: lindex.test,v 1.5 1999/05/06 18:46:43 stanton Exp $ +# RCS: @(#) $Id: lindex.test,v 1.6 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test lindex-1.1 {basic tests} { diff --git a/tests/link.test b/tests/link.test index 4ea079c..843333b 100644 --- a/tests/link.test +++ b/tests/link.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: link.test,v 1.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: link.test,v 1.4 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testlink] == {}} { diff --git a/tests/linsert.test b/tests/linsert.test index e8ca689..c1e42a6 100644 --- a/tests/linsert.test +++ b/tests/linsert.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: linsert.test,v 1.5 1999/05/06 18:46:43 stanton Exp $ +# RCS: @(#) $Id: linsert.test,v 1.6 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {unset lis} diff --git a/tests/list.test b/tests/list.test index fa83038..54624a5 100644 --- a/tests/list.test +++ b/tests/list.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: list.test,v 1.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: list.test,v 1.4 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # First, a bunch of individual tests diff --git a/tests/listObj.test b/tests/listObj.test index 2c9e58e..863122c 100644 --- a/tests/listObj.test +++ b/tests/listObj.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: listObj.test,v 1.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: listObj.test,v 1.4 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testobj] == {}} { diff --git a/tests/llength.test b/tests/llength.test index 40c0d73..0de94f4 100644 --- a/tests/llength.test +++ b/tests/llength.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: llength.test,v 1.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: llength.test,v 1.4 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test llength-1.1 {length of list} { diff --git a/tests/load.test b/tests/load.test index 8bbfb98..72082c2 100644 --- a/tests/load.test +++ b/tests/load.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: load.test,v 1.4 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: load.test,v 1.5 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Figure out what extension is used for shared libraries on this diff --git a/tests/lrange.test b/tests/lrange.test index c928b19..db29efb 100644 --- a/tests/lrange.test +++ b/tests/lrange.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: lrange.test,v 1.5 1999/05/06 18:46:43 stanton Exp $ +# RCS: @(#) $Id: lrange.test,v 1.6 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test lrange-1.1 {range of list elements} { diff --git a/tests/lreplace.test b/tests/lreplace.test index 868d98e..94d0f71 100644 --- a/tests/lreplace.test +++ b/tests/lreplace.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: lreplace.test,v 1.5 1999/05/06 18:46:43 stanton Exp $ +# RCS: @(#) $Id: lreplace.test,v 1.6 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test lreplace-1.1 {lreplace command} { diff --git a/tests/lsearch.test b/tests/lsearch.test index 498607b..9d4ba13 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: lsearch.test,v 1.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: lsearch.test,v 1.4 1999/06/26 03:54:16 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } set x {abcd bbcd 123 234 345} diff --git a/tests/macFCmd.test b/tests/macFCmd.test index bbb5df8..2dd1f68 100644 --- a/tests/macFCmd.test +++ b/tests/macFCmd.test @@ -10,11 +10,12 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: macFCmd.test,v 1.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: macFCmd.test,v 1.4 1999/06/26 03:54:17 jenn Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {file delete -force foo.dir} diff --git a/tests/misc.test b/tests/misc.test index 67c2216..ab5bb30 100644 --- a/tests/misc.test +++ b/tests/misc.test @@ -12,10 +12,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: misc.test,v 1.3 1999/04/16 00:47:30 stanton Exp $ +# RCS: @(#) $Id: misc.test,v 1.4 1999/06/26 03:54:17 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test misc-1.1 {error in variable ref. in command in array reference} { diff --git a/tests/msgcat.test b/tests/msgcat.test index 1d000a3..ae0b295 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -12,10 +12,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: msgcat.test,v 1.4 1999/04/21 21:50:30 rjohnson Exp $ +# RCS: @(#) $Id: msgcat.test,v 1.5 1999/06/26 03:54:17 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[catch {package require msgcat 1.0}]} { diff --git a/tests/namespace-old.test b/tests/namespace-old.test index d8a736e..2fc8ab1 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -14,10 +14,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace-old.test,v 1.3 1999/04/16 00:47:31 stanton Exp $ +# RCS: @(#) $Id: namespace-old.test,v 1.4 1999/06/26 03:54:17 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Clear out any namespaces called test_ns_* diff --git a/tests/namespace.test b/tests/namespace.test index 54f1149..c852a7d 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace.test,v 1.4 1999/04/16 00:47:31 stanton Exp $ +# RCS: @(#) $Id: namespace.test,v 1.5 1999/06/26 03:54:17 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Clear out any namespaces called test_ns_* diff --git a/tests/obj.test b/tests/obj.test index ce7738d..f23bf42 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: obj.test,v 1.3 1999/04/16 00:47:31 stanton Exp $ +# RCS: @(#) $Id: obj.test,v 1.4 1999/06/26 03:54:17 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testobj] == {}} { diff --git a/tests/opt.test b/tests/opt.test index 3ca62f2..552280a 100644 --- a/tests/opt.test +++ b/tests/opt.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: opt.test,v 1.4 1999/04/16 00:47:31 stanton Exp $ +# RCS: @(#) $Id: opt.test,v 1.5 1999/06/26 03:54:18 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # the package we are going to test diff --git a/tests/osa.test b/tests/osa.test index 4b061cf..42322bb 100644 --- a/tests/osa.test +++ b/tests/osa.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: osa.test,v 1.3 1999/04/16 00:47:31 stanton Exp $ +# RCS: @(#) $Id: osa.test,v 1.4 1999/06/26 03:54:18 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Only run the test if we can load the AppleScript command diff --git a/tests/parse.test b/tests/parse.test index ccedc77..9fee75f 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -8,10 +8,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parse.test,v 1.4 1999/04/30 22:45:03 stanton Exp $ +# RCS: @(#) $Id: parse.test,v 1.5 1999/06/26 03:54:18 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testparser] == {}} { diff --git a/tests/parseExpr.test b/tests/parseExpr.test index e454321..199f9e5 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -8,10 +8,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parseExpr.test,v 1.2 1999/04/16 00:47:31 stanton Exp $ +# RCS: @(#) $Id: parseExpr.test,v 1.3 1999/06/26 03:54:19 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Note that the Tcl expression parser (tclParseExpr.c) does not check diff --git a/tests/parseOld.test b/tests/parseOld.test index 3f799d6..50cf625 100644 --- a/tests/parseOld.test +++ b/tests/parseOld.test @@ -13,10 +13,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parseOld.test,v 1.2 1999/04/16 00:47:32 stanton Exp $ +# RCS: @(#) $Id: parseOld.test,v 1.3 1999/06/26 03:54:19 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } proc fourArgs {a b c d} { diff --git a/tests/pid.test b/tests/pid.test index 3f8275b..a896aaf 100644 --- a/tests/pid.test +++ b/tests/pid.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: pid.test,v 1.3 1999/04/16 00:47:32 stanton Exp $ +# RCS: @(#) $Id: pid.test,v 1.4 1999/06/26 03:54:19 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # If pid is not defined just return with no error diff --git a/tests/pkg.test b/tests/pkg.test index 02ffc14..aa0ea7e 100644 --- a/tests/pkg.test +++ b/tests/pkg.test @@ -10,17 +10,18 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: pkg.test,v 1.4 1999/04/16 00:47:32 stanton Exp $ +# RCS: @(#) $Id: pkg.test,v 1.5 1999/06/26 03:54:20 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Do all this in a slave interp to avoid garbaging the # package list set i [interp create] interp eval $i [list set argv $argv] -interp eval $i [list source [file join $::tcltest::testsDir defs.tcl]] +interp eval $i [list source [file join $::tcltest::testsDirectory defs.tcl]] interp eval $i { eval package forget [package names] diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index ce9d00a..8f8313a 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -8,19 +8,20 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: pkgMkIndex.test,v 1.8 1999/04/21 21:50:31 rjohnson Exp $ +# RCS: @(#) $Id: pkgMkIndex.test,v 1.9 1999/06/26 03:54:20 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } -set fullPkgPath [file join $::tcltest::testsDir pkg] +set fullPkgPath [file join $::tcltest::testsDirectory pkg] # Add the pkg1 directory to auto_path, so that its packages can be found. # packages in pkg1 are used to test indexing of packages in pkg. # Make sure that the path to pkg1 is absolute. -lappend auto_path [file join $::tcltest::testsDir pkg1] +lappend auto_path [file join $::tcltest::testsDirectory pkg1] namespace eval pkgtest { # Namespace for procs we can discard diff --git a/tests/platform.test b/tests/platform.test index b81103c..c5d9794 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -12,7 +12,8 @@ # RCS: @(#) if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test platform-1.1 {TclpSetVariables: tcl_platform} { diff --git a/tests/proc-old.test b/tests/proc-old.test index a57e147..a802c63 100644 --- a/tests/proc-old.test +++ b/tests/proc-old.test @@ -14,10 +14,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: proc-old.test,v 1.3 1999/04/16 00:47:32 stanton Exp $ +# RCS: @(#) $Id: proc-old.test,v 1.4 1999/06/26 03:54:21 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {rename t1 ""} diff --git a/tests/proc.test b/tests/proc.test index 60f5d8e..c22a85f 100644 --- a/tests/proc.test +++ b/tests/proc.test @@ -13,10 +13,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: proc.test,v 1.4 1999/04/16 00:47:32 stanton Exp $ +# RCS: @(#) $Id: proc.test,v 1.5 1999/06/26 03:54:21 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {eval namespace delete [namespace children :: test_ns_*]} diff --git a/tests/pwd.test b/tests/pwd.test index 0656b63..c1f6c48 100644 --- a/tests/pwd.test +++ b/tests/pwd.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: pwd.test,v 1.3 1999/04/16 00:47:32 stanton Exp $ +# RCS: @(#) $Id: pwd.test,v 1.4 1999/06/26 03:54:22 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test pwd-1.1 {simple pwd} { diff --git a/tests/reg.test b/tests/reg.test index 503c3bc..b5bfc8e 100644 --- a/tests/reg.test +++ b/tests/reg.test @@ -6,10 +6,11 @@ # # Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. # -# RCS: @(#) $Id: reg.test,v 1.5 1999/06/25 18:42:14 stanton Exp $ +# RCS: @(#) $Id: reg.test,v 1.6 1999/06/26 03:54:22 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # All tests require the testregexp command, return if this diff --git a/tests/regexp.test b/tests/regexp.test index 781cf24..0d1e021 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: regexp.test,v 1.6 1999/06/17 19:31:50 stanton Exp $ +# RCS: @(#) $Id: regexp.test,v 1.7 1999/06/26 03:54:22 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {unset foo} @@ -404,7 +405,7 @@ test regexp-14.2 {CompileRegexp: regexp cache, different flags} { } 1 test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} { makeFile {puts [regexp {} foo]} junk.tcl - exec $tcltest junk.tcl + exec $::tcltest::tcltest junk.tcl } 1 set x 1 diff --git a/tests/registry.test b/tests/registry.test index 773f964..4fe7382 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -10,10 +10,11 @@ # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# RCS: @(#) $Id: registry.test,v 1.5 1999/04/16 00:47:33 stanton Exp $ +# RCS: @(#) $Id: registry.test,v 1.6 1999/06/26 03:54:23 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {$tcl_platform(platform) == "windows"} { diff --git a/tests/rename.test b/tests/rename.test index 14cdf05..b85a3ec 100644 --- a/tests/rename.test +++ b/tests/rename.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: rename.test,v 1.3 1999/04/16 00:47:33 stanton Exp $ +# RCS: @(#) $Id: rename.test,v 1.4 1999/06/26 03:54:23 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Must eliminate the "unknown" command while the test is running, diff --git a/tests/resource.test b/tests/resource.test index b5f341a..f49077b 100644 --- a/tests/resource.test +++ b/tests/resource.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: resource.test,v 1.4 1999/04/16 00:47:33 stanton Exp $ +# RCS: @(#) $Id: resource.test,v 1.5 1999/06/26 03:54:24 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test resource-1.1 {resource tests} {macOnly} { diff --git a/tests/result.test b/tests/result.test index 3f77fdc..febbf94 100644 --- a/tests/result.test +++ b/tests/result.test @@ -13,7 +13,8 @@ # SCCS: @(#) result.test 1.4 97/12/08 15:07:49 if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Some tests require the testsaveresult command diff --git a/tests/safe.test b/tests/safe.test index 5149c59..8d8aa14 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.test,v 1.5 1999/04/16 00:47:33 stanton Exp $ +# RCS: @(#) $Id: safe.test,v 1.6 1999/06/26 03:54:24 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } foreach i [interp slaves] { diff --git a/tests/scan.test b/tests/scan.test index aa86a4d..b777a76 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: scan.test,v 1.4 1999/04/16 00:47:34 stanton Exp $ +# RCS: @(#) $Id: scan.test,v 1.5 1999/06/26 03:54:25 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test scan-1.1 {BuildCharSet, CharInSet} { diff --git a/tests/security.test b/tests/security.test index d75696a..ae5f58b 100644 --- a/tests/security.test +++ b/tests/security.test @@ -10,10 +10,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: security.test,v 1.2 1999/04/16 00:47:34 stanton Exp $ +# RCS: @(#) $Id: security.test,v 1.3 1999/06/26 03:54:25 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # If this proc becomes invoked, then there is a bug diff --git a/tests/set-old.test b/tests/set-old.test index 08e2cd1..51ddb9e 100644 --- a/tests/set-old.test +++ b/tests/set-old.test @@ -13,10 +13,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: set-old.test,v 1.4 1999/04/16 00:47:34 stanton Exp $ +# RCS: @(#) $Id: set-old.test,v 1.5 1999/06/26 03:54:26 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } proc ignore args {} diff --git a/tests/set.test b/tests/set.test index 7ffeb75..00d9951 100644 --- a/tests/set.test +++ b/tests/set.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: set.test,v 1.3 1999/04/16 00:47:34 stanton Exp $ +# RCS: @(#) $Id: set.test,v 1.4 1999/06/26 03:54:26 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {unset x} diff --git a/tests/socket.test b/tests/socket.test index dc8331c..36b3b44 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: socket.test,v 1.9 1999/04/21 21:50:31 rjohnson Exp $ +# RCS: @(#) $Id: socket.test,v 1.10 1999/06/26 03:54:26 jenn Exp $ # Running socket tests with a remote server: # ------------------------------------------ @@ -63,7 +63,8 @@ # using the remote server are not performed. if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Some tests require the testthread command @@ -123,7 +124,7 @@ if {$doTestsWithRemoteServer} { set remoteServerIP 127.0.0.1 set remoteFile [file join [pwd] remote.tcl] if {[catch {set remoteProcChan \ - [open "|[list $tcltest $remoteFile \ + [open "|[list $::tcltest::tcltest $remoteFile \ -serverIsSilent \ -port $remoteServerPort \ -address $remoteServerIP]" \ @@ -138,7 +139,7 @@ if {$doTestsWithRemoteServer} { set doTestsWithRemoteServer 0 } } else { - set noRemoteTestReason "$msg $tcltest" + set noRemoteTestReason "$msg $::tcltest::tcltest" set doTestsWithRemoteServer 0 } } @@ -261,7 +262,7 @@ test socket-2.1 {tcp connection} {socket stdio} { puts $x } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {socket 127.0.0.1 2828} msg]} { set x $msg @@ -297,7 +298,7 @@ test socket-2.2 {tcp connection with client port specified} {socket stdio} { close $f } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] gets $f x global port if {[catch {socket -myport $port 127.0.0.1 2829} sock]} { @@ -331,7 +332,7 @@ test socket-2.3 {tcp connection with client interface specified} {socket stdio} close $f } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} { set x $sock @@ -362,7 +363,7 @@ test socket-2.4 {tcp connection with server interface specified} {socket stdio} close $f } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {socket [info hostname] 2831} sock]} { set x $sock @@ -393,7 +394,7 @@ test socket-2.5 {tcp connection with redundant server port} {socket stdio} { close $f } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {socket 127.0.0.1 2832} sock]} { set x $sock @@ -443,7 +444,7 @@ test socket-2.7 {echo server, one line} {socket stdio} { puts done } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [socket 127.0.0.1 2834] fconfigure $s -buffering line -translation lf @@ -482,7 +483,7 @@ test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} { close $f puts "done $i" } script - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [socket 127.0.0.1 2835] fconfigure $s -buffering line @@ -503,7 +504,7 @@ test socket-2.9 {socket conflict} {socket stdio} { set f [open script w] puts -nonewline $f {socket -server accept 2828} close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] gets $f after 100 set x [list [catch {close $f} msg] $msg] @@ -575,7 +576,7 @@ test socket-3.1 {socket conflict} {socket stdio} { close $f } close $f - set f [open "|[list $tcltest script]" r+] + set f [open "|[list $::tcltest::tcltest script]" r+] gets $f set x [list [catch {socket -server accept 2828} msg] \ $msg] @@ -617,7 +618,7 @@ test socket-3.2 {server with several clients} {socket stdio} { puts $x } close $f - set f [open "|[list $tcltest script]" r+] + set f [open "|[list $::tcltest::tcltest script]" r+] set x [gets $f] set s1 [socket 127.0.0.1 2828] fconfigure $s1 -buffering line @@ -657,11 +658,11 @@ test socket-4.1 {server with several clients} {socket stdio} { gets stdin } close $f - set p1 [open "|[list $tcltest script]" r+] + set p1 [open "|[list $::tcltest::tcltest script]" r+] fconfigure $p1 -buffering line - set p2 [open "|[list $tcltest script]" r+] + set p2 [open "|[list $::tcltest::tcltest script]" r+] fconfigure $p2 -buffering line - set p3 [open "|[list $tcltest script]" r+] + set p3 [open "|[list $::tcltest::tcltest script]" r+] fconfigure $p3 -buffering line proc accept {s a p} { fconfigure $s -buffering line @@ -748,7 +749,7 @@ test socket-6.1 {accept callback error} {socket stdio} { socket 127.0.0.1 2848 } close $f - set f [open "|[list $tcltest script]" r+] + set f [open "|[list $::tcltest::tcltest script]" r+] proc bgerror args { global x set x $args @@ -780,7 +781,7 @@ test socket-7.1 {testing socket specific options} {socket stdio} { after cancel $timer } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [socket 127.0.0.1 2820] set p [fconfigure $s -peername] @@ -806,7 +807,7 @@ test socket-7.2 {testing socket specific options} {socket stdio} { after cancel $timer } close $f - set f [open "|[list $tcltest script]" r] + set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [socket 127.0.0.1 2821] set p [fconfigure $s -sockname] @@ -1382,13 +1383,13 @@ test socket-12.1 {testing inheritance of server sockets} \ # be closed unless script1 inherited it. set f [open script2 w] - puts $f [list set tcltest $tcltest] + puts $f [list set tcltest $::tcltest::tcltest] puts $f { set f [socket -server accept 2828] proc accept { file addr port } { close $file } - exec $tcltest script1 & + exec $::tcltest::tcltest script1 & close $f after 1000 exit vwait forever @@ -1397,7 +1398,7 @@ test socket-12.1 {testing inheritance of server sockets} \ # Launch script2 and wait 5 seconds - exec $tcltest script2 & + exec $::tcltest::tcltest script2 & after 5000 { set ok_to_proceed 1 } vwait ok_to_proceed @@ -1434,10 +1435,10 @@ test socket-12.2 {testing inheritance of client sockets} \ # client socket, the socket will still be open. set f [open script2 w] - puts $f [list set tcltest $tcltest] + puts $f [list set tcltest $::tcltest::tcltest] puts $f { set f [socket 127.0.0.1 2829] - exec $tcltest script1 & + exec $::tcltest::tcltest script1 & puts $f testing flush $f after 1000 exit @@ -1490,7 +1491,7 @@ test socket-12.2 {testing inheritance of client sockets} \ # Launch the script2 process - exec $tcltest script2 & + exec $::tcltest::tcltest script2 & vwait x if {!$failed} { @@ -1513,13 +1514,13 @@ test socket-12.3 {testing inheritance of accepted sockets} \ close $f set f [open script2 w] - puts $f [list set tcltest $tcltest] + puts $f [list set tcltest $::tcltest::tcltest] puts $f { set server [socket -server accept 2930] proc accept { file host port } { global tcltest puts $file {test data on socket} - exec $tcltest script1 & + exec $::tcltest::tcltest script1 & after 1000 exit } vwait forever @@ -1529,7 +1530,7 @@ test socket-12.3 {testing inheritance of accepted sockets} \ # Launch the script2 process and connect to it. See how long # the socket stays open - exec $tcltest script2 & + exec $::tcltest::tcltest script2 & after 1000 set ok_to_proceed 1 vwait ok_to_proceed diff --git a/tests/source.test b/tests/source.test index 74a3589..a0001f7 100644 --- a/tests/source.test +++ b/tests/source.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: source.test,v 1.3 1999/04/16 00:47:34 stanton Exp $ +# RCS: @(#) $Id: source.test,v 1.4 1999/06/26 03:54:27 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test source-1.1 {source command} { diff --git a/tests/split.test b/tests/split.test index fc78e84..a474cb0 100644 --- a/tests/split.test +++ b/tests/split.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: split.test,v 1.3 1999/04/16 00:47:34 stanton Exp $ +# RCS: @(#) $Id: split.test,v 1.4 1999/06/26 03:54:27 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test split-1.1 {basic split commands} { diff --git a/tests/stack.test b/tests/stack.test index 1e62788..55f04ae 100644 --- a/tests/stack.test +++ b/tests/stack.test @@ -9,10 +9,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stack.test,v 1.2 1999/04/16 00:47:34 stanton Exp $ +# RCS: @(#) $Id: stack.test,v 1.3 1999/06/26 03:54:27 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Note that a failure in this test results in a crash of the executable. diff --git a/tests/string.test b/tests/string.test index 6a0bdfd..3a7e8be 100644 --- a/tests/string.test +++ b/tests/string.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: string.test,v 1.14 1999/06/24 03:27:57 stanton Exp $ +# RCS: @(#) $Id: string.test,v 1.15 1999/06/26 03:54:28 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Some tests require the testobj command diff --git a/tests/stringObj.test b/tests/stringObj.test index 3ea2573..28d550e 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -12,10 +12,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stringObj.test,v 1.6 1999/06/15 22:06:18 hershey Exp $ +# RCS: @(#) $Id: stringObj.test,v 1.7 1999/06/26 03:54:28 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testobj] == {}} { diff --git a/tests/subst.test b/tests/subst.test index 51546d2..da2be4b 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: subst.test,v 1.3 1999/04/16 00:47:35 stanton Exp $ +# RCS: @(#) $Id: subst.test,v 1.4 1999/06/26 03:54:29 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test subst-1.1 {basics} { diff --git a/tests/switch.test b/tests/switch.test index cdbfc61..388b13e 100644 --- a/tests/switch.test +++ b/tests/switch.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: switch.test,v 1.3 1999/04/16 00:47:35 stanton Exp $ +# RCS: @(#) $Id: switch.test,v 1.4 1999/06/26 03:54:29 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test switch-1.1 {simple patterns} { diff --git a/tests/thread.test b/tests/thread.test index 14ecab8..1144c11 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: thread.test,v 1.4 1999/04/21 21:50:31 rjohnson Exp $ +# RCS: @(#) $Id: thread.test,v 1.5 1999/06/26 03:54:29 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Some tests require the testthread command diff --git a/tests/timer.test b/tests/timer.test index 0e6f4e6..24f782a 100644 --- a/tests/timer.test +++ b/tests/timer.test @@ -13,10 +13,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: timer.test,v 1.3 1999/04/16 00:47:35 stanton Exp $ +# RCS: @(#) $Id: timer.test,v 1.4 1999/06/26 03:54:30 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test timer-1.1 {Tcl_CreateTimerHandler procedure} { diff --git a/tests/trace.test b/tests/trace.test index a2dd45e..13d3982 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.3 1999/04/16 00:47:35 stanton Exp $ +# RCS: @(#) $Id: trace.test,v 1.4 1999/06/26 03:54:30 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } proc traceScalar {name1 name2 op} { diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index d026aa3..9b28d4f 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -9,10 +9,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixFCmd.test,v 1.6 1999/04/16 00:47:35 stanton Exp $ +# RCS: @(#) $Id: unixFCmd.test,v 1.7 1999/06/26 03:54:31 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Several tests require need to match results against the unix username diff --git a/tests/unixFile.test b/tests/unixFile.test index c18ac20..9f623fd 100644 --- a/tests/unixFile.test +++ b/tests/unixFile.test @@ -9,10 +9,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixFile.test,v 1.3 1999/04/16 00:47:35 stanton Exp $ +# RCS: @(#) $Id: unixFile.test,v 1.4 1999/06/26 03:54:31 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testobj] == {}} { diff --git a/tests/unixInit.test b/tests/unixInit.test index 84fcdb0..3c84a38 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixInit.test,v 1.5 1999/04/24 01:46:53 stanton Exp $ +# RCS: @(#) $Id: unixInit.test,v 1.6 1999/06/26 03:54:31 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {set oldlibrary $env(TCL_LIBRARY); unset env(TCL_LIBRARY)} @@ -23,7 +24,7 @@ set env(LANG) C # Some tests will fail if they are run on a machine that doesn't have # this Tcl version installed (as opposed to built) on it. if {[catch { - set f [open "|[list $tcltest]" w+] + set f [open "|[list $::tcltest::tcltest]" w+] exec kill -PIPE [pid $f] close $f }]} { @@ -37,14 +38,14 @@ test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} { # Watch out for a race condition here. If tcltest is too slow to start # then we'll kill it before it has a chance to set up its signal handler. - set f [open "|[list $tcltest]" w+] + set f [open "|[list $::tcltest::tcltest]" w+] puts $f "puts hi" flush $f gets $f exec kill -PIPE [pid $f] lappend x [catch {close $f}] - set f [open "|[list $tcltest]" w+] + set f [open "|[list $::tcltest::tcltest]" w+] puts $f "puts hi" flush $f gets $f @@ -54,7 +55,7 @@ test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} { set x } {0 1} -proc getlibpath "{program [list $tcltest]}" { +proc getlibpath "{program [list $::tcltest::tcltest]}" { set f [open "|$program" w+] fconfigure $f -buffering none puts $f {puts $tcl_libPath; exit} @@ -86,7 +87,7 @@ test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} \ } else { set developLib tcl[info tclversion]/library } - set prefix [file dirname [file dirname $tcltest]] + set prefix [file dirname [file dirname $::tcltest::tcltest]] set x {} lappend x [string compare [lindex $path 0] $prefix/$installLib] @@ -131,7 +132,7 @@ test unixInit-2.6 {TclpInitLibraryPath: executable relative} \ {unixOnly installedTcl} { file delete -force /tmp/sparkly file mkdir /tmp/sparkly/bin - file copy $tcltest /tmp/sparkly/bin/tcltest + file copy $::tcltest::tcltest /tmp/sparkly/bin/tcltest file mkdir /tmp/sparkly/lib/tcl[info tclversion] close [open /tmp/sparkly/lib/tcl[info tclversion]/init.tcl w] @@ -148,7 +149,7 @@ test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \ test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} { set env(LANG) C - set f [open "|[list $tcltest]" w+] + set f [open "|[list $::tcltest::tcltest]" w+] fconfigure $f -buffering none puts $f {puts [encoding system]; exit} set enc [gets $f] @@ -160,7 +161,7 @@ test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} { test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly installedTcl} { set env(LANG) japanese - set f [open "|[list $tcltest]" w+] + set f [open "|[list $::tcltest::tcltest]" w+] fconfigure $f -buffering none puts $f {puts [encoding system]; exit} set enc [gets $f] diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test index 2775597..132c771 100644 --- a/tests/unixNotfy.test +++ b/tests/unixNotfy.test @@ -10,14 +10,15 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixNotfy.test,v 1.4 1999/04/16 00:47:36 stanton Exp $ +# RCS: @(#) $Id: unixNotfy.test,v 1.5 1999/06/26 03:54:32 jenn Exp $ # The tests should not be run if you have a notifier which is unable to # detect infinite vwaits, as the tests below will hang. The presence of # the "testthread" command indicates that this is the case. if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } set ::tcltest::testConfig(testthread) \ diff --git a/tests/unknown.test b/tests/unknown.test index 791a9d1..3dab4e1 100644 --- a/tests/unknown.test +++ b/tests/unknown.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unknown.test,v 1.3 1999/04/16 00:47:36 stanton Exp $ +# RCS: @(#) $Id: unknown.test,v 1.4 1999/06/26 03:54:32 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {unset x} diff --git a/tests/uplevel.test b/tests/uplevel.test index 857c8e1..d26e900 100644 --- a/tests/uplevel.test +++ b/tests/uplevel.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: uplevel.test,v 1.3 1999/04/16 00:47:36 stanton Exp $ +# RCS: @(#) $Id: uplevel.test,v 1.4 1999/06/26 03:54:32 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } proc a {x y} { diff --git a/tests/upvar.test b/tests/upvar.test index 2fe81c9..35b8f2f 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -11,10 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: upvar.test,v 1.4 1999/04/16 00:47:36 stanton Exp $ +# RCS: @(#) $Id: upvar.test,v 1.5 1999/06/26 03:54:32 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test upvar-1.1 {reading variables with upvar} { diff --git a/tests/utf.test b/tests/utf.test index 28d5643..800e21d 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -8,10 +8,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: utf.test,v 1.3 1999/06/03 18:43:30 stanton Exp $ +# RCS: @(#) $Id: utf.test,v 1.4 1999/06/26 03:54:32 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {unset x} diff --git a/tests/util.test b/tests/util.test index 3c8b7b0..06b1bf8 100644 --- a/tests/util.test +++ b/tests/util.test @@ -7,10 +7,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: util.test,v 1.4 1999/04/16 00:47:36 stanton Exp $ +# RCS: @(#) $Id: util.test,v 1.5 1999/06/26 03:54:33 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {[info commands testobj] == {}} { diff --git a/tests/var.test b/tests/var.test index 9145fc5..a6e54ff 100644 --- a/tests/var.test +++ b/tests/var.test @@ -14,11 +14,12 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: var.test,v 1.5 1999/04/16 00:47:36 stanton Exp $ +# RCS: @(#) $Id: var.test,v 1.6 1999/06/26 03:54:33 jenn Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } catch {rename p ""} diff --git a/tests/while-old.test b/tests/while-old.test index f0d55ab..ac181f3 100644 --- a/tests/while-old.test +++ b/tests/while-old.test @@ -13,10 +13,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: while-old.test,v 1.3 1999/04/16 00:47:36 stanton Exp $ +# RCS: @(#) $Id: while-old.test,v 1.4 1999/06/26 03:54:33 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test while-old-1.1 {basic while loops} { diff --git a/tests/while.test b/tests/while.test index f4c7581..5708dec 100644 --- a/tests/while.test +++ b/tests/while.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: while.test,v 1.3 1999/04/16 00:47:36 stanton Exp $ +# RCS: @(#) $Id: while.test,v 1.4 1999/06/26 03:54:34 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # Basic "while" operation. diff --git a/tests/winConsole.test b/tests/winConsole.test index 8a18b2c..c6b6fc2 100644 --- a/tests/winConsole.test +++ b/tests/winConsole.test @@ -9,10 +9,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winConsole.test,v 1.2 1999/04/16 00:47:36 stanton Exp $ +# RCS: @(#) $Id: winConsole.test,v 1.3 1999/06/26 03:54:34 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } diff --git a/tests/winDde.test b/tests/winDde.test index e9b65d8..4ac101d 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -9,10 +9,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winDde.test,v 1.2 1999/04/16 00:47:37 stanton Exp $ +# RCS: @(#) $Id: winDde.test,v 1.3 1999/06/26 03:54:34 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } if {$tcl_platform(platform) == "windows"} { diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 935198e..7566c2e 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -10,11 +10,12 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winFCmd.test,v 1.4 1999/04/16 00:47:37 stanton Exp $ +# RCS: @(#) $Id: winFCmd.test,v 1.5 1999/06/26 03:54:34 jenn Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } proc createfile {file {string a}} { diff --git a/tests/winFile.test b/tests/winFile.test index c343141..622dcdb 100644 --- a/tests/winFile.test +++ b/tests/winFile.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winFile.test,v 1.3 1999/04/21 21:50:32 rjohnson Exp $ +# RCS: @(#) $Id: winFile.test,v 1.4 1999/06/26 03:54:35 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } test winFile-1.1 {TclpGetUserHome} {pcOnly} { diff --git a/tests/winNotify.test b/tests/winNotify.test index c8c3d9e..13c8f9a 100644 --- a/tests/winNotify.test +++ b/tests/winNotify.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winNotify.test,v 1.3 1999/04/16 00:47:37 stanton Exp $ +# RCS: @(#) $Id: winNotify.test,v 1.4 1999/06/26 03:54:35 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } set ::tcltest::testConfig(testeventloop) \ diff --git a/tests/winPipe.test b/tests/winPipe.test index e93a39e..ba45ad7 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -12,10 +12,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winPipe.test,v 1.7 1999/05/21 19:05:04 redman Exp $ +# RCS: @(#) $Id: winPipe.test,v 1.8 1999/06/26 03:54:35 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } set bindir [file join [pwd] [file dirname [info nameofexecutable]]] @@ -71,11 +72,11 @@ test winpipe-1.2 {32 bit comprehensive tests: from big file} {pcOnly stdio cat32 list [contents stdout] [contents stderr] } "{$big} stderr32" test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {nt stdio cat32} { - exec $tcltest more < little | $cat32 > stdout 2> stderr + exec $::tcltest::tcltest more < little | $cat32 > stdout 2> stderr list [contents stdout] [contents stderr] } {little stderr32} test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {nt stdio cat32} { - exec $tcltest more < big | $cat32 > stdout 2> stderr + exec $::tcltest::tcltest more < big | $cat32 > stdout 2> stderr list [contents stdout] [contents stderr] } "{$big} stderr32" test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {95 stdio cat32} { @@ -124,12 +125,12 @@ test winpipe-1.13 {32 bit comprehensive tests: a lot to file} \ } "{$big} stderr32" test winpipe-1.14 {32 bit comprehensive tests: a little to pipe} \ {pcOnly stdio cat32} { - exec $cat32 < little | $tcltest more > stdout 2> stderr + exec $cat32 < little | $::tcltest::tcltest more > stdout 2> stderr list [contents stdout] [contents stderr] } {little stderr32} test winpipe-1.15 {32 bit comprehensive tests: a lot to pipe} \ {pcOnly stdio cat32} { - exec $cat32 < big | $tcltest more > stdout 2> stderr + exec $cat32 < big | $::tcltest::tcltest more > stdout 2> stderr list [contents stdout] [contents stderr] } "{$big} stderr32" test winpipe-1.16 {32 bit comprehensive tests: to console} {pcOnly stdio cat32} { @@ -185,7 +186,7 @@ test winpipe-2.2 {16 bit comprehensive tests: from big file} {pcOnly stdio cat16 list [contents stdout] [contents stderr] } "{$big} stderr16" test winpipe-2.3 {16 bit comprehensive tests: a little from pipe} {pcOnly stdio cat16} { - exec $tcltest more < little | $cat16 > stdout 2> stderr + exec $::tcltest::tcltest more < little | $cat16 > stdout 2> stderr list [contents stdout] [contents stderr] } {little stderr16} test winpipe-2.4 {16 bit comprehensive tests: a lot from pipe} {nt stdio cat16} { @@ -193,7 +194,7 @@ test winpipe-2.4 {16 bit comprehensive tests: a lot from pipe} {nt stdio cat16} list [contents stdout] [contents stderr] } "{$big} stderr16stderr16" test winpipe-2.5 {16 bit comprehensive tests: a lot from pipe} {95 stdio cat16} { - exec $tcltest more < big | $cat16 > stdout 2> stderr + exec $::tcltest::tcltest more < big | $cat16 > stdout 2> stderr list [contents stdout] [contents stderr] } "{$big} stderr16" test winpipe-2.6 {16 bit comprehensive tests: from console} \ @@ -232,11 +233,11 @@ test winpipe-2.13 {16 bit comprehensive tests: a lot to file} {pcOnly stdio cat1 list [contents stdout] [contents stderr] } "{$big} stderr16" test winpipe-2.14 {16 bit comprehensive tests: a little to pipe} {pcOnly stdio cat16} { - exec $cat16 < little | $tcltest more > stdout 2> stderr + exec $cat16 < little | $::tcltest::tcltest more > stdout 2> stderr list [contents stdout] [contents stderr] } {little stderr16} test winpipe-2.15 {16 bit comprehensive tests: a lot to pipe} {pcOnly stdio cat16} { - exec $cat16 < big | $tcltest more > stdout 2> stderr + exec $cat16 < big | $::tcltest::tcltest more > stdout 2> stderr list [contents stdout] [contents stderr] } "{$big} stderr16" test winpipe-2.16 {16 bit comprehensive tests: to console} {pcOnly stdio cat16} { @@ -308,7 +309,7 @@ set env(TEMP) c:/ test winpipe-4.1 {TclpCreateTempFile: cleanup temp files} {pcOnly stdio} { set x {} set existing [glob -nocomplain c:/tcl*.tmp] - exec $tcltest < nothing + exec $::tcltest::tcltest < nothing foreach p [glob -nocomplain c:/tcl*.tmp] { if {[lsearch $existing $p] == -1} { lappend x $p @@ -321,7 +322,7 @@ test winpipe-4.2 {TclpCreateTempFile: TMP and TEMP not defined} {pcOnly stdio} { set temp $env(TEMP) unset env(TMP) unset env(TEMP) - exec $tcltest < nothing + exec $::tcltest::tcltest < nothing set env(TMP) $tmp set env(TEMP) $temp set x {} @@ -330,7 +331,7 @@ test winpipe-4.3 {TclpCreateTempFile: TMP specifies non-existent directory} \ {pcOnly stdio} { set tmp $env(TMP) set env(TMP) snarky - exec $tcltest < nothing + exec $::tcltest::tcltest < nothing set env(TMP) $tmp set x {} } {} @@ -340,7 +341,7 @@ test winpipe-4.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \ set temp $env(TEMP) unset env(TMP) set env(TEMP) snarky - exec $tcltest < nothing + exec $::tcltest::tcltest < nothing set env(TMP) $tmp set env(TEMP) $temp set x {} @@ -385,10 +386,10 @@ makeFile { } echoArgs.tcl test winpipe-4.1 {BuildCommandLine: null arguments} {pcOnly stdio} { - exec $tcltest echoArgs.tcl foo "" bar + exec $::tcltest::tcltest echoArgs.tcl foo "" bar } {echoArgs.tcl {foo {} bar}} test winpipe-4.1 {BuildCommandLine: null arguments} {pcOnly stdio} { - exec $tcltest echoArgs.tcl foo \" bar + exec $::tcltest::tcltest echoArgs.tcl foo \" bar } {echoArgs.tcl {foo {"} bar}} # restore old values for env(TMP) and env(TEMP) diff --git a/tests/winTime.test b/tests/winTime.test index 417f4bc..9ba05cd 100644 --- a/tests/winTime.test +++ b/tests/winTime.test @@ -10,10 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winTime.test,v 1.2 1999/04/16 00:47:37 stanton Exp $ +# RCS: @(#) $Id: winTime.test,v 1.3 1999/06/26 03:54:36 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import ::tcltest::* } # The next two tests will crash on Windows if the check for negative |