summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--library/dde/pkgIndex.tcl4
-rw-r--r--library/http/http.tcl2
-rwxr-xr-xlibrary/reg/pkgIndex.tcl4
-rw-r--r--library/tm.tcl228
-rw-r--r--tests/chanio.test4
-rw-r--r--tests/cmdAH.test30
-rw-r--r--tests/cmdMZ.test4
-rw-r--r--tests/compile.test4
-rw-r--r--tests/fCmd.test17
-rw-r--r--tests/fileName.test46
-rw-r--r--tests/interp.test64
-rw-r--r--tests/io.test4
-rw-r--r--tests/ioCmd.test10
-rw-r--r--tests/pid.test2
-rw-r--r--tests/registry.test8
-rw-r--r--tests/socket.test2
-rw-r--r--tests/tcltest.test108
-rw-r--r--tests/tm.test12
18 files changed, 284 insertions, 269 deletions
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index 065dc83..bcb5f9c 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,6 +1,6 @@
-if {![package vsatisfies [package provide Tcl] 8]} return
+if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] != ".dll"} return
-if {[info exists ::tcl_platform(debug)]} {
+if {[::tcl::pkgconfig get debug]} {
package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde]
} else {
package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde]
diff --git a/library/http/http.tcl b/library/http/http.tcl
index ac3b6d5..75898c9 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -1286,7 +1286,7 @@ proc http::Eof {token {force 0}} {
if {($state(coding) eq "gzip") && [string length $state(body)] > 0} {
if {[catch {
- if {[package vsatisfies [package present Tcl] 8.6]} {
+ if {[package vsatisfies [package provide Tcl] 8.6]} {
# The zlib integration into 8.6 includes proper gzip support
set state(body) [zlib gunzip $state(body)]
} else {
diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index 12c7ea5..9a85944 100755
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/pkgIndex.tcl
@@ -1,6 +1,6 @@
-if {![package vsatisfies [package provide Tcl] 8]} return
+if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] != ".dll"} return
-if {[info exists ::tcl_platform(debug)]} {
+if {[::tcl::pkgconfig get debug]} {
package ifneeded registry 1.3.3 \
[list load [file join $dir tclreg13g.dll] registry]
} else {
diff --git a/library/tm.tcl b/library/tm.tcl
index 87db0df..bab5485 100644
--- a/library/tm.tcl
+++ b/library/tm.tcl
@@ -1,48 +1,44 @@
# -*- tcl -*-
#
-# Searching for Tcl Modules. Defines a procedure, declares it as the
-# primary command for finding packages, however also uses the former
-# 'package unknown' command as a fallback.
+# Searching for Tcl Modules. Defines a procedure, declares it as the primary
+# command for finding packages, however also uses the former 'package unknown'
+# command as a fallback.
#
-# Locates all possible packages in a directory via a less restricted
-# glob. The targeted directory is derived from the name of the
-# requested package. I.e. the TM scan will look only at directories
-# which can contain the requested package. It will register all
-# packages it found in the directory so that future requests have a
-# higher chance of being fulfilled by the ifneeded database without
-# having to come to us again.
+# Locates all possible packages in a directory via a less restricted glob. The
+# targeted directory is derived from the name of the requested package, i.e.
+# the TM scan will look only at directories which can contain the requested
+# package. It will register all packages it found in the directory so that
+# future requests have a higher chance of being fulfilled by the ifneeded
+# database without having to come to us again.
#
-# We do not remember where we have been and simply rescan targeted
-# directories when invoked again. The reasoning is this:
+# We do not remember where we have been and simply rescan targeted directories
+# when invoked again. The reasoning is this:
#
-# - The only way we get back to the same directory is if someone is
-# trying to [package require] something that wasn't there on the
-# first scan.
+# - The only way we get back to the same directory is if someone is trying to
+# [package require] something that wasn't there on the first scan.
#
# Either
# 1) It is there now: If we rescan, you get it; if not you don't.
#
-# This covers the possibility that the application asked for a
-# package late, and the package was actually added to the
-# installation after the application was started. It shoukld
-# still be able to find it.
+# This covers the possibility that the application asked for a package
+# late, and the package was actually added to the installation after the
+# application was started. It shoukld still be able to find it.
#
-# 2) It still is not there: Either way, you don't get it, but the
-# rescan takes time. This is however an error case and we dont't
-# care that much about it
+# 2) It still is not there: Either way, you don't get it, but the rescan
+# takes time. This is however an error case and we dont't care that much
+# about it
#
-# 3) It was there the first time; but for some reason a "package
-# forget" has been run, and "package" doesn't know about it
-# anymore.
+# 3) It was there the first time; but for some reason a "package forget" has
+# been run, and "package" doesn't know about it anymore.
#
-# This can be an indication that the application wishes to reload
-# some functionality. And should work as well.
+# This can be an indication that the application wishes to reload some
+# functionality. And should work as well.
#
-# Note that this also strikes a balance between doing a glob targeting
-# a single package, and thus most likely requiring multiple globs of
-# the same directory when the application is asking for many packages,
-# and trying to glob for _everything_ in all subdirectories when
-# looking for a package, which comes with a heavy startup cost.
+# Note that this also strikes a balance between doing a glob targeting a
+# single package, and thus most likely requiring multiple globs of the same
+# directory when the application is asking for many packages, and trying to
+# glob for _everything_ in all subdirectories when looking for a package,
+# which comes with a heavy startup cost.
#
# We scan for regular packages only if no satisfying module was found.
@@ -71,46 +67,43 @@ namespace eval ::tcl::tm {
# path with 'list'.
#
# Results
-# No result for subcommands 'add' and 'remove'. A list of paths
-# for 'list'.
+# No result for subcommands 'add' and 'remove'. A list of paths for
+# 'list'.
#
# Sideeffects
-# The subcommands 'add' and 'remove' manipulate the list of
-# paths to search for Tcl Modules. The subcommand 'list' has no
-# sideeffects.
+# The subcommands 'add' and 'remove' manipulate the list of paths to
+# search for Tcl Modules. The subcommand 'list' has no sideeffects.
-proc ::tcl::tm::add {path args} {
+proc ::tcl::tm::add {args} {
# PART OF THE ::tcl::tm::path ENSEMBLE
#
# The path is added at the head to the list of module paths.
#
- # The command enforces the restriction that no path may be an
- # ancestor directory of any other path on the list. If the new
- # path violates this restriction an error wil be raised.
+ # The command enforces the restriction that no path may be an ancestor
+ # directory of any other path on the list. If the new path violates this
+ # restriction an error wil be raised.
#
- # If the path is already present as is no error will be raised and
- # no action will be taken.
+ # If the path is already present as is no error will be raised and no
+ # action will be taken.
variable paths
- # We use a copy of the path as source during validation, and
- # extend it as well. Because we not only have to detect if the new
- # paths are bogus with respect to the existing paths, but also
- # between themselves. Otherwise we can still add bogus paths, by
- # specifying them in a single call. This makes the use of the new
- # paths simpler as well, a trivial assignment of the collected
- # paths to the official state var.
+ # We use a copy of the path as source during validation, and extend it as
+ # well. Because we not only have to detect if the new paths are bogus with
+ # respect to the existing paths, but also between themselves. Otherwise we
+ # can still add bogus paths, by specifying them in a single call. This
+ # makes the use of the new paths simpler as well, a trivial assignment of
+ # the collected paths to the official state var.
set newpaths $paths
- foreach p [linsert $args 0 $path] {
+ foreach p $args {
if {$p in $newpaths} {
# Ignore a path already on the list.
continue
}
- # Search for paths which are subdirectories of the new one. If
- # there are any then the new path violates the restriction
- # about ancestors.
+ # Search for paths which are subdirectories of the new one. If there
+ # are any then the new path violates the restriction about ancestors.
set pos [lsearch -glob $newpaths ${p}/*]
# Cannot use "in", we need the position for the message.
@@ -119,10 +112,9 @@ proc ::tcl::tm::add {path args} {
"$p is ancestor of existing module path [lindex $newpaths $pos]."
}
- # Now look for existing paths which are ancestors of the new
- # one. This reverse question forces us to loop over the
- # existing paths, as each element is the pattern, not the new
- # path :(
+ # Now look for existing paths which are ancestors of the new one. This
+ # reverse question forces us to loop over the existing paths, as each
+ # element is the pattern, not the new path :(
foreach ep $newpaths {
if {[string match ${ep}/* $p]} {
@@ -134,24 +126,23 @@ proc ::tcl::tm::add {path args} {
set newpaths [linsert $newpaths 0 $p]
}
- # The validation of the input is complete and successful, and
- # everything in newpaths is either an old path, or added. We can
- # now extend the official list of paths, a simple assignment is
- # sufficient.
+ # The validation of the input is complete and successful, and everything
+ # in newpaths is either an old path, or added. We can now extend the
+ # official list of paths, a simple assignment is sufficient.
set paths $newpaths
return
}
-proc ::tcl::tm::remove {path args} {
+proc ::tcl::tm::remove {args} {
# PART OF THE ::tcl::tm::path ENSEMBLE
#
- # Removes the path from the list of module paths. The command is
- # silently ignored if the path is not on the list.
+ # Removes the path from the list of module paths. The command is silently
+ # ignored if the path is not on the list.
variable paths
- foreach p [linsert $args 0 $path] {
+ foreach p $args {
set pos [lsearch -exact $paths $p]
if {$pos >= 0} {
set paths [lreplace $paths $pos $pos]
@@ -177,17 +168,16 @@ proc ::tcl::tm::list {} {
# empty string.
# exact - Either -exact or ommitted.
#
-# Name, version, and exact are used to determine
-# satisfaction. The original is called iff no satisfaction was
-# achieved. The name is also used to compute the directory to
-# target in the search.
+# Name, version, and exact are used to determine satisfaction. The
+# original is called iff no satisfaction was achieved. The name is also
+# used to compute the directory to target in the search.
#
# Results
# None.
#
# Sideeffects
-# May populate the package ifneeded database with additional
-# provide scripts.
+# May populate the package ifneeded database with additional provide
+# scripts.
proc ::tcl::tm::UnknownHandler {original name args} {
# Import the list of paths to search for packages in module form.
@@ -196,8 +186,8 @@ proc ::tcl::tm::UnknownHandler {original name args} {
variable paths
variable pkgpattern
- # Without paths to search we can do nothing. (Except falling back
- # to the regular search).
+ # Without paths to search we can do nothing. (Except falling back to the
+ # regular search).
if {[llength $paths]} {
set pkgpath [string map {:: /} $name]
@@ -206,11 +196,10 @@ proc ::tcl::tm::UnknownHandler {original name args} {
set pkgroot ""
}
- # We don't remember a copy of the paths while looping. Tcl
- # Modules are unable to change the list while we are searching
- # for them. This also simplifies the loop, as we cannot get
- # additional directories while iterating over the list. A
- # simple foreach is sufficient.
+ # We don't remember a copy of the paths while looping. Tcl Modules are
+ # unable to change the list while we are searching for them. This also
+ # simplifies the loop, as we cannot get additional directories while
+ # iterating over the list. A simple foreach is sufficient.
set satisfied 0
foreach path $paths {
@@ -223,12 +212,11 @@ proc ::tcl::tm::UnknownHandler {original name args} {
}
set strip [llength [file split $path]]
- # We can't use glob in safe interps, so enclose the following
- # in a catch statement, where we get the module files out
- # of the subdirectories. In other words, Tcl Modules are
- # not-functional in such an interpreter. This is the same
- # as for the command "tclPkgUnknown", i.e. the search for
- # regular packages.
+ # We can't use glob in safe interps, so enclose the following in a
+ # catch statement, where we get the module files out of the
+ # subdirectories. In other words, Tcl Modules are not-functional
+ # in such an interpreter. This is the same as for the command
+ # "tclPkgUnknown", i.e. the search for regular packages.
catch {
# We always look for _all_ possible modules in the current
@@ -238,13 +226,13 @@ proc ::tcl::tm::UnknownHandler {original name args} {
set pkgfilename [join [lrange [file split $file] $strip end] ::]
if {![regexp -- $pkgpattern $pkgfilename --> pkgname pkgversion]} {
- # Ignore everything not matching our pattern
- # for package names.
+ # Ignore everything not matching our pattern for
+ # package names.
continue
}
if {[catch {package vcompare $pkgversion 0}]} {
- # Ignore everything where the version part is
- # not acceptable to "package vcompare".
+ # Ignore everything where the version part is not
+ # acceptable to "package vcompare".
continue
}
@@ -257,38 +245,36 @@ proc ::tcl::tm::UnknownHandler {original name args} {
continue
}
- # We have found a candidate, generate a "provide
- # script" for it, and remember it. Note that we
- # are using ::list to do this; locally [list]
- # means something else without the namespace
- # specifier.
-
- # NOTE. When making changes to the format of the
- # provide command generated below CHECK that the
- # 'LOCATE' procedure in core file
- # 'platform/shell.tcl' still understands it, or,
- # if not, update its implementation appropriately.
+ # We have found a candidate, generate a "provide script"
+ # for it, and remember it. Note that we are using ::list
+ # to do this; locally [list] means something else without
+ # the namespace specifier.
+
+ # NOTE. When making changes to the format of the provide
+ # command generated below CHECK that the 'LOCATE'
+ # procedure in core file 'platform/shell.tcl' still
+ # understands it, or, if not, update its implementation
+ # appropriately.
#
- # Right now LOCATE's implementation assumes that
- # the path of the package file is the last element
- # in the list.
+ # Right now LOCATE's implementation assumes that the path
+ # of the package file is the last element in the list.
package ifneeded $pkgname $pkgversion \
"[::list package provide $pkgname $pkgversion];[::list source -encoding utf-8 $file]"
- # We abort in this unknown handler only if we got
- # a satisfying candidate for the requested
- # package. Otherwise we still have to fallback to
- # the regular package search to complete the
- # processing.
+ # We abort in this unknown handler only if we got a
+ # satisfying candidate for the requested package.
+ # Otherwise we still have to fallback to the regular
+ # package search to complete the processing.
if {($pkgname eq $name)
&& [package vsatisfies $pkgversion {*}$args]} {
set satisfied 1
- # We do not abort the loop, and keep adding
- # provide scripts for every candidate in the
- # directory, just remember to not fall back to
- # the regular search anymore.
+
+ # We do not abort the loop, and keep adding provide
+ # scripts for every candidate in the directory, just
+ # remember to not fall back to the regular search
+ # anymore.
}
}
}
@@ -299,8 +285,8 @@ proc ::tcl::tm::UnknownHandler {original name args} {
}
}
- # Fallback to previous command, if existing. See comment above
- # about ::list...
+ # Fallback to previous command, if existing. See comment above about
+ # ::list...
if {[llength $original]} {
uplevel 1 $original [::linsert $args 0 $name]
@@ -323,7 +309,7 @@ proc ::tcl::tm::UnknownHandler {original name args} {
proc ::tcl::tm::Defaults {} {
global env tcl_platform
- lassign [split [info tclversion] .] major minor
+ regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
set exe [file normalize [info nameofexecutable]]
# Note that we're using [::list], not [list] because [list] means
@@ -366,22 +352,22 @@ proc ::tcl::tm::Defaults {} {
# Calls 'path add' to paths to the list of module search paths.
proc ::tcl::tm::roots {paths} {
- lassign [split [package present Tcl] .] major minor
+ regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
foreach pa $paths {
set p [file join $pa tcl$major]
for {set n $minor} {$n >= 0} {incr n -1} {
set px [file join $p ${major}.${n}]
- if {![interp issafe]} { set px [file normalize $px] }
+ if {![interp issafe]} {set px [file normalize $px]}
path add $px
}
set px [file join $p site-tcl]
- if {![interp issafe]} { set px [file normalize $px] }
+ if {![interp issafe]} {set px [file normalize $px]}
path add $px
}
return
}
-# Initialization. Set up the default paths, then insert the new
-# handler into the chain.
+# Initialization. Set up the default paths, then insert the new handler into
+# the chain.
-if {![interp issafe]} { ::tcl::tm::Defaults }
+if {![interp issafe]} {::tcl::tm::Defaults}
diff --git a/tests/chanio.test b/tests/chanio.test
index 5d47e0b..a18bbbe 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -2069,7 +2069,7 @@ test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} {
set l
} {0 60 72}
test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} \
- {unixOrPc} {
+ {unixOrWin} {
file delete $path(test1)
set f [open $path(test1) w]
chan configure $f -translation lf -buffersize 60 -eofchar {}
@@ -7339,7 +7339,7 @@ test chan-io-57.2 {buffered data and file events, read} {fileevent} {
set result
} {1 readable 234567890 timer}
-test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} {
+test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
set out [open $path(script) w]
chan puts $out {
chan puts "normal message from pipe"
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index c8318c0..563a09e 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -372,7 +372,7 @@ test cmdAH-8.45 {Tcl_FileObjCmd: dirname} {
-match regexp
-setup {
set temp $::env(HOME)
- }
+ }
-body {
set ::env(HOME) "/homewontexist/test"
testsetplatform windows
@@ -878,7 +878,7 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
} 1
test cmdAH-18.5 {Tcl_FileObjCmd: executable} {win} {
- # On pc, must be a .exe, .com, etc.
+ # On windows, must be a .exe, .com, etc.
set x [file exe $gorpfile]
set gorpexe [makeFile foo gorp.exe]
@@ -887,7 +887,7 @@ test cmdAH-18.5 {Tcl_FileObjCmd: executable} {win} {
set x
} {0 1}
test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} {win} {
- # On pc, must be a .exe, .com, etc.
+ # On windows, must be a .exe, .com, etc.
set x [file exe $gorpfile]
set gorpexe [makeFile foo gorp.exe]
@@ -1303,8 +1303,28 @@ test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -cons
test cmdAH-25.1 {Tcl_FileObjCmd: owned} {
list [catch {file owned a b} msg] $msg
} {1 {wrong # args: should be "file owned name"}}
-test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -body {
- file owned $gorpfile
+test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -setup {
+ set fn $gorpfile
+ # prefer temp file to check owner (try to avoid bug [7de2d722bd]):
+ if {
+ [info exists ::env(TEMP)] && [file isdirectory $::env(TEMP)] &&
+ [file dirname $fn] ne [file normalize $::env(TEMP)]
+ } {
+ set fn [file join $::env(TEMP)/test-owner-from-tcl.txt]
+ set fn [makeFile "data" test-owner-from-tcl.txt $::env(TEMP)]
+ }
+ # be sure we have really owned this file before trying to check that
+ # (avoid dependency on admin with UAC and the setting "System objects:
+ # Default owner for objects created by members of the Administrators group"):
+ catch {
+ exec takeown /F [file nativename $fn]
+ }
+} -body {
+ file owned $fn
+} -cleanup {
+ if {$fn ne $gorpfile} {
+ removeFile $fn
+ }
} -result 1
test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup {
# Avoid problems with AFS
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 98cb0fb..5f94777 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -224,12 +224,12 @@ foreach script {
# More tests of Tcl_SourceObjCmd are in source.test
test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints {
- unixOrPc
+ unixOrWin
} -body {
list [catch {source} msg] $msg
} -match glob -result {1 {wrong # args: should be "source*fileName"}}
test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints {
- unixOrPc
+ unixOrWin
} -body {
list [catch {source a b} msg] $msg
} -match glob -result {1 {wrong # args: should be "source*fileName"}}
diff --git a/tests/compile.test b/tests/compile.test
index cd26fdf..a66da22 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -442,10 +442,10 @@ test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup
}}
} -body {
# Test different compilation variants (instructions evalStk, invokeStk, etc),
- # with 2000 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack
+ # with 1500 (750 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack
# boxes or systems, please don't decrease it (either provide a constraint)
$i eval {foreach cmd {eval "if 1" catch} {
- set c [gencode [expr {![::tcl::pkgconfig get debug] ? 2000 : 1000}] $cmd]
+ set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 750}] $cmd]
if 1 $c
}}
$i eval {set result}
diff --git a/tests/fCmd.test b/tests/fCmd.test
index f53128d..71bc186 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -26,6 +26,15 @@ testConstraint winOlderThan2000 0
testConstraint notNetworkFilesystem 0
testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
testConstraint 2000orNewer [expr {![testConstraint 95or98]}]
+testConstraint reg 0
+if {[testConstraint win]} {
+ if {![catch {
+ ::tcltest::loadTestedCommands
+ set ::regver [package require registry 1.3.3]
+ }]} {
+ testConstraint reg 1
+ }
+}
set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
@@ -49,7 +58,7 @@ if {[testConstraint unix]} {
}
# Also used in winFCmd...
-if {[testConstraint winOnly]} {
+if {[testConstraint win]} {
if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
if {$::tcl_platform(osVersion) >= 6.0} {
testConstraint winVista 1
@@ -259,7 +268,7 @@ test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup {
} -result {user "_totally_bogus_user" doesn't exist}
test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup {
cleanup
-} -constraints {notRoot unixOrPc} -returnCodes error -body {
+} -constraints {notRoot unixOrWin} -returnCodes error -body {
file mkdir td1
file rename / td1
} -result {error renaming "/" to "td1": file already exists}
@@ -387,7 +396,7 @@ test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
file delete tf1 td1 tf2
lappend x [file exists tf1] [file exists tf2] [file exists tf3]
} {1 1 1 0 0 0}
-test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {
+test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrWin} {
cleanup
createfile tf1
createfile tf2
@@ -1080,7 +1089,7 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup {
} -result [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} -setup {
cleanup
-} -constraints {notRoot unixOrPc testchmod} -body {
+} -constraints {notRoot unixOrWin testchmod} -body {
file mkdir tds1
file mkdir tds2
file mkdir [file join tdd1 tds1 xxx]
diff --git a/tests/fileName.test b/tests/fileName.test
index a4c8efe..3747fc9 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -1116,13 +1116,13 @@ file delete -force $tildeglobname
set globname globTest
unset horribleglobname tildeglobname
-test filename-12.1 {simple globbing} {unixOrPc} {
+test filename-12.1 {simple globbing} {unixOrWin} {
list [catch {glob {}} msg] $msg
} {0 .}
-test filename-12.1.1 {simple globbing} {unixOrPc} {
+test filename-12.1.1 {simple globbing} {unixOrWin} {
list [catch {glob -types f {}} msg] $msg
} {1 {no files matched glob pattern ""}}
-test filename-12.1.2 {simple globbing} {unixOrPc} {
+test filename-12.1.2 {simple globbing} {unixOrWin} {
list [catch {glob -types d {}} msg] $msg
} {0 .}
test filename-12.1.3 {simple globbing} {unix} {
@@ -1144,7 +1144,7 @@ test filename-12.3 {simple globbing} {
set globPreResult globTest/
set x1 x1.c
set y1 y1.c
-test filename-12.4 {simple globbing} {unixOrPc} {
+test filename-12.4 {simple globbing} {unixOrWin} {
lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
} "$globPreResult$x1 $globPreResult$y1"
test filename-12.5 {simple globbing} {
@@ -1231,32 +1231,32 @@ test filename-13.9 {globbing with brace substitution} {
test filename-13.10 {globbing with brace substitution} {
list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg
} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
-test filename-13.11 {globbing with brace substitution} {unixOrPc} {
+test filename-13.11 {globbing with brace substitution} {unixOrWin} {
list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
} {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}}
test filename-13.13 {globbing with brace substitution} {
lsort [glob globTest/{a,b,x,y}1.c]
} [list $globPreResult$x1 $globPreResult$y1]
-test filename-13.14 {globbing with brace substitution} {unixOrPc} {
+test filename-13.14 {globbing with brace substitution} {unixOrWin} {
lsort [glob {globTest/{x1,y2,weird name}.c}]
} {{globTest/weird name.c} globTest/x1.c}
-test filename-13.16 {globbing with brace substitution} {unixOrPc} {
+test filename-13.16 {globbing with brace substitution} {unixOrWin} {
lsort [glob globTest/{x1.c,a1/*}]
} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
-test filename-13.18 {globbing with brace substitution} {unixOrPc} {
+test filename-13.18 {globbing with brace substitution} {unixOrWin} {
lsort [glob globTest/{x1.c,{a},a1/*}]
} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
-test filename-13.20 {globbing with brace substitution} {unixOrPc} {
+test filename-13.20 {globbing with brace substitution} {unixOrWin} {
lsort [glob globTest/{a,x}1/*/{x,y}*]
} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
test filename-13.22 {globbing with brace substitution} {
list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg
} {1 {unmatched open-brace in file name}}
-test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
+test filename-14.1 {asterisks, question marks, and brackets} {unixOrWin} {
lsort [glob glo*/*.c]
} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
+test filename-14.3 {asterisks, question marks, and brackets} {unixOrWin} {
lsort [glob globTest/?1.c]
} {globTest/x1.c globTest/y1.c globTest/z1.c}
@@ -1266,7 +1266,7 @@ file rename globTest [file join globTestContext globTest]
set savepwd [pwd]
cd globTestContext
-test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} {
+test filename-14.5 {asterisks, question marks, and brackets} {unixOrWin} {
lsort [glob */*/*/*.c]
} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
@@ -1281,16 +1281,16 @@ test filename-14.7 {asterisks, question marks, and brackets} {unix} {
test filename-14.7.1 {asterisks, question marks, and brackets} {win} {
lsort [glob globTest/*]
} {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} {
+test filename-14.9 {asterisks, question marks, and brackets} {unixOrWin} {
lsort [glob globTest/.*]
} {globTest/. globTest/.. globTest/.1}
-test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} {
+test filename-14.11 {asterisks, question marks, and brackets} {unixOrWin} {
lsort [glob globTest/*/*]
} {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
-test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} {
+test filename-14.13 {asterisks, question marks, and brackets} {unixOrWin} {
lsort [glob {globTest/[xyab]1.*}]
} {globTest/x1.c globTest/y1.c}
-test filename-14.15 {asterisks, question marks, and brackets} {unixOrPc} {
+test filename-14.15 {asterisks, question marks, and brackets} {unixOrWin} {
lsort [glob globTest/*/]
} {globTest/a1/ globTest/a2/ globTest/a3/}
test filename-14.17 {asterisks, question marks, and brackets} {
@@ -1301,7 +1301,7 @@ test filename-14.17 {asterisks, question marks, and brackets} {
set env(HOME) $temp
set result
} [list 0 [list [file join $env(HOME) globTest z1.c]]]
-test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} {
+test filename-14.18 {asterisks, question marks, and brackets} {unixOrWin} {
list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
} {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}}
test filename-14.20 {asterisks, question marks, and brackets} {
@@ -1340,16 +1340,16 @@ test filename-14.25.1 {type specific globbing} {win} {
test filename-14.26 {type specific globbing} {
list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg
} [list 0 {}]
-test filename-14.27 {Bug 2710920} {unixOrPc} {
+test filename-14.27 {Bug 2710920} {unixOrWin} {
file tail [lindex [lsort [glob globTest/*/]] 0]
} a1
-test filename-14.28 {Bug 2710920} {unixOrPc} {
+test filename-14.28 {Bug 2710920} {unixOrWin} {
file dirname [lindex [lsort [glob globTest/*/]] 0]
} globTest
-test filename-14.29 {Bug 2710920} {unixOrPc} {
+test filename-14.29 {Bug 2710920} {unixOrWin} {
file extension [lindex [lsort [glob globTest/*/]] 0]
} {}
-test filename-14.30 {Bug 2710920} {unixOrPc} {
+test filename-14.30 {Bug 2710920} {unixOrWin} {
file rootname [lindex [lsort [glob globTest/*/]] 0]
} globTest/a1/
@@ -1406,7 +1406,7 @@ test filename-15.4.1 {no complain: errors, sequencing} {
} {1 {user "wontexist" doesn't exist} 1 {user "blahxyz" doesn't exist}}
test filename-15.4.2 {no complain: errors, sequencing} {
# test used to fail because if an error occurs, the interp's result
- # is reset...
+ # is reset...
string equal \
[list [catch {glob -nocomplain ~wontexist *} res1] $res1] \
[list [catch {glob -nocomplain * ~wontexist} res2] $res2]
@@ -1414,7 +1414,7 @@ test filename-15.4.2 {no complain: errors, sequencing} {
test filename-15.5 {unix specific globbing} {unix nonPortable} {
glob ~ouster/.csh*
} "/home/ouster/.cshrc"
-catch {close [open globTest/odd\\\[\]*?\{\}name w]}
+catch {close [open globTest/odd\\\[\]*?\{\}name w]}
test filename-15.6 {unix specific globbing} {unix} {
global env
set temp $env(HOME)
diff --git a/tests/interp.test b/tests/interp.test
index 510ab4a..b5632e1 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -53,7 +53,7 @@ test interp-1.8 {options for interp command} {
} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.9 {options for interp command} {
list [catch {interp -froboz -safe} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.10 {options for interp command} {
list [catch {interp target} msg] $msg
} {1 {wrong # args: should be "interp target path alias"}}
@@ -68,7 +68,7 @@ test interp-2.2 {basic interpreter creation} {
} 0
test interp-2.3 {basic interpreter creation} {
catch {interp create -safe}
-} 0
+} 0
test interp-2.4 {basic interpreter creation} {
list [catch {interp create a} msg] $msg
} {1 {interpreter named "a" already exists, cannot create}}
@@ -100,7 +100,7 @@ test interp-2.11 {anonymous interps vs existing procs} {
set x [interp create]
regexp "interp(\[0-9]+)" $x dummy anothernum
expr $anothernum > $thenum
-} 1
+} 1
test interp-2.12 {anonymous interps vs existing procs} {
set x [interp create -safe]
regexp "interp(\[0-9]+)" $x dummy thenum
@@ -109,11 +109,11 @@ test interp-2.12 {anonymous interps vs existing procs} {
set x [interp create -safe]
regexp "interp(\[0-9]+)" $x dummy anothernum
expr $anothernum - $thenum
-} 1
+} 1
test interp-2.13 {correct default when no $path arg is given} -body {
interp create --
} -match regexp -result {interp[0-9]+}
-
+
foreach i [interp slaves] {
interp delete $i
}
@@ -854,12 +854,12 @@ test interp-18.9 {eval in deleted interp, bug 495830} {
interp create tst
interp alias tst suicide {} interp delete tst
list [catch {tst eval {suicide; set a 5}} msg] $msg
-} {1 {attempt to call eval in deleted interpreter}}
+} {1 {attempt to call eval in deleted interpreter}}
test interp-18.10 {eval in deleted interp, bug 495830} {
interp create tst
interp alias tst suicide {} interp delete tst
list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
-} {1 {attempt to call eval in deleted interpreter}}
+} {1 {attempt to call eval in deleted interpreter}}
# Test alias deletion
@@ -949,7 +949,7 @@ test interp-19.9 {alias deletion, renaming} {
set l [interp eval a foo]
interp delete a
set l
-} 1156
+} 1156
test interp-20.1 {interp hide, interp expose and interp invokehidden} {
set a [interp create]
@@ -1170,7 +1170,7 @@ test interp-20.21 {interp hide vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {a hide list} msg]
+ lappend l [catch {a hide list} msg]
lappend l $msg
interp delete a
set l
@@ -1179,7 +1179,7 @@ test interp-20.22 {interp hide vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {interp hide a list} msg]
+ lappend l [catch {interp hide a list} msg]
lappend l $msg
interp delete a
set l
@@ -1188,7 +1188,7 @@ test interp-20.23 {interp hide vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {a eval {interp hide {} list}} msg]
+ lappend l [catch {a eval {interp hide {} list}} msg]
lappend l $msg
interp delete a
set l
@@ -1198,7 +1198,7 @@ test interp-20.24 {interp hide vs safety} {
interp create a -safe
interp create {a b}
set l ""
- lappend l [catch {a eval {interp hide b list}} msg]
+ lappend l [catch {a eval {interp hide b list}} msg]
lappend l $msg
interp delete a
set l
@@ -1217,7 +1217,7 @@ test interp-20.26 {interp expoose vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {a hide list} msg]
+ lappend l [catch {a hide list} msg]
lappend l $msg
lappend l [catch {a expose list} msg]
lappend l $msg
@@ -1228,9 +1228,9 @@ test interp-20.27 {interp expose vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {interp hide a list} msg]
+ lappend l [catch {interp hide a list} msg]
lappend l $msg
- lappend l [catch {interp expose a list} msg]
+ lappend l [catch {interp expose a list} msg]
lappend l $msg
interp delete a
set l
@@ -1239,7 +1239,7 @@ test interp-20.28 {interp expose vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {a hide list} msg]
+ lappend l [catch {a hide list} msg]
lappend l $msg
lappend l [catch {a eval {interp expose {} list}} msg]
lappend l $msg
@@ -1250,9 +1250,9 @@ test interp-20.29 {interp expose vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {interp hide a list} msg]
+ lappend l [catch {interp hide a list} msg]
lappend l $msg
- lappend l [catch {a eval {interp expose {} list}} msg]
+ lappend l [catch {a eval {interp expose {} list}} msg]
lappend l $msg
interp delete a
set l
@@ -1262,9 +1262,9 @@ test interp-20.30 {interp expose vs safety} {
interp create a -safe
interp create {a b}
set l ""
- lappend l [catch {interp hide {a b} list} msg]
+ lappend l [catch {interp hide {a b} list} msg]
lappend l $msg
- lappend l [catch {a eval {interp expose b list}} msg]
+ lappend l [catch {a eval {interp expose b list}} msg]
lappend l $msg
interp delete a
set l
@@ -1274,7 +1274,7 @@ test interp-20.31 {interp expose vs safety} {
interp create a -safe
interp create {a b}
set l ""
- lappend l [catch {interp hide {a b} list} msg]
+ lappend l [catch {interp hide {a b} list} msg]
lappend l $msg
lappend l [catch {interp expose {a b} list} msg]
lappend l $msg
@@ -1631,7 +1631,7 @@ test interp-21.5 {interp hidden} {
set l [lsort [interp hidden a]]
interp delete a
set l
-} $hidden_cmds
+} $hidden_cmds
test interp-21.6 {interp hidden vs interp hide, interp expose} {
catch {interp delete a}
interp create a
@@ -1786,7 +1786,7 @@ test interp-23.1 {testing hiding vs aliases} {
interp delete a
set l
} {{} bar {} bar bar {} {}}
-test interp-23.2 {testing hiding vs aliases} {unixOrPc} {
+test interp-23.2 {testing hiding vs aliases} {unixOrWin} {
catch {interp delete a}
interp create a -safe
set l ""
@@ -1802,7 +1802,7 @@ test interp-23.2 {testing hiding vs aliases} {unixOrPc} {
lappend l [lsort [interp hidden a]]
interp delete a
set l
-} {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload}}
+} {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload}}
test interp-24.1 {result resetting on error} {
catch {interp delete a}
@@ -2045,7 +2045,7 @@ test interp-26.1 {result code transmission : interp eval direct} {
# Test that all the possibles error codes from Tcl get passed up
# from the slave interp's context to the master, even though the
# slave nominally thinks the command is running at the root level.
-
+
catch {interp delete a}
interp create a
set res {}
@@ -2076,7 +2076,7 @@ test interp-26.3 {result code transmission : aliases} {
# Test that all the possibles error codes from Tcl get passed up
# from the slave interp's context to the master, even though the
# slave nominally thinks the command is running at the root level.
-
+
catch {interp delete a}
interp create a
set res {}
@@ -2193,7 +2193,7 @@ test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} {
test interp-27.1 {interp aliases & namespaces} {
set i [interp create];
set aliasTrace {};
- proc tstAlias {args} {
+ proc tstAlias {args} {
global aliasTrace;
lappend aliasTrace [list [namespace current] $args];
}
@@ -2206,7 +2206,7 @@ test interp-27.1 {interp aliases & namespaces} {
test interp-27.2 {interp aliases & namespaces} {
set i [interp create];
set aliasTrace {};
- proc tstAlias {args} {
+ proc tstAlias {args} {
global aliasTrace;
lappend aliasTrace [list [namespace current] $args];
}
@@ -2219,7 +2219,7 @@ test interp-27.2 {interp aliases & namespaces} {
test interp-27.3 {interp aliases & namespaces} {
set i [interp create];
set aliasTrace {};
- proc tstAlias {args} {
+ proc tstAlias {args} {
global aliasTrace;
lappend aliasTrace [list [namespace current] $args];
}
@@ -2234,7 +2234,7 @@ test interp-27.4 {interp aliases & namespaces} {
set i [interp create];
namespace eval foo2 {
variable aliasTrace {};
- proc bar {args} {
+ proc bar {args} {
variable aliasTrace;
lappend aliasTrace [list [namespace current] $args];
}
@@ -3206,7 +3206,7 @@ test interp-34.9 {time limits trigger in blocking after} {
} msg]
set t1 [clock seconds]
interp delete $i
- list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}]
+ list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}]
} {1 {time limit exceeded} OK}
test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body {
set i [interp create]
@@ -3440,7 +3440,7 @@ test interp-35.24 {interp time limits can't touch current interp} -body {
test interp-36.1 {interp bgerror syntax} -body {
interp bgerror
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
-test interp-36.2 {interp bgerror syntax} -body {
+test interp-36.2 {interp bgerror syntax} -body {
interp bgerror x y z
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
test interp-36.3 {interp bgerror syntax} -setup {
diff --git a/tests/io.test b/tests/io.test
index 13ff38c..4257d51 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -2208,7 +2208,7 @@ test io-27.4 {FlushChannel, implicit flush when buffer fills} {
set l
} {0 60 72}
test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
- {unixOrPc} {
+ {unixOrWin} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf -buffersize 60 -eofchar {}
@@ -8102,7 +8102,7 @@ test io-57.2 {buffered data and file events, read} {fileevent} {
set result
} {1 readable 234567890 timer}
-test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} {
+test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
set out [open $path(script) w]
puts $out {
puts "normal message from pipe"
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 460299b..c3893bc 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -265,7 +265,7 @@ removeFile fconfigure.dummy
test iocmd-8.14 {fconfigure command} {
fconfigure stdin -buffers
} 4096
-test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrPc} -setup {
+test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup {
set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $srv -sockname] 2]
proc iocmdSRV {sock ip port} {close $sock}
@@ -367,18 +367,18 @@ test iocmd-10.5 {fblocked command} {
set path(test4) [makeFile {} test4]
set path(test5) [makeFile {} test5]
-test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
+test iocmd-11.1 {I/O to command pipelines} {unixOrWin unixExecs} {
set f [open $path(test4) w]
close $f
list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
} {1 {can't write input to command: standard input was redirected} NONE}
-test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
+test iocmd-11.2 {I/O to command pipelines} {unixOrWin unixExecs} {
list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} NONE}
-test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
+test iocmd-11.3 {I/O to command pipelines} {unixOrWin unixExecs} {
list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} NONE}
-test iocmd-11.4 {I/O to command pipelines} unixOrPc {
+test iocmd-11.4 {I/O to command pipelines} unixOrWin {
list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
} {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}
diff --git a/tests/pid.test b/tests/pid.test
index d21dbaa..af21f30 100644
--- a/tests/pid.test
+++ b/tests/pid.test
@@ -21,7 +21,7 @@ testConstraint pidDefined [llength [info commands pid]]
test pid-1.1 {pid command} pidDefined {
regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid]
} 1
-test pid-1.2 {pid command} -constraints {unixOrPc unixExecs pidDefined} -setup {
+test pid-1.2 {pid command} -constraints {unixOrWin unixExecs pidDefined} -setup {
set path(test1) [makeFile {} test1]
file delete $path(test1)
} -body {
diff --git a/tests/registry.test b/tests/registry.test
index 539ba2d..9691b3e 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -242,7 +242,7 @@ test registry-4.2 {GetKeyNames} {win reg} {
registry delete HKEY_CURRENT_USER\\TclFoobar
set result
} {baz}
-test registry-4.3 {GetKeyNames: remote key} {win reg nonPortable english} {
+test registry-4.3 {GetKeyNames: remote key} {win reg english} {
set hostname [info hostname]
registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar\\baz
set result [registry keys \\\\gaspode\\HKEY_CURRENT_USER\\TclFoobar]
@@ -535,7 +535,7 @@ test registry-7.3 {GetValueNames} -constraints {win reg} -setup {
} -cleanup {
registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {{} baz blat}
-test registry-7.4 {GetValueNames: remote key} -constraints {win reg nonPortable english} -body {
+test registry-7.4 {GetValueNames: remote key} -constraints {win reg english} -body {
set hostname [info hostname]
registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar baz blat
set result [registry values \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar]
@@ -571,7 +571,7 @@ test registry-7.7 {GetValueNames: names with spaces} -constraints {win reg} -set
registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {{baz bar} blat}
-test registry-8.1 {OpenSubKey} -constraints {win reg nonPortable english} \
+test registry-8.1 {OpenSubKey} -constraints {win reg english} \
-body {
# This test will only succeed if the current user does not have
# registry access on the specified machine.
@@ -657,7 +657,7 @@ test registry-11.2 {SetValue: modification} -constraints {win reg} \
set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat]
} -result {frob}
test registry-11.3 {SetValue: failure} \
- -constraints {win reg nonPortable english} \
+ -constraints {win reg english} \
-body {
# This test will only succeed if the current user does not have
# registry access on the specified machine.
diff --git a/tests/socket.test b/tests/socket.test
index 2fb8988..3544dd9 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -949,7 +949,7 @@ test socket-7.4 {testing socket specific options} {socket} {
set l ""
lappend l [expr {[lindex $x 2] == $listen}] [llength $x]
} {1 3}
-test socket-7.5 {testing socket specific options} {socket unixOrPc} {
+test socket-7.5 {testing socket specific options} {socket unixOrWin} {
set s [socket -server accept 0]
proc accept {s a p} {
global x
diff --git a/tests/tcltest.test b/tests/tcltest.test
index ca720ee..c856209 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -98,44 +98,44 @@ proc slave {msgVar args} {
}
return $code
}
-test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} {
+test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrWin} {
set result [slave msg test.tcl]
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
-test tcltest-2.1 {tcltest -verbose 'b'} {unixOrPc} {
+test tcltest-2.1 {tcltest -verbose 'b'} {unixOrWin} {
set result [slave msg test.tcl -verbose 'b']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
-test tcltest-2.2 {tcltest -verbose 'p'} {unixOrPc} {
+test tcltest-2.2 {tcltest -verbose 'p'} {unixOrWin} {
set result [slave msg test.tcl -verbose 'p']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 0 1}
-test tcltest-2.3 {tcltest -verbose 's'} {unixOrPc} {
+test tcltest-2.3 {tcltest -verbose 's'} {unixOrWin} {
set result [slave msg test.tcl -verbose 's']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 0 1 1}
-test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrPc} {
+test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrWin} {
set result [slave msg test.tcl -verbose 'ps']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 1 1}
-test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrPc} {
+test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrWin} {
set result [slave msg test.tcl -verbose 'psb']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 1 1}
-test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} {
+test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} {
set result [slave msg test.tcl -verbose "pass skip body"]
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
@@ -143,7 +143,7 @@ test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} {
} {0 1 1 1 1}
test tcltest-2.6 {tcltest -verbose 't'} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
set result [slave msg test.tcl -verbose 't']
list $result $msg
@@ -153,7 +153,7 @@ test tcltest-2.6 {tcltest -verbose 't'} {
}
test tcltest-2.6a {tcltest -verbose 'start'} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
set result [slave msg test.tcl -verbose start]
list $result $msg
@@ -176,7 +176,7 @@ test tcltest-2.7 {tcltest::verbose} {
}
test tcltest-2.8 {tcltest -verbose 'error'} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
set result [slave msg test.tcl -verbose error]
list $result $msg
@@ -185,22 +185,22 @@ test tcltest-2.8 {tcltest -verbose 'error'} {
-match regexp
}
# -match, [match]
-test tcltest-3.1 {tcltest -match 'a*'} {unixOrPc} {
+test tcltest-3.1 {tcltest -match 'a*'} {unixOrWin} {
set result [slave msg test.tcl -match a* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
-test tcltest-3.2 {tcltest -match 'b*'} {unixOrPc} {
+test tcltest-3.2 {tcltest -match 'b*'} {unixOrWin} {
set result [slave msg test.tcl -match b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 1 0 1}
-test tcltest-3.3 {tcltest -match 'c*'} {unixOrPc} {
+test tcltest-3.3 {tcltest -match 'c*'} {unixOrWin} {
set result [slave msg test.tcl -match c* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg]
} {0 0 0 1 1}
-test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrPc} {
+test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrWin} {
set result [slave msg test.tcl -match {a* b*} -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
@@ -220,27 +220,27 @@ test tcltest-3.5 {tcltest::match} {
}
# -skip, [skip]
-test tcltest-4.1 {tcltest -skip 'a*'} {unixOrPc} {
+test tcltest-4.1 {tcltest -skip 'a*'} {unixOrWin} {
set result [slave msg test.tcl -skip a* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
} {0 0 1 1 1}
-test tcltest-4.2 {tcltest -skip 'b*'} {unixOrPc} {
+test tcltest-4.2 {tcltest -skip 'b*'} {unixOrWin} {
set result [slave msg test.tcl -skip b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 0 1 1}
-test tcltest-4.3 {tcltest -skip 'c*'} {unixOrPc} {
+test tcltest-4.3 {tcltest -skip 'c*'} {unixOrWin} {
set result [slave msg test.tcl -skip c* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 0 1}
-test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrPc} {
+test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrWin} {
set result [slave msg test.tcl -skip {a* b*} -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 0 1 1}
-test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrPc} {
+test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrWin} {
set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
@@ -261,12 +261,12 @@ test tcltest-4.6 {tcltest::skip} {
# -constraints, -limitconstraints, [testConstraint],
# $constraintsSpecified, [limitConstraints]
-test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} {
+test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrWin} {
set result [slave msg test.tcl -constraints knownBug -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg]
} {0 1 1 1 1}
-test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrPc} {
+test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrWin} {
set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
@@ -355,7 +355,7 @@ set printerror [makeFile {
} printerror.tcl]
test tcltest-6.1 {tcltest -outfile, -errfile defaults} {
- -constraints unixOrPc
+ -constraints unixOrWin
-body {
slave msg $printerror
return $msg
@@ -363,21 +363,21 @@ test tcltest-6.1 {tcltest -outfile, -errfile defaults} {
-result {a test.*a really}
-match regexp
}
-test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc unixExecs} {
+test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrWin unixExecs} {
slave msg $printerror -outfile a.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" a.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
$result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {0 1 0 1 1 {}}
-test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc unixExecs} {
+test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrWin unixExecs} {
slave msg $printerror -errfile a.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" a.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
$result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {1 0 1 0 1 {}}
-test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrPc unixExecs} {
+test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrWin unixExecs} {
slave msg $printerror -outfile a.tmp -errfile b.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" b.tmp}]
@@ -464,25 +464,25 @@ test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} {
# Must use child processes to test -debug because it always writes
# messages to stdout, and we have no way to capture stdout of a
# slave interp
-test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrPc} {
+test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrWin} {
catch {exec [interpreter] test.tcl -debug 0} msg
regexp "Flags passed into tcltest" $msg
} {0}
-test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrPc} {
+test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrWin} {
catch {exec [interpreter] test.tcl -debug 1 -skip b*} msg
list [regexp userSpecifiedSkip $msg] \
[regexp "Flags passed into tcltest" $msg]
} {1 0}
-test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrPc} {
+test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrWin} {
catch {exec [interpreter] test.tcl -debug 1 -match b*} msg
list [regexp userSpecifiedNonMatch $msg] \
[regexp "Flags passed into tcltest" $msg]
} {1 0}
-test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrPc} {
+test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrWin} {
catch {exec [interpreter] test.tcl -debug 2} msg
list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
} {1 0}
-test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrPc} {
+test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrWin} {
catch {exec [interpreter] test.tcl -debug 3} msg
list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
} {1 1}
@@ -522,7 +522,7 @@ set normaldirectory [makeDirectory normaldirectory]
normalizePath normaldirectory
# -tmpdir, [temporaryDirectory]
-test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrPc -setup {
+test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup {
file delete -force thisdirectorydoesnotexist
} -body {
slave msg $a -tmpdir thisdirectorydoesnotexist
@@ -531,7 +531,7 @@ test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrPc -setup {
file delete -force thisdirectorydoesnotexist
} -result 1
test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
- -constraints unixOrPc
+ -constraints unixOrWin
-body {
slave msg $a -tmpdir $tdiaf
return $msg
@@ -572,7 +572,7 @@ testConstraint notFAT [expr {
}]
# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used
test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
- -constraints {unixOrPc notRoot notFAT}
+ -constraints {unixOrWin notRoot notFAT}
-body {
slave msg $a -tmpdir $notWriteableDir
return $msg
@@ -581,7 +581,7 @@ test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
-match glob
}
test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {
- -constraints unixOrPc
+ -constraints unixOrWin
-body {
slave msg $a -tmpdir $normaldirectory
# The join is necessary because the message can be split on multiple
@@ -624,7 +624,7 @@ test tcltest-8.6a {temporaryDirectory - test format 2} -setup {
cd [temporaryDirectory]
# -testdir, [testsDirectory]
test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
- -constraints unixOrPc
+ -constraints unixOrWin
-setup {
file delete -force thisdirectorydoesnotexist
}
@@ -636,7 +636,7 @@ test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
-result {*does not exist*}
}
test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {
- -constraints unixOrPc
+ -constraints unixOrWin
-body {
slave msg $a -testdir $tdiaf
return $msg
@@ -654,7 +654,7 @@ test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
-result {*not readable*}
}
test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {
- -constraints unixOrPc
+ -constraints unixOrWin
-body {
slave msg $a -testdir $normaldirectory
# The join is necessary because the message can be split on multiple
@@ -731,7 +731,7 @@ removeFile thisdirectoryisafile
removeDirectory normaldirectory
# -file, -notfile, [matchFiles], [skipFiles]
-test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup {
+test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup {
set old [testsDirectory]
testsDirectory [file dirname [info script]]
} -body {
@@ -741,7 +741,7 @@ test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup {
testsDirectory $old
} -match regexp -result {dstring\.test}
-test tcltest-9.2 {-file d*.tcl} -constraints {unixOrPc} -setup {
+test tcltest-9.2 {-file d*.tcl} -constraints {unixOrWin} -setup {
set old [testsDirectory]
testsDirectory [file dirname [info script]]
} -body {
@@ -806,23 +806,23 @@ set mc [makeFile {
} makecore.tcl]
cd [temporaryDirectory]
-test tcltest-10.1 {-preservecore 0} {unixOrPc} {
+test tcltest-10.1 {-preservecore 0} {unixOrWin} {
slave msg $mc -preservecore 0
file delete core
regexp "Core file produced" $msg
} {0}
-test tcltest-10.2 {-preservecore 1} {unixOrPc} {
+test tcltest-10.2 {-preservecore 1} {unixOrWin} {
slave msg $mc -preservecore 1
file delete core
regexp "Core file produced" $msg
} {1}
-test tcltest-10.3 {-preservecore 2} {unixOrPc} {
+test tcltest-10.3 {-preservecore 2} {unixOrWin} {
slave msg $mc -preservecore 2
file delete core
list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
[regexp "core-" $msg] [file delete core-makecore]
} {1 1 1 {}}
-test tcltest-10.4 {-preservecore 3} {unixOrPc} {
+test tcltest-10.4 {-preservecore 3} {unixOrWin} {
slave msg $mc -preservecore 3
file delete core
list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
@@ -853,13 +853,13 @@ set contents {
}
set loadfile [makeFile $contents load.tcl]
-test tcltest-12.1 {-load xxx} {unixOrPc} {
+test tcltest-12.1 {-load xxx} {unixOrWin} {
slave msg $loadfile -load xxx
return $msg
} {xxx}
# Using child process because of -debug usage.
-test tcltest-12.2 {-loadfile load.tcl} {unixOrPc} {
+test tcltest-12.2 {-loadfile load.tcl} {unixOrWin} {
catch {exec [interpreter] $loadfile -debug 2 -loadfile $loadfile} msg
list \
[regexp {tcltest} [join [list $msg] [split $msg \n]]] \
@@ -950,7 +950,7 @@ set allfile [makeFile {
cd [workingDirectory]
test tcltest-14.1 {-singleproc - single process} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
return $msg
@@ -960,7 +960,7 @@ test tcltest-14.1 {-singleproc - single process} {
}
test tcltest-14.2 {-singleproc - multiple process} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
return $msg
@@ -1024,7 +1024,7 @@ makeFile {
} all.tcl $dtd3
test tcltest-15.1 {basic directory walking} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
if {[slave msg \
[file join $dtd all.tcl] \
@@ -1038,7 +1038,7 @@ test tcltest-15.1 {basic directory walking} {
}
test tcltest-15.2 {-asidefromdir} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
if {[slave msg \
[file join $dtd all.tcl] \
@@ -1056,7 +1056,7 @@ Error: No test files remain after applying your match and skip patterns!$}
}
test tcltest-15.3 {-relateddir, non-existent dir} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
if {[slave msg \
[file join $dtd all.tcl] \
@@ -1071,7 +1071,7 @@ test tcltest-15.3 {-relateddir, non-existent dir} {
}
test tcltest-15.4 {-relateddir, subdir} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
if {[slave msg \
[file join $dtd all.tcl] \
@@ -1084,7 +1084,7 @@ test tcltest-15.4 {-relateddir, subdir} {
-result {Tests located in:.*dirtestdir2.[^23]}
}
test tcltest-15.5 {-relateddir, -asidefromdir} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
if {[slave msg \
[file join $dtd all.tcl] \
@@ -1173,7 +1173,7 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup {
cd [temporaryDirectory]
# PrintError
-test tcltest-20.1 {PrintError} {unixOrPc} {
+test tcltest-20.1 {PrintError} {unixOrWin} {
set result [slave msg $printerror]
list $result [regexp "Error: a really short string" $msg] \
[regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \
@@ -1409,7 +1409,7 @@ makeFile {
# Must use a child process because stdout/stderr parsing can't be
# duplicated in slave interp.
test tcltest-22.1 {runAllTests} {
- -constraints {unixOrPc}
+ -constraints {unixOrWin}
-body {
exec [interpreter] \
[file join $atd all.tcl] \
diff --git a/tests/tm.test b/tests/tm.test
index 3f93483..001b73e 100644
--- a/tests/tm.test
+++ b/tests/tm.test
@@ -6,7 +6,7 @@
# Copyright (c) 2004 by Donal K. Fellows.
# All rights reserved.
-package require Tcl 8.5
+package require Tcl 8.5-
if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
@@ -19,12 +19,12 @@ test tm-1.1 {tm: path command exists} {
test tm-1.2 {tm: path command syntax} -returnCodes error -body {
::tcl::tm::path foo
} -result {unknown or ambiguous subcommand "foo": must be add, list, or remove}
-test tm-1.3 {tm: path command syntax} -returnCodes error -body {
+test tm-1.3 {tm: path command syntax} {
::tcl::tm::path add
-} -result "wrong # args: should be \"::tcl::tm::path add path ...\""
-test tm-1.4 {tm: path command syntax} -returnCodes error -body {
+} {}
+test tm-1.4 {tm: path command syntax} {
::tcl::tm::path remove
-} -result "wrong # args: should be \"::tcl::tm::path remove path ...\""
+} {}
test tm-1.5 {tm: path command syntax} -returnCodes error -body {
::tcl::tm::path list foobar
} -result "wrong # args: should be \"::tcl::tm::path list\""
@@ -200,7 +200,7 @@ test tm-3.11 {tm: module path management, remove ignores unknown path} -setup {
proc genpaths {base} {
# Normalizing picks up drive letters on windows [Bug 1053568]
set base [file normalize $base]
- lassign [split [package present Tcl] .] major minor
+ regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
set results {}
set base [file join $base tcl$major]
lappend results [file join $base site-tcl]
generated by cgit v0.12 at 2025-12-25 17:09:58 (GMT)