summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/parseOld.test6
-rwxr-xr-xtests/tcltest.test53
2 files changed, 30 insertions, 29 deletions
diff --git a/tests/parseOld.test b/tests/parseOld.test
index 2c597bc..80e6338 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -13,7 +13,7 @@
# 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.10 2001/08/02 01:20:05 hobbs Exp $
+# RCS: @(#) $Id: parseOld.test,v 1.11 2002/06/25 01:13:38 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -23,6 +23,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
tcltest::testConstraint testwordend \
[string equal "testwordend" [info commands testwordend]]
+# Save the argv value for restoration later
+set savedArgv $argv
+
proc fourArgs {a b c d} {
global arg1 arg2 arg3 arg4
set arg1 $a
@@ -536,6 +539,7 @@ test parseOld-15.5 {TclScriptEnd procedure} {
} {0}
# cleanup
+set argv $savedArgv
::tcltest::cleanupTests
return
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 7bfdb66..0e4b36c 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -6,7 +6,7 @@
# Copyright (c) 2000 by Ajuba Solutions
# All rights reserved.
#
-# RCS: @(#) $Id: tcltest.test,v 1.26 2002/06/07 19:48:41 dgp Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.27 2002/06/25 01:13:38 dgp Exp $
# Note that there are several places where the value of
# tcltest::currentFailure is stored/reset in the -setup/-cleanup
@@ -64,7 +64,7 @@ test tcltest-1.2 {tcltest -help -something} {unixOrPc} {
test tcltest-1.3 {tcltest -h} {unixOrPc} {
set result [catch {exec [interpreter] test.tcl -h} msg]
list $result [regexp Usage $msg]
-} {0 0}
+} {1 0}
# -verbose, implicit & explicit testing of [verbose]
test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} {
@@ -141,7 +141,7 @@ test tcltest-2.7 {tcltest::verbose} {
verbose $oldVerbosity
list $currentVerbosity $newVerbosity
}
- -result {{body a r} {f o o}}
+ -result {body {}}
}
test tcltest-2.8 {tcltest -verbose 'error'} {
@@ -497,12 +497,10 @@ test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
-constraints unixOrPc
-body {
catch {exec [interpreter] a.tcl -tmpdir thisdirectoryisafile} msg
- # The join is necessary because the message can be split on multiple
- # lines
- join $msg
+ set msg
}
- -result {not a directory}
- -match regexp
+ -result {*not a directory*}
+ -match glob
}
# Test non-writeable directories, non-readable directories with directory flags
@@ -524,14 +522,12 @@ switch $tcl_platform(platform) {
test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unixOnly} {
catch {exec [interpreter] a.tcl -tmpdir $notReadableDir} msg
- # The join is necessary because the message can be split on multiple lines
- list [regexp {not readable} [join $msg]]
+ string match {*not readable*} $msg
} {1}
test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc} {
catch {exec [interpreter] a.tcl -tmpdir $notWriteableDir} msg
- # The join is necessary because the message can be split on multiple lines
- list [regexp {not writeable} [join $msg]]
+ string match {*not writeable*} $msg
} {1}
test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {unixOrPc} {
@@ -576,19 +572,17 @@ test tcltest-8.6a {temporaryDirectory - test format 2} -setup {
test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {unixOrPc} {
file delete -force thisdirectorydoesnotexist
catch {exec [interpreter] a.tcl -testdir thisdirectorydoesnotexist} msg
- list [regexp "does not exist" [join $msg]]
+ string match "*does not exist*" $msg
} {1}
test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {unixOrPc} {
catch {exec [interpreter] a.tcl -testdir thisdirectoryisafile} msg
- # The join is necessary because the message can be split on multiple lines
- list [regexp "not a directory" [join $msg]]
+ string match "*not a directory*" $msg
} {1}
test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {unixOnly} {
catch {exec [interpreter] a.tcl -testdir $notReadableDir} msg
- # The join is necessary because the message can be split on multiple lines
- list [regexp {not readable} [join $msg]]
+ string match {*not readable*} $msg
} {1}
@@ -733,16 +727,19 @@ test tcltest-10.4 {-preservecore 3} {unixOrPc} {
[regexp "core-" $msg] [file delete core-makecore]
} {1 1 1 {}}
-test tcltest-10.5 {preserveCore} {
- -body {
- set old [preserveCore]
- set result [preserveCore foo]
- set result2 [preserveCore]
- preserveCore $old
- list $result $result2
- }
- -result {foo foo}
-}
+# Removing this test. It makes no sense to test the ability of
+# [preserveCore] to accept an invalid value that will cause errors
+# in other parts of tcltests' operation.
+#test tcltest-10.5 {preserveCore} {
+# -body {
+# set old [preserveCore]
+# set result [preserveCore foo]
+# set result2 [preserveCore]
+# preserveCore $old
+# list $result $result2
+# }
+# -result {foo foo}
+#}
# -load, -loadfile, [loadScript], [loadFile]
set loadfile [makeFile {
@@ -1005,7 +1002,7 @@ test tcltest-15.7 {skipDirectories} {
# TCLTEST_OPTIONS
test tcltest-19.1 {TCLTEST_OPTIONS default} {
- -constraints {unixOrPc}
+ -constraints {unixOrPc singleTestInterp}
-setup {
if {[info exists ::env(TCLTEST_OPTIONS)]} {
set oldoptions $::env(TCLTEST_OPTIONS)