summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--tests/README104
-rw-r--r--tests/cmdMZ.test24
-rw-r--r--tests/encoding.test93
-rw-r--r--tests/fCmd.test11
-rw-r--r--tests/info.test3
-rw-r--r--tests/interp.test54
7 files changed, 133 insertions, 163 deletions
diff --git a/ChangeLog b/ChangeLog
index b672f8e..235e336 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,12 @@
2002-06-30 Don Porter <dgp@users.sourceforge.net>
+ * tests/README: Updated the instructions on running and
+ * tests/cmdMZ.test: adding to the test suite. Also updated
+ * tests/encoding.test: several tests, mostly to correctly create
+ * tests/fCmd.test: and destroy any temporary files in the
+ * tests/info.test: [temporaryDirectory] of tcltest.
+ * tests/interp.test:
+
* library/tcltest/tcltest.tcl: Stopped checking for writeability
of -tmpdir value because no default directory can be guaranteed to
be writeable.
diff --git a/tests/README b/tests/README
index 8b2fa4f..4a82e91 100644
--- a/tests/README
+++ b/tests/README
@@ -1,6 +1,6 @@
README -- Tcl test suite design document.
-RCS: @(#) $Id: README,v 1.8 1999/08/31 21:49:27 jenn Exp $
+RCS: @(#) $Id: README,v 1.9 2002/07/01 07:52:02 dgp Exp $
Contents:
---------
@@ -23,75 +23,16 @@ You can run the tests in three ways:
(a) type "make test" in ../unix; this will run all of the tests.
(b) type "tcltest <testFile> ?<option> <value>?
- Command line options include:
-
- -help display usage information
-
- -verbose <level> set the level of verbosity to a substring
- of "bps". See the "Test output" section
- of the tcltest man page for an
- explanation of this option.
-
- -match <matchList> only run tests that match one or more of
- the glob patterns in <matchList>
-
- -skip <skipList> do not run tests that match one or more
- of the glob patterns in <skipList>
-
- -file <globPatternList>
- only source test files that match one or
- more of the glob patterns in
- <globPatternList> (relative to the
- "tests" directory). This option only
- applies when you run the test suite with
- the "all.tcl" file.
-
- -notfile <globPatternList>
- do not source test files that match one
- or more of the patterns in
- <globPatternList> (relative to the
- "tests" directory). This option only
- applies when you run the test suite with
- the "all.tcl" file.
-
- -constraints <list> tests with any constraints in <list> will
- not be skipped. Not that elements of
- <list> must exactly match the existing
- constraints.
-
- -limitconstraints <bool>
- If 1, limit test runs to those tests that
- match the constraints listed using the
- -constraints flag. Use of this flag
- requires use of the -constraints flag.
- The default value is 0.
-
- -tmpdir <dirname> put temporary files created by
- ::tcltest::makeFile and
- ::tcltest::makeDirectory in the named
- directory. The default location is
- ::tcltest::workingDirectory.
-
- -preservecore <level>
- check for core files. If level is 0,
- check for core files only when
- cleanupTests is called from an all.tcl
- file. If 1, also check at the end of
- every test command. If 2, also save core
- files in ::tcltest::temporaryDirectory.
- The default level is 0.
+
+ where the options and values are the configuration options
+ of the tcltest package.
(c) start up tcltest in this directory, then "source" the test
file (for example, type "source parse.test"). To run all
of the tests, type "source all.tcl". To use the options in
- interactive mode, you can set their corresponding tcltest
- namespace variables after loading the tcltest package.
- For example, some of the tcltest variables are:
- ::tcltest::match
- ::tcltest::skip
- ::tcltest::testConstraints(nonPortable)
- ::tcltest::testConstraints(knownBug)
- ::tcltest::testConstraints(userInteractive)
+ interactive mode, you can set them with the tcltest::configure
+ command. Set constraints with the tcltest::testConstraints
+ command.
Please see the tcltest man page for more information regarding how to
write and run tests.
@@ -108,25 +49,25 @@ correspond to any Tcl or C code file so they should match the pattern
Be sure your new test file can be run from any working directory.
Be sure no temporary files are left behind by your test file.
+Use [tcltest::makeFile], [tcltest::removeFile], and [tcltest::cleanupTests]
+properly to be sure of this.
Be sure your tests can run cross-platform in both a build environment
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.
-2. Incompatibilities with prior Tcl versions:
----------------------------------------------
-
-1) Global variables such as VERBOSE, TESTS, and testConfig are now
- renamed to use the new "tcltest" namespace.
+2. Incompatibilities of package tcltest 2.1 with
+ testing machinery of very old versions of Tcl:
+------------------------------------------------
- old name new name
- -------- --------
- VERBOSE ::tcltest::verbose
- TESTS ::tcltest::match
- testConfig ::tcltest::testConstraints
+1) Global variables such as VERBOSE, TESTS, and testConfig of the
+ old machinery correspond to the [configure -verbose],
+ [configure -match], and [testConstraint] commands of tcltest 2.1,
+ respectively.
-2) VERBOSE values are no longer numeric.
+2) VERBOSE values were longer numeric. [configure -verbose] values
+ are lists of keywords.
3) When you run "make test", the working dir for the test suite is now
the one from which you called "make test", rather than the "tests"
@@ -135,13 +76,12 @@ the constraints mechanism to skip those tests.
other or with existing files. All tests must now run independently
of their working directory.
-4) The "all" and "visual" files are now called "all.tcl" and
- "visual_bb.test".
+4) The "all" file is now called "all.tcl"
5) The "defs" file no longer exists.
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::testConstraints(nonPortable) variable to 1 (after
- loading the tcltest package).
+ command line flag. If you are running interactively, you can run
+ [tcltest::testConstraint nonPortable 1] (after loading the tcltest
+ package).
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index d2a57f9..cf7a1a9 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -11,7 +11,7 @@
# 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.9 2001/11/23 01:25:54 das Exp $
+# RCS: @(#) $Id: cmdMZ.test,v 1.10 2002/07/01 07:52:02 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -85,22 +85,26 @@ test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
list [catch {source a b} msg] $msg
} {1 {wrong # args: should be "source fileName"}}
-test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} {
- makeFile {
+test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body {
+ set file [makeFile {
set x 146
error "error in sourced file"
set y $x
- } source.file
- list [catch {source source.file} msg] $msg $errorInfo
-} {1 {error in sourced file} {error in sourced file
+ } source.file]
+ set result [list [catch {source $file} msg] $msg $errorInfo]
+ removeFile source.file
+ set result
+} -match glob -result {1 {error in sourced file} {error in sourced file
while executing
"error "error in sourced file""
- (file "source.file" line 3)
+ (file "*" line 3)
invoked from within
-"source source.file"}}
+"source $file"}}
test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
- makeFile {list result} source.file
- source source.file
+ set file [makeFile {list result} source.file]
+ set result [source $file]
+ removeFile source.file
+ set result
} result
# Tcl_SplitObjCmd
diff --git a/tests/encoding.test b/tests/encoding.test
index fb6f0c3..cf0392b 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -8,7 +8,7 @@
# 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.13 2002/06/22 04:19:47 dgp Exp $
+# RCS: @(#) $Id: encoding.test,v 1.14 2002/07/01 07:52:02 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -90,10 +90,10 @@ test encoding-3.2 {Tcl_GetEncodingName, non-null} {
} {jis0208}
test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
- file mkdir tmp/encoding
- close [open tmp/encoding/junk.enc w]
- close [open tmp/encoding/junk2.enc w]
- cd tmp
+ cd [makeDirectory tmp]
+ makeDirectory [file join tmp encoding]
+ makeFile {} [file join tmp encoding junk.enc]
+ makeFile {} [file join tmp encoding junk2.enc]
set path [testencoding path]
testencoding path {}
catch {unset encodings}
@@ -108,8 +108,11 @@ test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
}
}
testencoding path $path
- cd ..
- file delete -force tmp
+ cd [workingDirectory]
+ removeFile [file join tmp encoding junk2.enc]
+ removeFile [file join tmp encoding junk.enc]
+ removeDirectory [file join tmp encoding]
+ removeDirectory tmp
lsort $x
} {junk junk2}
@@ -158,15 +161,15 @@ test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
} "512 \u4e4e"
test encoding-8.1 {Tcl_ExternalToUtf} {
- set f [open dummy w]
+ set f [open [file join [temporaryDirectory] dummy] w]
fconfigure $f -translation binary -encoding iso8859-1
puts -nonewline $f "ab\x8c\xc1g"
close $f
- set f [open dummy r]
+ set f [open [file join [temporaryDirectory] dummy] r]
fconfigure $f -translation binary -encoding shiftjis
set x [read $f]
close $f
- file delete dummy
+ file delete [file join [temporaryDirectory] dummy]
set x
} "ab\u4e4eg"
@@ -186,15 +189,15 @@ test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
} "1024 8C"
test encoding-10.1 {Tcl_UtfToExternal} {
- set f [open dummy w]
+ set f [open [file join [temporaryDirectory] dummy] w]
fconfigure $f -translation binary -encoding shiftjis
puts -nonewline $f "ab\u4e4eg"
close $f
- set f [open dummy r]
+ set f [open [file join [temporaryDirectory] dummy] r]
fconfigure $f -translation binary -encoding iso8859-1
set x [read $f]
close $f
- file delete dummy
+ file delete [file join [temporaryDirectory] dummy]
set x
} "ab\x8c\xc1g"
@@ -239,15 +242,19 @@ test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
set system [encoding system]
set path [testencoding path]
encoding system identity
+ cd [temporaryDirectory]
testencoding path tmp
- file mkdir tmp/encoding
- set f [open tmp/encoding/splat.enc w]
+ makeDirectory tmp
+ makeDirectory [file join tmp encoding]
+ set f [open [file join tmp encoding splat.enc] w]
fconfigure $f -translation binary
puts $f "abcdefghijklmnop"
close $f
set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]
- file delete -force tmp
- catch {file delete encoding}
+ file delete [file join [temporaryDirectory] tmp encoding splat.enc]
+ removeDirectory [file join tmp encoding]
+ removeDirectory tmp
+ cd [workingDirectory]
testencoding path $path
encoding system $system
set x
@@ -325,6 +332,7 @@ set ::iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3
\u0063\u0061\u0073\u0069\u006e\u006f\u005f\u006a\u0061\u0070\u0061\u006e\u0065\u0073\u0065\u0040\u005f\u005f\u005f\u002e\u0063\u006f\u006d\u0020\uff09\u307e\u3067\u3054\u4f4f\u6240\u5909\u66f4\u6e08\u306e\u9023\u7d61\u3092\u3044\u305f\u3060\u3051\u306a\u3044\u3067
\u3057\u3087\u3046\u304b\uff1f"
+cd [temporaryDirectory]
set fid [open iso2022.txt w]
fconfigure $fid -encoding binary
puts -nonewline $fid $::iso2022encData
@@ -362,50 +370,55 @@ test encoding-23.3 {iso2022-jp escape encoding test} {
close $fid
set data
} [string range $::iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
+cd [workingDirectory]
-test encoding-24.1 {EscapeFreeProc on open channels} {exec} {
+test encoding-24.1 {EscapeFreeProc on open channels} -constraints {
+ exec
+} -setup {
# Bug #524674 input
- set f [open iso2022.tcl w]
- puts $f {
- set f [open iso2022.txt]
+ set file [makeFile {
+ set f [open [file join [file dirname [info script]] iso2022.txt]]
fconfigure $f -encoding iso2022-jp
gets $f
- }
- close $f
- exec $::tcltest::tcltest iso2022.tcl
-} {}
-
-test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
+ } iso2022.tcl]
+} -body {
+ exec $::tcltest::tcltest $file
+} -cleanup {
+ removeFile iso2022.tcl
+} -result {}
+
+test encoding-24.2 {EscapeFreeProc on open channels} -constraints {
+ exec
+} -setup {
# Bug #524674 output
- set f [open iso2022.tcl w]
- puts $f {
+ set file [makeFile {
fconfigure stdout -encoding iso2022-jp
puts ab\u4e4e\u68d9g
exit
- }
- close $f
- viewable [exec $::tcltest::tcltest iso2022.tcl]
-} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
+ } iso2022.tcl]
+} -body {
+ viewable [exec $::tcltest::tcltest $file]
+} -cleanup {
+ removeFile iso2022.tcl
+} -result "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
test encoding-24.3 {EscapeFreeProc on open channels} {exec} {
# Bug #219314 - if we don't free escape encodings correctly on
# channel closure, we go boom
- set f [open iso2022.tcl w]
- puts $f {
+ set file [makeFile {
encoding system iso2022-jp
set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
puts $a
- }
- close $f
- set f [open "|[list $::tcltest::tcltest iso2022.tcl]"]
+ } iso2022.tcl]
+ set f [open "|[list $::tcltest::tcltest $file]"]
fconfigure $f -encoding iso2022-jp
set count [gets $f line]
close $f
+ removeFile iso2022.tcl
list $count [viewable $line]
} [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"]
-::tcltest::removeFile iso2022.txt
-::tcltest::removeFile iso2022.tcl
+file delete [file join [temporaryDirectory] iso2022.txt]
# EscapeFreeProc, GetTableEncoding, unilen
# are fully tested by the rest of this file
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 94db157..131ace5 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.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: fCmd.test,v 1.15 2002/06/22 04:19:47 dgp Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.16 2002/07/01 07:52:02 dgp Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -2195,13 +2195,12 @@ test fCmd-28.4 {file link} {hasLinks} {
list [catch {file link -abc b c} msg] $msg
} {1 {bad switch "-abc": must be -symbolic or -hard}}
-catch {file delete -force abc.dir}
-catch {file delete -force abc2.dir}
makeDirectory abc.dir
makeDirectory abc2.dir
makeFile contents abc.file
makeFile contents abc2.file
+cd [temporaryDirectory]
test fCmd-28.5 {file link: source already exists} {linkDirectory} {
list [catch {file link abc.dir abc2.dir} msg] $msg
} {1 {could not create new link "abc.dir": that path already exists}}
@@ -2295,6 +2294,12 @@ test fCmd-28.18 {file link: glob -type d} {linkDirectory} {
} [lsort [list abc.link abc.dir abc2.dir]]
file delete -force abc.link
+cd [workingDirectory]
+
+removeFile abc2.file
+removeFile abc.file
+removeDirectory abc2.dir
+removeDirectory abc.dir
# cleanup
cleanup
diff --git a/tests/info.test b/tests/info.test
index db20d58..4f87e99 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -11,7 +11,7 @@
# 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.23 2002/06/11 13:56:20 dkf Exp $
+# RCS: @(#) $Id: info.test,v 1.24 2002/07/01 07:52:03 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -521,7 +521,6 @@ test info-16.1 {info script option} {
test info-16.2 {info script option} {
file tail [info sc]
} "info.test"
-removeFile gorp.info
set gorpfile [makeFile "info script\n" gorp.info]
test info-16.3 {info script option} {
list [source $gorpfile] [file tail [info script]]
diff --git a/tests/interp.test b/tests/interp.test
index 43eb266..f82151e 100644
--- a/tests/interp.test
+++ b/tests/interp.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: interp.test,v 1.14 2002/03/07 20:17:23 dgp Exp $
+# RCS: @(#) $Id: interp.test,v 1.15 2002/07/01 07:52:03 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -481,74 +481,74 @@ test interp-15.1 {testing file sharing} {
z eval close stdout
list [catch {z eval puts hello} msg] $msg
} {1 {can not find channel named "stdout"}}
-catch {removeFile file-15.2}
-test interp-15.2 {testing file sharing} {
+test interp-15.2 {testing file sharing} -body {
catch {interp delete z}
interp create z
- set f [open file-15.2 w]
+ set f [open [makeFile {} file-15.2] w]
interp share "" $f z
z eval puts $f hello
z eval close $f
close $f
-} ""
-catch {removeFile file-15.2}
+} -cleanup {
+ removeFile file-15.2
+} -result ""
test interp-15.3 {testing file sharing} {
catch {interp delete xsafe}
interp create xsafe -safe
list [catch {xsafe eval puts hello} msg] $msg
} {1 {can not find channel named "stdout"}}
-catch {removeFile file-15.4}
-test interp-15.4 {testing file sharing} {
+test interp-15.4 {testing file sharing} -body {
catch {interp delete xsafe}
interp create xsafe -safe
- set f [open file-15.4 w]
+ set f [open [makeFile {} file-15.4] w]
interp share "" $f xsafe
xsafe eval puts $f hello
xsafe eval close $f
close $f
-} ""
-catch {removeFile file-15.4}
+} -cleanup {
+ removeFile file-15.4
+} -result ""
test interp-15.5 {testing file sharing} {
catch {interp delete xsafe}
interp create xsafe -safe
interp share "" stdout xsafe
list [catch {xsafe eval gets stdout} msg] $msg
} {1 {channel "stdout" wasn't opened for reading}}
-catch {removeFile file-15.6}
-test interp-15.6 {testing file sharing} {
+test interp-15.6 {testing file sharing} -body {
catch {interp delete xsafe}
interp create xsafe -safe
- set f [open file-15.6 w]
+ set f [open [makeFile {} file-15.6] w]
interp share "" $f xsafe
set x [list [catch [list xsafe eval gets $f] msg] $msg]
xsafe eval close $f
close $f
string compare [string tolower $x] \
[list 1 [format "channel \"%s\" wasn't opened for reading" $f]]
-} 0
-catch {removeFile file-15.6}
-catch {removeFile file-15.7}
-test interp-15.7 {testing file transferring} {
+} -cleanup {
+ removeFile file-15.6
+} -result 0
+test interp-15.7 {testing file transferring} -body {
catch {interp delete xsafe}
interp create xsafe -safe
- set f [open file-15.7 w]
+ set f [open [makeFile {} file-15.7] w]
interp transfer "" $f xsafe
xsafe eval puts $f hello
xsafe eval close $f
-} ""
-catch {removeFile file-15.7}
-catch {removeFile file-15.8}
-test interp-15.8 {testing file transferring} {
+} -cleanup {
+ removeFile file-15.7
+} -result ""
+test interp-15.8 {testing file transferring} -body {
catch {interp delete xsafe}
interp create xsafe -safe
- set f [open file-15.8 w]
+ set f [open [makeFile {} file-15.8] w]
interp transfer "" $f xsafe
xsafe eval close $f
set x [list [catch {close $f} msg] $msg]
string compare [string tolower $x] \
[list 1 [format "can not find channel named \"%s\"" $f]]
-} 0
-catch {removeFile file-15.8}
+} -cleanup {
+ removeFile file-15.8
+} -result 0
#
# Torture tests for interpreter deletion order
@@ -2868,6 +2868,7 @@ test interp-31.1 {alias invocation scope} {
test interp-32.1 { parent's working directory should
be inherited by a child interp } {
+ cd [temporaryDirectory]
set parent [pwd]
set i [interp create]
set child [$i eval pwd]
@@ -2880,6 +2881,7 @@ test interp-32.1 { parent's working directory should
cd ..
file delete cwd_test
interp delete $i
+ cd [workingDirectory]
expr {[string equal $parent $child] ? 1 :
"\{$parent\} != \{$child\}"}
} 1