summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjenn <jenn>1999-06-26 03:54:09 (GMT)
committerjenn <jenn>1999-06-26 03:54:09 (GMT)
commitc750824920529a5930ca3a8c4301a9cf9c45d6a4 (patch)
tree475011f75181f78a0a48f3360124d7e98188018e
parentf95999e4e240586c6002c721425f7b17e84f3637 (diff)
downloadtcl-c750824920529a5930ca3a8c4301a9cf9c45d6a4.zip
tcl-c750824920529a5930ca3a8c4301a9cf9c45d6a4.tar.gz
tcl-c750824920529a5930ca3a8c4301a9cf9c45d6a4.tar.bz2
Modified the tests to use the package tcltest
-rw-r--r--tests/README345
-rw-r--r--tests/all.tcl12
-rw-r--r--tests/append.test5
-rw-r--r--tests/assocd.test5
-rw-r--r--tests/async.test5
-rw-r--r--tests/autoMkindex.test12
-rw-r--r--tests/basic.test5
-rw-r--r--tests/binary.test5
-rw-r--r--tests/case.test5
-rw-r--r--tests/clock.test5
-rw-r--r--tests/cmdAH.test5
-rw-r--r--tests/cmdIL.test5
-rw-r--r--tests/cmdInfo.test5
-rw-r--r--tests/cmdMZ.test5
-rw-r--r--tests/compExpr-old.test5
-rw-r--r--tests/compExpr.test5
-rw-r--r--tests/compile.test5
-rw-r--r--tests/concat.test5
-rw-r--r--tests/dcall.test5
-rw-r--r--tests/defs.tcl1087
-rw-r--r--tests/dstring.test5
-rw-r--r--tests/encoding.test5
-rw-r--r--tests/env.test7
-rw-r--r--tests/error.test5
-rw-r--r--tests/eval.test5
-rw-r--r--tests/event.test5
-rw-r--r--tests/exec.test201
-rw-r--r--tests/execute.test6
-rw-r--r--tests/expr-old.test5
-rw-r--r--tests/expr.test5
-rw-r--r--tests/fCmd.test5
-rw-r--r--tests/fileName.test5
-rw-r--r--tests/for-old.test5
-rw-r--r--tests/for.test5
-rw-r--r--tests/foreach.test5
-rw-r--r--tests/format.test5
-rw-r--r--tests/get.test5
-rw-r--r--tests/history.test5
-rw-r--r--tests/http.test11
-rw-r--r--tests/httpold.test5
-rw-r--r--tests/if-old.test5
-rw-r--r--tests/if.test5
-rw-r--r--tests/incr-old.test5
-rw-r--r--tests/incr.test5
-rw-r--r--tests/indexObj.test5
-rw-r--r--tests/info.test5
-rw-r--r--tests/init.test10
-rw-r--r--tests/interp.test5
-rw-r--r--tests/io.test121
-rw-r--r--tests/ioCmd.test5
-rw-r--r--tests/ioUtil.test5
-rw-r--r--tests/join.test5
-rw-r--r--tests/lindex.test5
-rw-r--r--tests/link.test5
-rw-r--r--tests/linsert.test5
-rw-r--r--tests/list.test5
-rw-r--r--tests/listObj.test5
-rw-r--r--tests/llength.test5
-rw-r--r--tests/load.test5
-rw-r--r--tests/lrange.test5
-rw-r--r--tests/lreplace.test5
-rw-r--r--tests/lsearch.test5
-rw-r--r--tests/macFCmd.test5
-rw-r--r--tests/misc.test5
-rw-r--r--tests/msgcat.test5
-rw-r--r--tests/namespace-old.test5
-rw-r--r--tests/namespace.test5
-rw-r--r--tests/obj.test5
-rw-r--r--tests/opt.test5
-rw-r--r--tests/osa.test5
-rw-r--r--tests/parse.test5
-rw-r--r--tests/parseExpr.test5
-rw-r--r--tests/parseOld.test5
-rw-r--r--tests/pid.test5
-rw-r--r--tests/pkg.test7
-rw-r--r--tests/pkgMkIndex.test9
-rw-r--r--tests/platform.test3
-rw-r--r--tests/proc-old.test5
-rw-r--r--tests/proc.test5
-rw-r--r--tests/pwd.test5
-rw-r--r--tests/reg.test5
-rw-r--r--tests/regexp.test7
-rw-r--r--tests/registry.test5
-rw-r--r--tests/rename.test5
-rw-r--r--tests/resource.test5
-rw-r--r--tests/result.test3
-rw-r--r--tests/safe.test5
-rw-r--r--tests/scan.test5
-rw-r--r--tests/security.test5
-rw-r--r--tests/set-old.test5
-rw-r--r--tests/set.test5
-rw-r--r--tests/socket.test59
-rw-r--r--tests/source.test5
-rw-r--r--tests/split.test5
-rw-r--r--tests/stack.test5
-rw-r--r--tests/string.test5
-rw-r--r--tests/stringObj.test5
-rw-r--r--tests/subst.test5
-rw-r--r--tests/switch.test5
-rw-r--r--tests/thread.test5
-rw-r--r--tests/timer.test5
-rw-r--r--tests/trace.test5
-rw-r--r--tests/unixFCmd.test5
-rw-r--r--tests/unixFile.test5
-rw-r--r--tests/unixInit.test21
-rw-r--r--tests/unixNotfy.test5
-rw-r--r--tests/unknown.test5
-rw-r--r--tests/uplevel.test5
-rw-r--r--tests/upvar.test5
-rw-r--r--tests/utf.test5
-rw-r--r--tests/util.test5
-rw-r--r--tests/var.test5
-rw-r--r--tests/while-old.test5
-rw-r--r--tests/while.test5
-rw-r--r--tests/winConsole.test5
-rw-r--r--tests/winDde.test5
-rw-r--r--tests/winFCmd.test5
-rw-r--r--tests/winFile.test5
-rw-r--r--tests/winNotify.test5
-rw-r--r--tests/winPipe.test33
-rw-r--r--tests/winTime.test5
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