summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2006-03-21 11:12:27 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2006-03-21 11:12:27 (GMT)
commit86ca5531ac0818f99726ba9ad478e277cd5d6e94 (patch)
treecb78904bbef94025a4f19257afc9211ee618e8ce /tests
parentd4070e928ea23c067c492b5e594d206a76d9b3d5 (diff)
downloadtcl-86ca5531ac0818f99726ba9ad478e277cd5d6e94.zip
tcl-86ca5531ac0818f99726ba9ad478e277cd5d6e94.tar.gz
tcl-86ca5531ac0818f99726ba9ad478e277cd5d6e94.tar.bz2
Use test constraints properly instead of looking in tcl_platform
Consistent method of calling test constraints, and (try to) move constraint setup to the top of the test file
Diffstat (limited to 'tests')
-rw-r--r--tests/async.test5
-rw-r--r--tests/binary.test6
-rw-r--r--tests/clock.test27
-rw-r--r--tests/cmdAH.test53
-rw-r--r--tests/cmdInfo.test12
-rw-r--r--tests/compExpr-old.test13
-rw-r--r--tests/compExpr.test4
-rw-r--r--tests/env.test4
-rw-r--r--tests/execute.test19
-rw-r--r--tests/expr-old.test16
-rw-r--r--tests/fCmd.test170
-rw-r--r--tests/fileName.test30
-rw-r--r--tests/fileSystem.test16
-rw-r--r--tests/format.test29
-rw-r--r--tests/io.test17
-rw-r--r--tests/ioUtil.test30
-rw-r--r--tests/iogt.test15
-rw-r--r--tests/link.test5
-rw-r--r--tests/load.test10
-rw-r--r--tests/macOSXFCmd.test5
-rw-r--r--tests/main.test18
-rw-r--r--tests/parse.test23
-rw-r--r--tests/parseExpr.test4
-rw-r--r--tests/parseOld.test5
-rw-r--r--tests/pkgMkIndex.test12
-rw-r--r--tests/registry.test21
-rw-r--r--tests/safe.test29
-rw-r--r--tests/scan.test4
-rw-r--r--tests/source.test26
-rw-r--r--tests/stack.test11
-rw-r--r--tests/unixFCmd.test49
-rw-r--r--tests/unixInit.test44
-rw-r--r--tests/unload.test10
-rw-r--r--tests/util.test21
34 files changed, 322 insertions, 441 deletions
diff --git a/tests/async.test b/tests/async.test
index 969208c..014740a 100644
--- a/tests/async.test
+++ b/tests/async.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: async.test,v 1.8 2004/05/19 20:15:31 dkf Exp $
+# RCS: @(#) $Id: async.test,v 1.9 2006/03/21 11:12:27 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -19,8 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
testConstraint testasync [llength [info commands testasync]]
-
-tcltest::testConstraint threaded [expr {
+testConstraint threaded [expr {
[info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded)
}]
diff --git a/tests/binary.test b/tests/binary.test
index 557e03d..70dc044 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -10,14 +10,14 @@
# 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.26 2005/12/02 17:34:03 dgp Exp $
+# RCS: @(#) $Id: binary.test,v 1.27 2006/03/21 11:12:28 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-::tcltest::testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
-::tcltest::testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
+testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
+testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
test binary-0.1 {DupByteArrayInternalRep} {
set hdr [binary format cc 0 0316]
diff --git a/tests/clock.test b/tests/clock.test
index 6674fe4..d6c44ab 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -11,30 +11,25 @@
# 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.60 2005/11/28 15:37:19 kennykb Exp $
+# RCS: @(#) $Id: clock.test,v 1.61 2006/03/21 11:12:28 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-if { $::tcl_platform(platform) eq {windows} } {
- if { [catch { package require registry 1.1 }] } {
-
+if {[testConstraint win]} {
+ if {[catch {package require registry 1.1}]} {
# HIDEOUS KLUDGE: [package require registry 1.1] has failed.
# This failure likely means that we're running in Tcl's build
# directory instead of the install directory. We recover by
# trying to load tclreg*.dll directly.
-
- if { [catch {
- load [lindex \
- [glob -directory \
- [file join \
- [pwd] \
- [file dirname [info nameofexecutable]]] \
- tclReg*.dll] \
- 0] registry
- }] } {
+
+ if {[catch {
+ load [lindex [glob -directory \
+ [file join [pwd] [file dirname [info nameofexecutable]]] \
+ tclReg*.dll] 0] registry
+ }]} then {
# Still no registry!
namespace eval ::tcl::clock [set NoRegistry {}]
}
@@ -42,9 +37,9 @@ if { $::tcl_platform(platform) eq {windows} } {
}
package require msgcat 1.4
-::tcltest::testConstraint detroit \
+testConstraint detroit \
[expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}]
-::tcltest::testConstraint y2038 \
+testConstraint y2038 \
[expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}]
# TEST PLAN
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 9185aff..300e217 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,22 +10,21 @@
# 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.52 2006/03/20 11:39:03 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.53 2006/03/21 11:12:28 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
-tcltest::testConstraint testchmod [llength [info commands testchmod]]
-tcltest::testConstraint testsetplatform \
- [llength [info commands testsetplatform]]
-tcltest::testConstraint testvolumetype \
- [llength [info commands testvolumetype]]
-tcltest::testConstraint linkDirectory [expr \
- {$tcl_platform(platform) ne "windows" || \
- ([string index $tcl_platform(osVersion) 0] >= 5 \
- && ([lindex [file system [temporaryDirectory]] 1] == "NTFS"))}]
+testConstraint testchmod [llength [info commands testchmod]]
+testConstraint testsetplatform [llength [info commands testsetplatform]]
+testConstraint testvolumetype [llength [info commands testvolumetype]]
+testConstraint linkDirectory [expr {
+ ![testConstraint win] ||
+ ([string index $tcl_platform(osVersion) 0] >= 5
+ && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
+}]
global env
set cmdAHwd [pwd]
@@ -957,7 +956,7 @@ catch {file attributes $gorpfile -permissions 0765}
# atime
# avoid problems with non-local filesystems
-if {$::tcl_platform(platform) == "unix" && [file exists /tmp]} {
+if {[testConstraint unix] && [file exists /tmp]} {
set file [makeFile "data" touch.me /tmp]
} else {
set file [makeFile "data" touch.me]
@@ -989,7 +988,7 @@ test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unix} {
test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} {win testvolumetype} {
set old [pwd]
cd $::tcltest::temporaryDirectory
- if {![string equal "NTFS" [testvolumetype]]} {
+ if {"NTFS" ne [testvolumetype]} {
# Windows FAT doesn't understand atime, but NTFS does
# May also fail for Windows on NFS mounted disks
cd $old
@@ -1003,7 +1002,7 @@ test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} {win testvolumetype} {
expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
} 1
-if {$::tcl_platform(platform) == "unix" && [file exists /tmp]} {
+if {[testConstraint unix] && [file exists /tmp]} {
removeFile touch.me /tmp
} else {
removeFile touch.me
@@ -1103,17 +1102,19 @@ proc waitForEvenSecondForFAT {} {
# timings. :^(
# This procedure based on work by Helmut Giese
- global tcl_platform
- if {$tcl_platform(platform) ne "windows"} {return}
- if {[lindex [file system [temporaryDirectory]] 1] == "NTFS"} {return}
- # Assume non-NTFS means FAT{12,16,32} and hence in need of special help
- set start [clock seconds]
- while {1} {
- set now [clock seconds]
- if {$now!=$start && !($now & 1)} {
- return
+ if {
+ [testConstraint win]
+ && [lindex [file system [temporaryDirectory]] 1] ne "NTFS"
+ } then {
+ # Assume non-NTFS means FAT{12,16,32} and hence in need of special help
+ set start [clock seconds]
+ while {1} {
+ set now [clock seconds]
+ if {$now!=$start && !($now & 1)} {
+ break
+ }
+ after 50
}
- after 50
}
}
set file [makeFile "data" touch.me]
@@ -1161,7 +1162,7 @@ test cmdAH-24.5 {Tcl_FileObjCmd: mtime} {
# Under Unix, use a file in /tmp to avoid clock skew due to NFS.
# On other platforms, just use a file in the local directory.
- if {[string equal $tcl_platform(platform) "unix"]} {
+ if {[testConstraint unix]} {
set name /tmp/tcl.test.[pid]
} else {
set name [file join [temporaryDirectory] tf]
@@ -1543,3 +1544,7 @@ cd $cmdAHwd
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test
index b4022af..799c6e3 100644
--- a/tests/cmdInfo.test
+++ b/tests/cmdInfo.test
@@ -13,17 +13,15 @@
# 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.8 2003/11/14 20:44:46 dgp Exp $
+# RCS: @(#) $Id: cmdInfo.test,v 1.9 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-::tcltest::testConstraint testcmdinfo \
- [llength [info commands testcmdinfo]]
-::tcltest::testConstraint testcmdtoken \
- [llength [info commands testcmdtoken]]
+testConstraint testcmdinfo [llength [info commands testcmdinfo]]
+testConstraint testcmdtoken [llength [info commands testcmdtoken]]
test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
testcmdinfo create x1
@@ -104,3 +102,7 @@ catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
catch {rename x1 ""}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index b1e36bd..cd406a1 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -12,14 +12,14 @@
# 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.16 2005/11/08 22:09:56 dgp Exp $
+# RCS: @(#) $Id: compExpr-old.test,v 1.17 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+if {[catch {expr T1()} msg] && $msg eq {unknown math function "T1"}} {
testConstraint testmathfunctions 0
} else {
testConstraint testmathfunctions 1
@@ -81,7 +81,10 @@ proc testIEEE {} {
}
}
}
-::tcltest::testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint ieeeFloatingPoint [testIEEE]
+
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
# procedures used below
@@ -358,13 +361,9 @@ test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
# The following test is different for 32-bit versus 64-bit
# architectures because LONG_MIN is different
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-
test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
expr {int(1<<63)}
} -9223372036854775808
-
test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
expr {int(1<<31)}
} -2147483648
diff --git a/tests/compExpr.test b/tests/compExpr.test
index 42e5cd5..b9e8ba9 100644
--- a/tests/compExpr.test
+++ b/tests/compExpr.test
@@ -8,14 +8,14 @@
# 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.9 2005/05/10 18:35:17 kennykb Exp $
+# RCS: @(#) $Id: compExpr.test,v 1.10 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+if {[catch {expr T1()} msg] && $msg eq {unknown math function "T1"}} {
testConstraint testmathfunctions 0
} else {
testConstraint testmathfunctions 1
diff --git a/tests/env.test b/tests/env.test
index a1e50d9..4005afb 100644
--- a/tests/env.test
+++ b/tests/env.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: env.test,v 1.23 2005/11/03 00:17:31 patthoyts Exp $
+# RCS: @(#) $Id: env.test,v 1.24 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -70,7 +70,7 @@ set printenvScript [makeFile {
}
set names [lsort [array names env]]
- if {$tcl_platform(platform) == "windows"} {
+ if {[testConstraint win]} {
lrem names HOME
lrem names COMSPEC
lrem names ComSpec
diff --git a/tests/execute.test b/tests/execute.test
index bab3ced..1b3d75f 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -14,7 +14,7 @@
# 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.21 2005/11/09 20:24:10 dgp Exp $
+# RCS: @(#) $Id: execute.test,v 1.22 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -27,14 +27,13 @@ catch {unset x}
catch {unset y}
catch {unset msg}
-::tcltest::testConstraint testobj \
- [expr {[info commands testobj] != {} \
- && [info commands testdoubleobj] != {} \
- && [info commands teststringobj] != {} \
- && [info commands testobj] != {}}]
+testConstraint testobj [expr {
+ [llength [info commands testobj]]
+ && [llength [info commands testdoubleobj]]
+ && [llength [info commands teststringobj]]
+}]
-::tcltest::testConstraint longIs32bit \
- [expr {int(0x80000000) < 0}]
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
# Tests for the omnibus TclExecuteByteCode function:
@@ -775,3 +774,7 @@ catch {unset y}
catch {unset msg}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/expr-old.test b/tests/expr-old.test
index e6edcde..0e42a76 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -13,14 +13,19 @@
# 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.31 2005/11/09 20:24:10 dgp Exp $
+# RCS: @(#) $Id: expr-old.test,v 1.32 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+testConstraint testexprlong [llength [info commands testexprlong]]
+testConstraint testexprdouble [llength [info commands testexprdouble]]
+testConstraint testexprstring [llength [info commands testexprstring]]
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+
+if {[catch {expr T1()} msg] && $msg eq {unknown math function "T1"}} {
testConstraint testmathfunctions 0
} else {
testConstraint testmathfunctions 1
@@ -82,7 +87,7 @@ proc testIEEE {} {
}
}
}
-::tcltest::testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint ieeeFloatingPoint [testIEEE]
# First, test all of the integer operators individually.
@@ -1017,11 +1022,6 @@ test expr-old-36.16 {ExprLooksLikeInt procedure} {
expr {$x+1}
} [expr 0x100000000000000000000000000000000000000]
-testConstraint testexprlong [llength [info commands testexprlong]]
-testConstraint testexprdouble [llength [info commands testexprdouble]]
-testConstraint testexprstring [llength [info commands testexprstring]]
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-
test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
testexprlong 4+1
} {This is a result: 5}
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 6d2abc0..00e442a 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.52 2006/03/20 11:39:03 dkf Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.53 2006/03/21 11:12:29 dkf Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -25,9 +25,26 @@ testConstraint notNetworkFilesystem 0
testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
testConstraint 2000orNewer [expr {![testConstraint 95or98]}]
+# Find a group that exists on this Unix system, or else skip tests that
+# require Unix groups.
+testConstraint foundGroup [expr {![textConstraint unix]}]
+if {[testConstraint unix]} {
+ catch {
+ set groupList [exec groups]
+ set group [lindex $groupList 0]
+ testConstraint foundGroup 1
+ }
+}
+
+testConstraint fileSharing 0
+testConstraint notFileSharing 1
+testConstraint xdev 0
+testConstraint linkFile 1
+testConstraint linkDirectory 1
+
# Several tests require need to match results against the unix username
set user {}
-if {$tcl_platform(platform) == "unix"} {
+if {[testConstraint unix]} {
catch {set user [exec whoami]}
if {$user == ""} {
catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
@@ -44,7 +61,7 @@ proc createfile {file {string a}} {
return $string
}
-#
+#
# checkcontent --
#
# Ensures that file "file" contains only the string "matchString"
@@ -54,7 +71,7 @@ proc checkcontent {file matchString} {
if {[catch {
set f [open $file]
set fileString [read $f]
- close $f
+ close $f
}]} {
return 0
}
@@ -99,12 +116,8 @@ proc contents {file} {
}
cd [temporaryDirectory]
-testConstraint fileSharing 0
-testConstraint notFileSharing 1
-testConstraint xdev 0
-
-if {$tcl_platform(platform) == "unix"} {
+if {[testConstraint unix]} {
if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
@@ -221,10 +234,10 @@ test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {notRoot unixOrPc} {
} {1 {error renaming "/" to "td1": file already exists}}
test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} {
cleanup
- createfile tf1
- createfile tf2
- createfile tf3
- createfile tf4
+ createfile tf1
+ createfile tf2
+ createfile tf3
+ createfile tf4
file mkdir td1
createfile [file join td1 tf3]
list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
@@ -359,7 +372,7 @@ test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot}
set x [file exists tf1]
file delete tf1
list $x [file exists tf1]
-} {0 0}
+} {0 0}
test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
cleanup
file mkdir td1
@@ -533,7 +546,7 @@ test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
file attributes td1 -permissions 0000
set msg [list [catch {file rename td1 /tmp} msg] $msg]
file attributes td1 -permissions 0755
- set msg
+ set msg
} {1 {error renaming "td1": permission denied}}
test fCmd-6.24 {CopyRenameOneFile: error uses original name} \
{unix notRoot} {
@@ -687,7 +700,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod}
file rename tf1 tf3
file rename tf2 tf4
list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
-} {{tf3 tf4} 1 0}
+} {{tf3 tf4} 1 0}
test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} {
cleanup
file mkdir td1 td2
@@ -695,7 +708,7 @@ test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot te
file rename td1 td3
file rename td2 td4
list [lsort [glob td*]] [file writable td3] [file writable td4]
-} {{td3 td4} 1 0}
+} {{td3 td4} 1 0}
test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
cleanup
createfile tf1 tf1
@@ -704,7 +717,7 @@ test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
file rename -force tf1 tf1
file rename -force tf2 tf2
list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
-} {tf1 tf2 1 0}
+} {tf1 tf2 1 0}
test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} {
cleanup
file mkdir td1
@@ -713,7 +726,7 @@ test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testch
file rename -force td1 .
file rename -force td2 .
list [lsort [glob td*]] [file writable td1] [file writable td2]
-} {{td1 td2} 1 0}
+} {{td1 td2} 1 0}
test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} {
cleanup
createfile tf1
@@ -735,7 +748,7 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testc
file rename -force tfs2 tfd2
file rename -force tfs3 tfd3
file rename -force tfs4 tfd4
- list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
+ list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
cleanup
@@ -753,7 +766,7 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
file mkdir [file join tdd2 tds2]
file mkdir [file join tdd3 tds3]
file mkdir [file join tdd4 tds4]
- if {$tcl_platform(platform) != "unix"} {
+ if {![testConstraint unix]} {
testchmod 555 tds3
testchmod 555 tds4
}
@@ -764,12 +777,12 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
file rename -force tds2 tdd2
file rename -force tds3 tdd3
file rename -force tds4 tdd4
- if {$tcl_platform(platform) != "unix"} {
- set w3 [file writable [file join tdd3 tds3]]
- set w4 [file writable [file join tdd4 tds4]]
- } else {
+ if {[testConstraint unix]} {
set w3 0
set w4 0
+ } else {
+ set w3 [file writable [file join tdd3 tds3]]
+ set w4 [file writable [file join tdd4 tds4]]
}
list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
[file writable [file join tdd2 tds2]] $w3 $w4
@@ -782,15 +795,15 @@ test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup {
file mkdir tds2
file mkdir [file join tdd1 tds1 xxx]
file mkdir [file join tdd2 tds2 xxx]
- if {$tcl_platform(platform) != "unix"} {
+ if {![testConstraint unix]} {
testchmod 555 tds2
}
set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
- if {$tcl_platform(platform) != "unix"} {
- set w2 [file writable tds2]
- } else {
+ if {[testConstraint unix]} {
set w2 0
+ } else {
+ set w2 [file writable tds2]
}
list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
} -match glob -result \
@@ -811,15 +824,15 @@ test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot te
file mkdir td1
file mkdir td2
file mkdir td3
- if {$tcl_platform(platform) != "unix"} {
+ if {![testConstraint unix]} {
testchmod 555 td2
}
file rename td1 [file join td3 td3]
file rename td2 [file join td3 td4]
- if {$tcl_platform(platform) != "unix"} {
- set w4 [file writable [file join td3 td4]]
- } else {
+ if {[testConstraint unix]} {
set w4 0
+ } else {
+ set w4 [file writable [file join td3 td4]]
}
list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
[file writable [file join td3 td3]] $w4
@@ -950,7 +963,7 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testch
file copy -force tfs2 tfd2
file copy -force tfs3 tfd3
file copy -force tfs4 tfd4
- list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
+ list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} {
cleanup
@@ -973,7 +986,7 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod}
set a3 [catch {file copy -force tds2 tdd2}]
set a4 [catch {file copy -force tds3 tdd3}]
set a5 [catch {file copy -force tds4 tdd4}]
- list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
+ list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
{notRoot unixOrPc testchmod} {
@@ -1047,9 +1060,9 @@ test fCmd-10.12 {file rename: rename to empty file name} {
createfile tf1
list [catch {file rename tf1 ""} msg] $msg
} {1 {error renaming "tf1" to "": no such file or directory}}
-cleanup
+cleanup
-# old tests
+# old tests
test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} {
catch {file delete -force -- -tfa1}
@@ -1080,9 +1093,9 @@ test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot}
} {1}
test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} {
catch {file delete -force -- tfa1 tfa2 tfa3}
- createfile tfa1
- createfile tfa2
- createfile tfa3
+ createfile tfa1
+ createfile tfa2
+ createfile tfa3
set result [catch {file rename tfa1 tfa2 tfa3}]
file delete tfa1 tfa2 tfa3
set result
@@ -1104,7 +1117,7 @@ test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} {
file rename tfa1 tfa2 tfad
set r1 [checkcontent tfad/tfa1 $s1]
set r2 [checkcontent tfad/tfa2 $s2]
-
+
set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]
file delete -force tfad
@@ -1188,7 +1201,7 @@ test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} {
file mkdir tfad
file mkdir tfad/dir
set result [catch {file rename tfad tfad/dir}]
- file delete -force tfad
+ file delete -force tfad
set result
} {1}
test fCmd-12.8 {renamefile: generic error} {unix notRoot} {
@@ -1260,9 +1273,9 @@ test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
} {1}
test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} {
catch {file delete -force -- tfa1 tfa2 tfa3}
- createfile tfa1
- createfile tfa2
- createfile tfa3
+ createfile tfa1
+ createfile tfa2
+ createfile tfa3
set result [catch {file copy tfa1 tfa2 tfa3}]
file delete tfa1 tfa2 tfa3
set result
@@ -1306,7 +1319,7 @@ test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {
#
# Coverage tests for copyfile()
-#
+#
test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {
global env
set temp $env(HOME)
@@ -1392,7 +1405,7 @@ test fCmd-14.8 {copyfile: copy directory failing} {unix notRoot} {
test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {
global env
set temp $env(HOME)
- unset env(HOME)
+ unset env(HOME)
set result [catch {file mkdir ~/tfa}]
set env(HOME) $temp
set result
@@ -1515,7 +1528,7 @@ test fCmd-16.9 {error while deleting file } {unix notRoot} {
file attributes tfa -permissions 0555
set result [catch {file delete tfa/a }]
#######
- ####### If any directory in a tree that is being removed does not
+ ####### If any directory in a tree that is being removed does not
####### have write permission, the process will fail!
####### This is also the case with "rm -rf"
#######
@@ -1710,7 +1723,7 @@ test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
file mkdir tfa1/a/b/c/d
file mkdir tfa2
- set f [file join [pwd] tfa1/a/b]
+ set f [file join [pwd] tfa1/a/b]
set f2 [file join [pwd] {tfa2/b alias}]
file link -symbolic $f2 $f
file rename {tfa2/b alias/c} tfa3
@@ -1738,7 +1751,7 @@ test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unix notRoot} {
file mkdir tfa1
file link -symbolic tfalink tfa1
- file delete tfa1
+ file delete tfa1
file rename tfalink tfa2
set result [expr [string compare [file type tfa2] "link"] == 0]
file delete tfa2
@@ -1773,7 +1786,7 @@ test fCmd-19.3 {recursive remove} {notRoot} {
} {0}
#
-# TclUnixDeleteFile and TraversalDelete are covered by tests from the
+# TclUnixDeleteFile and TraversalDelete are covered by tests from the
# TclDeleteFilesCmd suite
#
#
@@ -1806,7 +1819,7 @@ test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034
#
# Feature testing for TclCopyFilesCmd
-#
+#
test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {
catch {file delete -force -- tfa1 tfa2}
set s [createfile tfa1]
@@ -1835,9 +1848,9 @@ test fCmd-21.3 {copy : single file into directory } {notRoot} {
test fCmd-21.4 {copy : more than one source and target is not a directory} \
{notRoot} {
catch {file delete -force -- tfa1 tfa2 tfa3}
- createfile tfa1
- createfile tfa2
- createfile tfa3
+ createfile tfa1
+ createfile tfa2
+ createfile tfa3
set result [catch {file copy tfa1 tfa2 tfa3}]
file delete tfa1 tfa2 tfa3
set result
@@ -1874,7 +1887,7 @@ test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unix notRoot dontCopyL
file link -symbolic tfalink tfad1
file delete tfad1
set result [list [catch {file copy tfalink tfalink2} msg] $msg]
- file delete -force tfalink tfalink2
+ file delete -force tfalink tfalink2
set result
} {1 {error copying "tfalink": the target of this link doesn't exist}}
test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unix notRoot} {
@@ -1883,7 +1896,7 @@ test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unix notRoot} {
file delete tfad1
file copy tfalink tfalink2
set result [string match [file type tfalink2] link]
- file delete tfalink tfalink2
+ file delete tfalink tfalink2
set result
} {1}
test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unix notRoot dontCopyLinks} {
@@ -1959,10 +1972,10 @@ test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot}
} {1}
test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {unix notRoot} {
catch {file delete -force -- tfa1}
- set s [createfile tfa1]
+ set s [createfile tfa1]
file rename -force tfa1 tfa1
set result [checkcontent tfa1 $s]
- file delete tfa1
+ file delete tfa1
set result
} {1}
test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} {
@@ -2012,12 +2025,12 @@ test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} {
file mkdir [file join tfad dir]
set result [catch {file delete tfad}]
- file delete -force tfad
+ file delete -force tfad
set result
} {1}
#
-# TclMacDeleteFile
+# TclMacDeleteFile
# Error cases are not covered.
#
test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
@@ -2089,7 +2102,7 @@ test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unix notRoot} {
set r1 [file isdir tfad1]
set r2 [file exists tfad2]
-
+
set result [expr $r1 && !$r2]
file delete tfad1
set result
@@ -2104,7 +2117,7 @@ test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unix notRoot} {
set r1 [file exists tfad1]
set r2 [file exists tfad2]
-
+
set result [expr !$r1 && !$r2]
set result
} {1}
@@ -2125,18 +2138,6 @@ test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
set attrs [file attributes foo.tmp]
list [catch {file attributes foo.tmp {expand}[lindex $attrs 0]}] [file delete -force -- foo.tmp]
} {0 {}}
-# Find a group that exists on this Unix system, or else skip tests that
-# require Unix groups.
-if {$tcl_platform(platform) == "unix"} {
- ::tcltest::testConstraint foundGroup 0
- catch {
- set groupList [exec groups]
- set group [lindex $groupList 0]
- ::tcltest::testConstraint foundGroup 1
- }
-} else {
- ::tcltest::testConstraint foundGroup 1
-}
test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {
catch {file delete -force -- foo.tmp}
createfile foo.tmp
@@ -2150,18 +2151,13 @@ test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
list [catch {file attributes foo.tmp {expand}[lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
} {0 {} {}}
-if {[string equal $tcl_platform(platform) "windows"]} {
- if {[string index $tcl_platform(osVersion) 0] >= 5 \
- && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
- tcltest::testConstraint linkDirectory 1
- tcltest::testConstraint linkFile 1
- } else {
- tcltest::testConstraint linkDirectory 0
- tcltest::testConstraint linkFile 0
- }
-} else {
- tcltest::testConstraint linkFile 1
- tcltest::testConstraint linkDirectory 1
+if {
+ [testConstraint win] &&
+ ([string index $tcl_platform(osVersion) 0] < 5
+ || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
+} then {
+ testConstraint linkDirectory 0
+ testConstraint linkFile 0
}
test fCmd-28.1 {file link} {
diff --git a/tests/fileName.test b/tests/fileName.test
index 5e4286e..4cd079b 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -10,15 +10,24 @@
# 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.50 2006/03/19 23:04:24 vincentdarley Exp $
+# RCS: @(#) $Id: fileName.test,v 1.51 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
-testConstraint testtranslatefilename [string equal testtranslatefilename [info commands testtranslatefilename]]
+testConstraint testsetplatform [llength [info commands testsetplatform]]
+testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
+testConstraint linkDirectory 1
+testConstraint symbolicLinkFile 1
+if {[testConstraint win]} {
+ if {[string index $tcl_platform(osVersion) 0] < 5 \
+ || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
+ testConstraint linkDirectory 0
+ }
+ testConstraint symbolicLinkFile 0
+}
global env
if {[testConstraint testsetplatform]} {
@@ -778,21 +787,6 @@ test filename-11.17.1 {Tcl_GlobCmd} {win} {
[file join $globname x,z1.c]\
[file join $globname x1.c]\
[file join $globname y1.c] [file join $globname z1.c]]]]
-if {[string equal $tcl_platform(platform) "windows"]} {
- if {[string index $tcl_platform(osVersion) 0] >= 5 \
- && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
- testConstraint linkDirectory 1
- } else {
- testConstraint linkDirectory 0
- }
-} else {
- testConstraint linkDirectory 1
-}
-if {[string equal $tcl_platform(platform) "windows"]} {
- testConstraint symbolicLinkFile 0
-} else {
- testConstraint symbolicLinkFile 1
-}
test filename-11.17.2 {Tcl_GlobCmd} {notRoot linkDirectory} {
set dir [pwd]
set ret "error in test"
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 7487743..06ab643 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -11,15 +11,8 @@
package require tcltest 2
namespace eval ::tcl::test::fileSystem {
+ namespace import ::tcltest::*
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::makeDirectory
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeDirectory
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
-
catch {
file delete -force link.file
file delete -force dir.link
@@ -39,7 +32,7 @@ makeFile "test file in directory" [file join dir.dir inside.file]
testConstraint unusedDrive 0
set drive {}
-if {$::tcl_platform(platform) eq "windows"} {
+if {[testConstraint win]} {
set vols [string map [list :/ {}] [file volumes]]
for {set i 0} {$i < 26} {incr i} {
set drive [format %c [expr {$i + 65}]]
@@ -54,7 +47,7 @@ if {$::tcl_platform(platform) eq "windows"} {
testConstraint moreThanOneDrive 0
set drives [list]
-if {$::tcl_platform(platform) eq "windows"} {
+if {[testConstraint win]} {
set dir [pwd]
foreach vol [file volumes] {
if {![catch {cd $vol}]} {
@@ -281,7 +274,7 @@ test filesystem-1.32 {link normalisation: link near filesystem root} {testsetpla
test filesystem-1.33 {link normalisation: link near filesystem root} {testsetplatform} {
testsetplatform windows
set res [file normalize C:/../bar]
- if {$::tcl_platform(platform) == "unix"} {
+ if {[testConstraint unix]} {
# Some unices go further in normalizing this -- not really
# a problem since this is a Windows test
regexp {C:/bar$} $res res
@@ -902,7 +895,6 @@ test filesystem-8.3 {path objects and empty string} {
set anchor ""
set dst foo
set res $dst
-
set yyy [file split $anchor]
set dst [file join $anchor $dst]
lappend res $dst $yyy
diff --git a/tests/format.test b/tests/format.test
index f99861d..321f52f 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -10,24 +10,26 @@
# 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.23 2005/10/13 21:49:46 dkf Exp $
+# RCS: @(#) $Id: format.test,v 1.24 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+# %u output depends on word length, so this test is not portable.
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
+testConstraint wideIs64bit \
+ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
+testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
+
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
} { 34 16923 -12 -1}
test format-1.2 {integer formatting} {
format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
} { 6 34 16923 -12 -1 0xe 0XC}
-
-# %u output depends on word length, so this test is not portable.
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-
test format-1.3 {integer formatting} longIs32bit {
format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0
} { 6 34 16923 4294967284 -1 0}
@@ -43,10 +45,8 @@ test format-1.5 {integer formatting} {
test format-1.6 {integer formatting} {
format "%00*d" 6 34
} {000034}
-
# Printing negative numbers in hex or octal format depends on word
# length, so these tests are not portable.
-
test format-1.7 {integer formatting} longIs32bit {
format "%4x %4x %4x %4x" 6 34 16923 -12 -1
} { 6 22 421b fffffff4}
@@ -426,6 +426,7 @@ test format-11.12 {XPG3 %$n specifiers} {
test format-12.1 {negative width specifiers} {
format "%*d" -47 25
} {25 }
+
test format-13.1 {tcl_precision fuzzy comparison} {
catch {unset a}
catch {unset b}
@@ -475,6 +476,7 @@ test format-13.5 {tcl_precision fuzzy comparison} {
set c [expr $a + $b]
format {%0.10f %0.12f %0.15f} $c $c $c
} {1.4444444444 1.444444444444 1.444444444443990}
+
test format-14.1 {testing MAX_FLOAT_SIZE for 0 and 1} {
format {%s} ""
} {}
@@ -502,16 +504,11 @@ for {set i 0} {$i < 290} {incr i} {
}
for {set i 290} {$i < 400} {incr i} {
test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
- format {%s} $b
+ format {%s} $b
} $b
append b "x"
}
-::tcltest::testConstraint wideIs64bit \
- [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
-::tcltest::testConstraint wideBiggerThanInt \
- [expr {wide(0x80000000) != int(0x80000000)}]
-
test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} {
format %d 7810179016327718216
} 1819043144
@@ -563,3 +560,7 @@ catch {unset c}
catch {unset d}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/io.test b/tests/io.test
index f1299af..a25f3c3 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -13,21 +13,14 @@
# 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.70 2006/03/16 19:12:17 andreas_kupries Exp $
+# RCS: @(#) $Id: io.test,v 1.71 2006/03/21 11:12:29 dkf Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
return
}
namespace eval ::tcl::test::io {
-
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::interpreter
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
- namespace import ::tcltest::viewFile
+ namespace import ::tcltest::*
testConstraint testchannel [llength [info commands testchannel]]
testConstraint exec [llength [info commands exec]]
@@ -37,6 +30,7 @@ testConstraint fcopy [llength [info commands fcopy]]
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
+testConstraint testthread [llength [info commands testthread]]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
@@ -47,6 +41,8 @@ testConstraint largefileSupport 0
set umaskValue 0
testConstraint umask [expr {![catch {set umaskValue [exec /bin/sh -c umask]}]}]
+testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}]
+
# set up a long data file for some of the following tests
set path(longfile) [makeFile {} longfile]
@@ -5279,7 +5275,6 @@ test io-40.15 {POSIX open access modes: RDWR} {
close $f
lappend x [viewFile test3]
} {zzy abzzy}
-testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}]
test io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup {
makeFile {Some text} _test_ ~
} -body {
@@ -7160,8 +7155,6 @@ test io-70.0 {Cutting & Splicing channels} {testchannel} {
# nop after the first call, and placement of its defintion in a
# central location.
-testConstraint testthread [expr {[info commands testthread] != {}}]
-
if {[testConstraint testthread]} {
testthread errorproc ThreadError
diff --git a/tests/ioUtil.test b/tests/ioUtil.test
index 1671572..bb084b0 100644
--- a/tests/ioUtil.test
+++ b/tests/ioUtil.test
@@ -1,26 +1,24 @@
# This file (ioUtil.test) tests the hookable TclStat(), TclAccess(),
# and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c.
# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
-#
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# 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.15 2003/11/14 20:44:46 dgp Exp $
-
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# 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.16 2006/03/21 11:12:29 dkf Exp $
+
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-::tcltest::testConstraint testopenfilechannelproc \
+testConstraint testopenfilechannelproc \
[llength [info commands testopenfilechannelproc]]
-::tcltest::testConstraint testaccessproc \
- [llength [info commands testaccessproc]]
-::tcltest::testConstraint teststatproc \
- [llength [info commands teststatproc]]
+testConstraint testaccessproc [llength [info commands testaccessproc]]
+testConstraint teststatproc [llength [info commands teststatproc]]
set unsetScript {
catch {unset testStat1(size)}
@@ -308,3 +306,7 @@ cd $oldpwd
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/iogt.test b/tests/iogt.test
index 9e09270..ac52f5b 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -10,21 +10,16 @@
# Copyright (c) 2000 Andreas Kupries.
# All rights reserved.
#
-# RCS: @(#) $Id: iogt.test,v 1.13 2005/05/10 18:35:22 kennykb Exp $
+# RCS: @(#) $Id: iogt.test,v 1.14 2006/03/21 11:12:29 dkf Exp $
if {[catch {package require tcltest 2.1}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
return
}
namespace eval ::tcl::test::iogt {
+ namespace import ::tcltest::*
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
-
- testConstraint testchannel [llength [info commands testchannel]]
+testConstraint testchannel [llength [info commands testchannel]]
set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
} dummy]
@@ -882,10 +877,6 @@ delete/read {} *ignored*
flush/write {} {}
delete/write {} *ignored*}
-
-
-
-
proc constX {op data} {
# replace anything coming in with a same-length string of x'es.
switch -- $op {
diff --git a/tests/link.test b/tests/link.test
index 84fa154..08251b1 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -11,15 +11,14 @@
# 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.14 2005/09/08 14:14:21 dkf Exp $
+# RCS: @(#) $Id: link.test,v 1.15 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-::tcltest::testConstraint testlink \
- [expr {[info commands testlink] != {}}]
+testConstraint testlink [llength [info commands testlink]]
foreach i {int real bool string} {
catch {unset $i}
diff --git a/tests/load.test b/tests/load.test
index d1bdc04..6ef2f53 100644
--- a/tests/load.test
+++ b/tests/load.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: load.test,v 1.14 2005/07/28 18:42:32 dgp Exp $
+# RCS: @(#) $Id: load.test,v 1.15 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -25,20 +25,18 @@ set ext [info sharedlibextension]
set testDir [file join [file dirname [info nameofexecutable]] dltest]
set x [file join $testDir pkga$ext]
set dll "[file tail $x]Required"
-::tcltest::testConstraint $dll [file readable $x]
+testConstraint $dll [file readable $x]
# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]
-::tcltest::testConstraint $loaded \
- [expr {![string match *pkga* $alreadyLoaded]}]
+testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}]
set alreadyTotalLoaded [info loaded]
# Certain tests require the 'teststaticpkg' command from tcltest
-::tcltest::testConstraint teststaticpkg \
- [string compare {} [info commands teststaticpkg]]
+testConstraint teststaticpkg [llength [info commands teststaticpkg]]
test load-1.1 {basic errors} {} {
diff --git a/tests/macOSXFCmd.test b/tests/macOSXFCmd.test
index b5f77c5..15b3909 100644
--- a/tests/macOSXFCmd.test
+++ b/tests/macOSXFCmd.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: macOSXFCmd.test,v 1.3 2006/03/21 11:06:23 das Exp $
+# RCS: @(#) $Id: macOSXFCmd.test,v 1.4 2006/03/21 11:12:29 dkf Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -24,8 +24,7 @@ cd [temporaryDirectory]
# check whether macosx file attributes are supported
testConstraint macosxFileAttr 0
-if {$tcl_platform(platform) eq "unix" && \
- $tcl_platform(os) eq "Darwin"} {
+if {[testConstraint unix] && $tcl_platform(os) eq "Darwin"} {
catch {file delete -force -- foo.test}
close [open foo.test w]
catch {
diff --git a/tests/main.test b/tests/main.test
index 3a14789..5eab892 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -1,6 +1,6 @@
# This file contains a collection of tests for generic/tclMain.c.
#
-# RCS: @(#) $Id: main.test,v 1.17 2006/02/09 15:22:52 dgp Exp $
+# RCS: @(#) $Id: main.test,v 1.18 2006/03/21 11:12:29 dkf Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -8,15 +8,7 @@ if {[catch {package require tcltest 2.0.2}]} {
}
namespace eval ::tcl::test::main {
-
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
- namespace import ::tcltest::interpreter
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::temporaryDirectory
- namespace import ::tcltest::workingDirectory
+ namespace import ::tcltest::*
# Is [exec] defined?
testConstraint exec [llength [info commands exec]]
@@ -615,8 +607,7 @@ namespace eval ::tcl::test::main {
after cancel $id
set wait
} -cleanup {
- if {[string equal timeout $wait]
- && [string equal unix $::tcl_platform(platform)]} {
+ if {[string equal timeout $wait] && [testConstraint unix]} {
exec kill [pid $f]
}
close $f
@@ -639,8 +630,7 @@ namespace eval ::tcl::test::main {
after cancel $id
set wait
} -cleanup {
- if {[string equal timeout $wait]
- && [string equal unix $::tcl_platform(platform)]} {
+ if {[string equal timeout $wait] && [testConstraint unix]} {
exec kill [pid $f]
}
close $f
diff --git a/tests/parse.test b/tests/parse.test
index 9657951..8989033 100644
--- a/tests/parse.test
+++ b/tests/parse.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: parse.test,v 1.23 2006/03/06 21:56:34 dgp Exp $
+# RCS: @(#) $Id: parse.test,v 1.24 2006/03/21 11:12:29 dkf Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -16,18 +16,15 @@ if {[catch {package require tcltest 2.0.2}]} {
}
namespace eval ::tcl::test::parse {
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::bytestring
+ namespace import ::tcltest::*
- testConstraint testparser [llength [info commands testparser]]
- testConstraint testevalobjv [llength [info commands testevalobjv]]
- testConstraint testevalex [llength [info commands testevalex]]
- testConstraint testparsevarname [llength [info commands testparsevarname]]
- testConstraint testparsevar [llength [info commands testparsevar]]
- testConstraint testasync [llength [info commands testasync]]
- testConstraint testcmdtrace [llength [info commands testcmdtrace]]
+testConstraint testparser [llength [info commands testparser]]
+testConstraint testevalobjv [llength [info commands testevalobjv]]
+testConstraint testevalex [llength [info commands testevalex]]
+testConstraint testparsevarname [llength [info commands testparsevarname]]
+testConstraint testparsevar [llength [info commands testparsevar]]
+testConstraint testasync [llength [info commands testasync]]
+testConstraint testcmdtrace [llength [info commands testcmdtrace]]
test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
testparser [bytestring "foo\0 bar"] -1
@@ -1045,7 +1042,7 @@ test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup {
interp delete i
} -returnCodes error -match glob -result {too many nested*}
- cleanupTests
+cleanupTests
}
namespace delete ::tcl::test::parse
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index a397a6b..a72eb87 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.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: parseExpr.test,v 1.17 2005/11/09 20:24:11 dgp Exp $
+# RCS: @(#) $Id: parseExpr.test,v 1.18 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -83,7 +83,7 @@ proc testIEEE {} {
}
}
}
-::tcltest::testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint ieeeFloatingPoint [testIEEE]
######################################################################
diff --git a/tests/parseOld.test b/tests/parseOld.test
index 40413db..12317e1 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -13,15 +13,14 @@
# 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.12 2003/03/27 13:49:00 dkf Exp $
+# RCS: @(#) $Id: parseOld.test,v 1.13 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-tcltest::testConstraint testwordend \
- [string equal "testwordend" [info commands testwordend]]
+testConstraint testwordend [llength [info commands testwordend]]
# Save the argv value for restoration later
set savedArgv $argv
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index b7bd664..c71f087 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -8,7 +8,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: pkgMkIndex.test,v 1.27 2004/07/28 18:00:11 dgp Exp $
+# RCS: @(#) $Id: pkgMkIndex.test,v 1.28 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -562,17 +562,17 @@ removeFile [file join pkg circ3.tcl]
set x [file join [file dirname [info nameofexecutable]] dltest \
pkga[info sharedlibextension]]
set dll "[file tail $x]Required"
-::tcltest::testConstraint $dll [file exists $x]
+testConstraint $dll [file exists $x]
if {[testConstraint $dll]} {
-makeFile {
+ makeFile {
# This package provides Pkga, which is also provided by a DLL.
package provide Pkga 1.0
proc pkga_neq { x } {
return [expr {! [pkgq_eq $x]}]
}
} [file join pkg pkga.tcl]
-file copy -force $x $fullPkgPath
+ file copy -force $x $fullPkgPath
}
testConstraint exec [llength [info commands ::exec]]
@@ -598,8 +598,8 @@ test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
} {0 {}}
if {[testConstraint $dll]} {
-file delete -force [file join $fullPkgPath [file tail $x]]
-removeFile [file join pkg pkga.tcl]
+ file delete -force [file join $fullPkgPath [file tail $x]]
+ removeFile [file join pkg pkga.tcl]
}
# Tolerate "namespace import" at the global scope
diff --git a/tests/registry.test b/tests/registry.test
index 9d475e7..28027d5 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -10,34 +10,32 @@
# Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
-# RCS: @(#) $Id: registry.test,v 1.18 2004/10/27 20:53:37 davygrvy Exp $
+# RCS: @(#) $Id: registry.test,v 1.19 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-if {$tcl_platform(platform) == "windows"} {
- if [catch {
+testConstraint reg 0
+if {[testConstraint win]} {
+ catch {
# Is the registry extension already static to this shell?
if [catch {load {} Registry; set ::reglib {}}] {
# try the location given to use on the commandline to tcltest
::tcltest::loadTestedCommands
load $::reglib Registry
}
- ::tcltest::testConstraint reg 1
- }] {
- ::tcltest::testConstraint reg 0
+ testConstraint reg 1
}
}
# determine the current locale
-testConstraint english [expr {[llength [info commands testlocale]]
- && [string match "English*" [testlocale all ""]]
+testConstraint english [expr {
+ [llength [info commands testlocale]]
+ && [string match "English*" [testlocale all ""]]
}]
-set hostname [info hostname]
-
test registry-1.1 {argument parsing for registry command} {win reg} {
list [catch {registry} msg] $msg
} {1 {wrong # args: should be "registry option ?arg arg ...?"}}
@@ -202,6 +200,7 @@ test registry-4.2 {GetKeyNames} {win reg} {
set result
} {baz}
test registry-4.3 {GetKeyNames: remote key} {win reg nonPortable english} {
+ set hostname [info hostname]
registry set \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar\\baz
set result [registry keys \\\\gaspode\\HKEY_CLASSES_ROOT\\TclFoobar]
registry delete \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar
@@ -471,6 +470,7 @@ test registry-7.3 {GetValueNames} {win reg} {
set result
} {{} baz blat}
test registry-7.4 {GetValueNames: remote key} {win reg nonPortable english} {
+ set hostname [info hostname]
registry set \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar baz blat
set result [registry values \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar]
registry delete \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar
@@ -598,6 +598,5 @@ test registry-12.5 {BroadcastValue} {win reg} {
} {0 {1 0}}
# cleanup
-unset hostname
::tcltest::cleanupTests
return
diff --git a/tests/safe.test b/tests/safe.test
index 4def77c..9324398 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -10,7 +10,9 @@
# 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.19 2005/05/10 18:35:23 kennykb Exp $
+# RCS: @(#) $Id: safe.test,v 1.20 2006/03/21 11:12:29 dkf Exp $
+
+package require Tcl 8.5
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -156,28 +158,25 @@ test safe-5.1 {test auto-loading in safe interpreters} {
} {0 -1}
# test safe interps 'information leak'
-proc SI {} {
- global I
- set I [interp create -safe];
-}
-proc DI {} {
- global I;
- interp delete $I;
+proc SafeEval {script} {
+ # Helper procedure that ensures the safe interp is cleaned up even if
+ # there is a failure in the script.
+ set SafeInterp [interp create -safe]
+ catch {$SafeInterp eval $script} msg opts
+ interp delete $SafeInterp
+ return -options $opts $msg
}
test safe-6.1 {test safe interpreters knowledge of the world} {
- SI; set r [lsort [$I eval {info globals}]]; DI; set r
+ lsort [SaveEval {info globals}]
} {tcl_interactive tcl_patchLevel tcl_platform tcl_version}
test safe-6.2 {test safe interpreters knowledge of the world} {
- SI; set r [$I eval {info script}]; DI; set r
+ SafeEval {info script}
} {}
test safe-6.3 {test safe interpreters knowledge of the world} {
- SI
- set r [lsort [$I eval {array names tcl_platform}]]
- DI
+ set r [lsort [SafeEval {array names tcl_platform}]]
# If running a windows-debug shell, remove the "debug" element from r.
- if {$tcl_platform(platform) == "windows" && \
- [lsearch $r "debug"] != -1} {
+ if {[testConstraint win] && ("debug" in $r)} {
set r [lreplace $r 1 1]
}
set threaded [lsearch $r "threaded"]
diff --git a/tests/scan.test b/tests/scan.test
index 5bc986c..e9ffad6 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -11,14 +11,14 @@
# 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.19 2005/12/19 19:03:17 dgp Exp $
+# RCS: @(#) $Id: scan.test,v 1.20 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-::tcltest::testConstraint wideIs64bit \
+testConstraint wideIs64bit \
[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
test scan-1.1 {BuildCharSet, CharInSet} {
diff --git a/tests/source.test b/tests/source.test
index 1d64034..29d3f2f 100644
--- a/tests/source.test
+++ b/tests/source.test
@@ -12,7 +12,7 @@
# 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.12 2004/03/17 18:14:18 das Exp $
+# RCS: @(#) $Id: source.test,v 1.13 2006/03/21 11:12:29 dkf Exp $
if {[catch {package require tcltest 2.1}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
@@ -20,12 +20,7 @@ if {[catch {package require tcltest 2.1}]} {
}
namespace eval ::tcl::test::source {
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::customMatch
+ namespace import ::tcltest::*
test source-1.1 {source command} -setup {
set x "old x value"
@@ -42,7 +37,6 @@ test source-1.1 {source command} -setup {
} -cleanup {
removeFile source.file
} -result {22 33 44}
-
test source-1.2 {source command} -setup {
set sourcefile [makeFile {list result} source.file]
} -body {
@@ -50,7 +44,6 @@ test source-1.2 {source command} -setup {
} -cleanup {
removeFile source.file
} -result result
-
test source-1.3 {source command} -setup {
set sourcefile [makeFile {} source.file]
set fd [open $sourcefile w]
@@ -94,7 +87,6 @@ test source-2.3 {source error conditions} -setup {
(file "*source.file" line 3)
invoked from within
"source $sourcefile"}]
-
test source-2.4 {source error conditions} -setup {
set sourcefile [makeFile {break} source.file]
} -body {
@@ -102,7 +94,6 @@ test source-2.4 {source error conditions} -setup {
} -cleanup {
removeFile source.file
} -returnCodes break
-
test source-2.5 {source error conditions} -setup {
set sourcefile [makeFile {continue} source.file]
} -body {
@@ -110,7 +101,6 @@ test source-2.5 {source error conditions} -setup {
} -cleanup {
removeFile source.file
} -returnCodes continue
-
test source-2.6 {source error conditions} -setup {
set sourcefile [makeFile {} _non_existent_]
removeFile _non_existent_
@@ -120,7 +110,6 @@ test source-2.6 {source error conditions} -setup {
{couldn't read file "*_non_existent_": no such file or directory} \
{POSIX ENOENT {no such file or directory}}]
-
test source-3.1 {return in middle of source file} -setup {
set sourcefile [makeFile {
set x new-x
@@ -135,7 +124,6 @@ test source-3.1 {return in middle of source file} -setup {
} -cleanup {
removeFile source.file
} -result {new-x old-y allDone}
-
test source-3.2 {return with special code etc.} -setup {
set sourcefile [makeFile {
set x new-x
@@ -147,7 +135,6 @@ test source-3.2 {return with special code etc.} -setup {
} -cleanup {
removeFile source.file
} -returnCodes break -result {Silly result}
-
test source-3.3 {return with special code etc.} -setup {
set sourcefile [makeFile {
set x new-x
@@ -161,7 +148,6 @@ test source-3.3 {return with special code etc.} -setup {
} -result {1 {Simulated error} {Simulated error
while executing
"source $sourcefile"} NONE}
-
test source-3.4 {return with special code etc.} -setup {
set sourcefile [makeFile {
set x new-x
@@ -175,7 +161,6 @@ test source-3.4 {return with special code etc.} -setup {
} -result {1 {} {Simulated errorInfo stuff
invoked from within
"source $sourcefile"} NONE}
-
test source-3.5 {return with special code etc.} -setup {
set sourcefile [makeFile {
set x new-x
@@ -191,7 +176,6 @@ test source-3.5 {return with special code etc.} -setup {
invoked from within
"source $sourcefile"} {a b c}}
-
test source-6.1 {source is binary ok} -setup {
# Note [makeFile] writes in the system encoding.
# [source] defaults to reading in the system encoding.
@@ -203,7 +187,6 @@ test source-6.1 {source is binary ok} -setup {
} -cleanup {
removeFile source.file
} -result 5
-
test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup {
set sourcefile [makeFile "set x ab\32c" source.file]
} -body {
@@ -228,7 +211,6 @@ test source-7.1 {source -encoding test} -setup {
} -cleanup {
removeFile source.file
} -result correct
-
test source-7.2 {source -encoding test} -setup {
# This tests for bad interactions between [source -encoding]
# and use of the Control-Z character (\u001A) as a cross-platform
@@ -248,12 +230,10 @@ test source-7.2 {source -encoding test} -setup {
} -cleanup {
removeFile source.file
} -result correct
-
test source-7.3 {source -encoding: syntax} -body {
# Have to spell out the -encoding option
source -e utf-8 no_file
} -returnCodes 1 -match glob -result {bad option*}
-
test source-7.4 {source -encoding: syntax} -setup {
set sourcefile [makeFile {} source.file]
} -body {
@@ -261,7 +241,6 @@ test source-7.4 {source -encoding: syntax} -setup {
} -cleanup {
removeFile source.file
} -returnCodes 1 -match glob -result {unknown encoding*}
-
test source-7.5 {source -encoding: correct operation} -setup {
set sourcefile [makeFile {} source.file]
file delete $sourcefile
@@ -276,7 +255,6 @@ test source-7.5 {source -encoding: correct operation} -setup {
removeFile source.file
rename \u20ac {}
} -result foo
-
test source-7.6 {source -encoding: mismatch encoding error} -setup {
set sourcefile [makeFile {} source.file]
file delete $sourcefile
diff --git a/tests/stack.test b/tests/stack.test
index 64b669a..047e0e8 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -9,7 +9,7 @@
# 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.18 2004/06/23 00:24:43 dkf Exp $
+# RCS: @(#) $Id: stack.test,v 1.19 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -23,19 +23,16 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# This doesn't catch all cases, for example threads of lower stacksize
# can still squeak through. A core check is really needed. -- JH
-if {[string equal $::tcl_platform(platform) "unix"]} {
+testConstraint minStack2400 1
+if {[testConstraint unix]} {
set stackSize [exec /bin/sh -c "ulimit -s"]
if {[string is integer $stackSize] && ($stackSize < 2400)} {
puts stderr "WARNING: the default application stacksize of $stackSize\
may cause Tcl to\ncrash due to stack overflow before the\
recursion limit is reached.\nA minimum stacksize of 2400\
kbytes is recommended.\nSkipping infinite recursion test."
- ::tcltest::testConstraint minStack2400 0
- } else {
- ::tcltest::testConstraint minStack2400 1
+ testConstraint minStack2400 0
}
-} else {
- ::tcltest::testConstraint minStack2400 1
}
test stack-1.1 {maxNestingDepth reached on infinite recursion} {minStack2400} {
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 2cf71f1..20afe69 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -9,7 +9,7 @@
# 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.23 2006/03/20 14:24:09 dgp Exp $
+# RCS: @(#) $Id: unixFCmd.test,v 1.24 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -25,7 +25,7 @@ cd [temporaryDirectory]
# Several tests require need to match results against the unix username
set user {}
-if {$tcl_platform(platform) == "unix"} {
+if {[testConstraint unix]} {
catch {set user [exec whoami]}
if {$user == ""} {
catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
@@ -35,6 +35,28 @@ if {$tcl_platform(platform) == "unix"} {
}
}
+# Find a group that exists on this system, or else skip tests that require
+# groups
+testConstraint foundGroup 0
+if {[testConstraint unix]} {
+ catch {
+ set groupList [exec groups]
+ set group [lindex $groupList 0]
+ testConstraint foundGroup 1
+ }
+}
+
+# check whether -readonly attribute is supported
+testConstraint readonlyAttr 0
+if {[testConstraint unix]} {
+ set f [makeFile "whatever" probe]
+ catch {
+ file attributes $f -readonly
+ testConstraint readonlyAttr 1
+ }
+ removeFile probe
+}
+
proc openup {path} {
testchmod 777 $path
if {[file isdirectory $path]} {
@@ -125,6 +147,7 @@ test unixFCmd-1.9 {Checking EINTR Bug} {unix notRoot nonPortable} {
catch {close $pipe}
list $line [testgotsig]
} {h 1}
+
test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
{unix notRoot} {
cleanup
@@ -232,17 +255,6 @@ test unixFCmd-14.2 {GetPermissionsAttribute} {unix notRoot} {
[file delete -force -- foo.test]
} {0 {}}
-# Find a group that exists on this system, or else skip tests that require
-# groups
-testConstraint foundGroup 0
-if {$tcl_platform(platform) == "unix"} {
- catch {
- set groupList [exec groups]
- set group [lindex $groupList 0]
- testConstraint foundGroup 1
- }
-}
-
#groups hard to test
test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unix notRoot} {
catch {file delete -force -- foo.test}
@@ -330,17 +342,6 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable unix notRoot} {
set r
} {1 {error getting working directory name:}}
-# check whether -readonly attribute is supported
-testConstraint readonlyAttr 0
-if {$tcl_platform(platform) == "unix"} {
- set f [makeFile "whatever" probe]
- catch {
- file attributes $f -readonly
- testConstraint readonlyAttr 1
- }
- removeFile probe
-}
-
test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} {unix notRoot readonlyAttr} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -readonly} msg] $msg
diff --git a/tests/unixInit.test b/tests/unixInit.test
index d2ebbfb..4c876c4 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.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: unixInit.test,v 1.48 2005/05/10 18:35:24 kennykb Exp $
+# RCS: @(#) $Id: unixInit.test,v 1.49 2006/03/21 11:12:29 dkf Exp $
package require tcltest 2.2
namespace import -force ::tcltest::*
@@ -20,27 +20,22 @@ set env(LANG) C
test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} {
set x {}
-
# 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 [interpreter]]" w+]
puts $f "puts hi"
flush $f
gets $f
exec kill -PIPE [pid $f]
lappend x [catch {close $f}]
-
set f [open "|[list [interpreter]]" w+]
puts $f "puts hi"
flush $f
gets $f
exec kill [pid $f]
lappend x [catch {close $f}]
-
set x
} {0 1}
-
# This test is really a test of code in tclUnixChan.c, but the
# channels are set up as part of initialisation of the interpreter so
# the test seems to me to fit here as well as anywhere else.
@@ -70,16 +65,13 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio}
# as a socket. Which is what this test is all about.
set pipe2 [open "|[list [interpreter] <@$sock]" r]
set result [gets $pipe2]
-
# Clear any pending data; stops certain kinds of (non-important) errors
fconfigure $pipe1 -blocking 0; gets $pipe1
fconfigure $pipe2 -blocking 0; gets $pipe2
-
# Close the pipes and the socket.
close $pipe2
close $pipe1
catch {close $sock}
-
# Can't use normal comparison, as hostname varies due to some
# installations having a messed up /etc/hosts file.
if {
@@ -105,7 +97,6 @@ test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} {
testsetdefenc $origDir
set path
} {slappy}
-
test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
@@ -114,11 +105,9 @@ test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup
}
} -body {
set path [getlibpath]
-
set installLib lib/tcl[info tclversion]
set developLib tcl[info patchlevel]/library
set prefix [file dirname [file dirname [interpreter]]]
-
set x {}
lappend x [string compare [lindex $path 0] $prefix/$installLib]
lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib]
@@ -129,19 +118,16 @@ test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup
unset oldlibrary
}
} -result {0 0}
-
test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
}
} -body {
- # ((str != NULL) && (str[0] != '\0'))
-
+ # ((str != NULL) && (str[0] != '\0'))
set env(TCL_LIBRARY) sparkly
set path [getlibpath]
unset env(TCL_LIBRARY)
-
lindex $path 0
} -cleanup {
if {[info exists oldlibrary]} {
@@ -149,7 +135,6 @@ test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup {
unset oldlibrary
}
} -result "sparkly"
-
test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
@@ -157,11 +142,9 @@ test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup {
}
} -body {
# ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0))
-
set env(TCL_LIBRARY) /a/b/tcl1.7
set path [getlibpath]
unset env(TCL_LIBRARY)
-
lrange $path 0 1
} -cleanup {
if {[info exists oldlibrary]} {
@@ -169,19 +152,16 @@ test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup {
unset oldlibrary
}
} -result [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
-
test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup {
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
}
} -body {
# Child process translates env variable from native encoding.
-
set env(TCL_LIBRARY) "\xa7"
set x [lindex [getlibpath] 0]
unset env(TCL_LIBRARY)
unset env(LANG)
-
set x
} -cleanup {
if {[info exists oldlibrary]} {
@@ -192,7 +172,6 @@ test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup {
test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} {
# cannot test
} {}
-
test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
@@ -223,12 +202,10 @@ test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup {
unset oldlibrary
}
} -result [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]]
-
test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} {
# would need test command to get defaultLibDir and compare it to
# [lindex $auto_path end]
} {}
-
#
# The following two tests write to the directory /tmp/sparkly instead
# of to [temporaryDirectory]. This is because the failures tested by
@@ -260,7 +237,6 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
file delete -force /tmp/lib/tcl[info tclversion]
file mkdir /tmp/sparkly
file copy [interpreter] /tmp/sparkly/tcltest
-
# Keep any existing /tmp/lib directory
set deletelib 1
if {[file exists /tmp/lib]} {
@@ -270,13 +246,11 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
file delete -force /tmp/lib
}
}
-
# For a successful Tcl_Init, we need a [source]-able init.tcl in
# ../lib/tcl$version relative to the executable.
file mkdir /tmp/lib/tcl[info tclversion]
close [open /tmp/lib/tcl[info tclversion]/init.tcl w]
} -body {
-
# Check that all directories in the library path are absolute pathnames
set allAbsolute 1
foreach dir [getlibpath /tmp/sparkly/tcltest] {
@@ -285,7 +259,6 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
}
set allAbsolute
} -cleanup {
-
# Clean up temporary installation
file delete -force /tmp/sparkly
file delete -force /tmp/lib/tcl[info tclversion]
@@ -296,7 +269,6 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
unset oldlibrary
}
} -result 1
-
test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -setup {
# Checking for Bug 438014
unset -nocomplain oldlibrary
@@ -308,7 +280,6 @@ test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -setup {
file delete -force /tmp/library
file mkdir /tmp/sparkly
file copy [interpreter] /tmp/sparkly/tcltest
-
file mkdir /tmp/library/
close [open /tmp/library/init.tcl w]
} -body {
@@ -323,7 +294,6 @@ test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -setup {
}
} -result [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \
/tmp/library /library /tcl[info patchlevel]/library]
-
test unixInit-2.10 {TclpInitLibraryPath: executable relative} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
@@ -374,23 +344,19 @@ test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
unix stdio
} -body {
set env(LANG) C
-
set f [open "|[list [interpreter]]" w+]
fconfigure $f -buffering none
puts $f {puts [encoding system]; exit}
set enc [gets $f]
close $f
unset env(LANG)
-
set enc
} -match regexp -result [expr {
($tcl_platform(os) eq "Darwin") ? "^utf-8$" : "^iso8859-15?$"}]
-
test unixInit-3.2 {TclpSetInitialEncodings} {unix stdio} {
set env(LANG) japanese
catch {set oldlc_all $env(LC_ALL)}
set env(LC_ALL) japanese
-
set f [open "|[list [interpreter]]" w+]
fconfigure $f -buffering none
puts $f {puts [encoding system]; exit}
@@ -399,7 +365,6 @@ test unixInit-3.2 {TclpSetInitialEncodings} {unix stdio} {
unset env(LANG)
unset env(LC_ALL)
catch {set env(LC_ALL) $oldlc_all}
-
set validEncodings [list euc-jp]
if {[string match HP-UX $tcl_platform(os)]} {
# Some older HP-UX systems need us to accept this as valid
@@ -409,10 +374,9 @@ test unixInit-3.2 {TclpSetInitialEncodings} {unix stdio} {
}
expr {[lsearch -exact $validEncodings $enc] < 0}
} 0
-
+
test unixInit-4.1 {TclpSetVariables} {unix} {
# just make sure they exist
-
set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
set tcl_platform(platform)
@@ -426,7 +390,7 @@ test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unix} {
} {}
test unixInit-7.1 {closed standard channel: Bug 772288} -constraints {
- unix stdio
+ unix stdio
} -body {
set tclsh [interpreter]
set crash [makeFile {puts [open /dev/null]} crash.tcl]
diff --git a/tests/unload.test b/tests/unload.test
index 6cc0007..8af0672 100644
--- a/tests/unload.test
+++ b/tests/unload.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: unload.test,v 1.4 2004/05/25 19:38:16 dgp Exp $
+# RCS: @(#) $Id: unload.test,v 1.5 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -26,19 +26,17 @@ set ext [info sharedlibextension]
set testDir [file join [file dirname [info nameofexecutable]] dltest]
set x [file join $testDir pkgua$ext]
set dll "[file tail $x]Required"
-::tcltest::testConstraint $dll [file readable $x]
+testConstraint $dll [file readable $x]
# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]
-::tcltest::testConstraint $loaded \
- [expr {![string match *pkgua* $alreadyLoaded]}]
+testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}]
set alreadyTotalLoaded [info loaded]
# Certain tests require the 'teststaticpkg' command from tcltest
-::tcltest::testConstraint teststaticpkg \
- [string compare {} [info commands teststaticpkg]]
+testConstraint teststaticpkg [llength [info commands teststaticpkg]]
# Basic tests: parameter testing...
test unload-1.1 {basic errors} {} {
diff --git a/tests/util.test b/tests/util.test
index da243cd..8c1ef26 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -7,13 +7,15 @@
# 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.17 2005/05/12 22:48:18 dgp Exp $
+# RCS: @(#) $Id: util.test,v 1.18 2006/03/21 11:12:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+testConstraint testdstring [llength [info commands testdstring]]
+
# Big test for correct ordering of data in [expr]
proc testIEEE {} {
@@ -70,7 +72,7 @@ proc testIEEE {} {
}
}
}
-::tcltest::testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint ieeeFloatingPoint [testIEEE]
proc convertDouble { x } {
variable ieeeValues
@@ -82,6 +84,7 @@ proc convertDouble { x } {
return $result
}
+
test util-1.1 {TclFindElement procedure - binary element in middle of list} {
lindex {0 foo\x00help 1} 1
} "foo\x00help"
@@ -102,7 +105,6 @@ test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces}
# have the property that it can be enclosing in curly braces to make
# an embedded sub-list. If this property doesn't hold, then
# Tcl_DStringStartSublist doesn't work.
-
set x {}
lappend x "# \\\{ \\"
concat $x [llength "{$x}"]
@@ -141,6 +143,7 @@ test util-3.5.1 {Tcl_ConverCountedElement procedure - quote leading '#'} {
rename #\{ {}
set result
} {#}
+
test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} {
concat a {b\ } c
} {a b\ c}
@@ -191,7 +194,6 @@ test util-5.8 {Tcl_StringMatch} {
} 1
test util-5.9 {Tcl_StringMatch: UTF-8} {
# skip one character in string
-
Wrapper_Tcl_StringMatch a?c a\u4e4fc
} 1
test util-5.10 {Tcl_StringMatch} {
@@ -205,19 +207,16 @@ test util-5.12 {Tcl_StringMatch} {
} 1
test util-5.13 {Tcl_StringMatch: UTF-8} {
# string += Tcl_UtfToUniChar(string, &ch);
-
Wrapper_Tcl_StringMatch "\[\u4e4fxy\]bc" "\u4e4fbc"
} 1
test util-5.14 {Tcl_StringMatch} {
# if ((*pattern == ']') || (*pattern == '\0'))
# badly formed pattern
-
Wrapper_Tcl_StringMatch {[]} {[]}
} 0
test util-5.15 {Tcl_StringMatch} {
# if ((*pattern == ']') || (*pattern == '\0'))
# badly formed pattern
-
Wrapper_Tcl_StringMatch {[} {[}
} 0
test util-5.16 {Tcl_StringMatch} {
@@ -226,19 +225,16 @@ test util-5.16 {Tcl_StringMatch} {
test util-5.17 {Tcl_StringMatch: UTF-8} {
# pattern += Tcl_UtfToUniChar(pattern, &endChar);
# get 1 UTF-8 character
-
Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc"
} 1
test util-5.18 {Tcl_StringMatch: UTF-8} {
# pattern += Tcl_UtfToUniChar(pattern, &endChar);
# proper advance: wrong answer would match on UTF trail byte of \u4e4f
-
Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [bytestring a\u008fc]
} 0
test util-5.19 {Tcl_StringMatch: UTF-8} {
# pattern += Tcl_UtfToUniChar(pattern, &endChar);
# proper advance.
-
Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc"
} 1
test util-5.20 {Tcl_StringMatch} {
@@ -319,7 +315,6 @@ test util-5.44 {Tcl_StringMatch: skip correct number of ']'} {
test util-5.45 {Tcl_StringMatch} {
# if (*pattern == '\0')
# badly formed pattern, still treats as a set
-
Wrapper_Tcl_StringMatch {[a} a
} 1
test util-5.46 {Tcl_StringMatch} {
@@ -373,7 +368,6 @@ test util-6.4 {Tcl_PrintDouble - using tcl_precision} -setup {
} -cleanup {
set tcl_precision $old_precision
} -result {x1.1234}
-
test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {
concat x[expr 2.0]
} {x2.0}
@@ -440,9 +434,6 @@ test util-8.1 {TclNeedSpace - correct UTF8 handling} {
interp delete \u5420
set result
} "\u5420 foo"
-
-testConstraint testdstring [expr {[info commands testdstring] != {}}]
-
test util-8.2 {TclNeedSpace - correct UTF8 handling} testdstring {
# Bug 411825
# This tests the same bug as the previous test, but