diff options
| author | vincentdarley <vincentdarley> | 2001-07-31 19:12:05 (GMT) |
|---|---|---|
| committer | vincentdarley <vincentdarley> | 2001-07-31 19:12:05 (GMT) |
| commit | c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad (patch) | |
| tree | 1ec44ca71eb2e561881490f7766175daa65dc9eb /tests | |
| parent | 2414705dd748a119ffa0a2976ed71abc283aff11 (diff) | |
| download | tcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.zip tcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.tar.gz tcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.tar.bz2 | |
Changes from TIP#17 "Redo Tcl's filesystem"
The following files were impacted.
* doc/Access.3:
* doc/FileSystem.3:
* doc/OpenFileChnl.3:
* doc/file.n:
* doc/glob.n:
* generic/tcl.decls:
* generic/tcl.h:
* generic/tclCmdAH.c:
* generic/tclCmdIL.c:
* generic/tclCmdMZ.c:
* generic/tclDate.c:
* generic/tclDecls.h:
* generic/tclEncoding.c:
* generic/tclFCmd.c:
* generic/tclFileName.c:
* generic/tclGetDate.y:
* generic/tclIO.c:
* generic/tclIOCmd.c:
* generic/tclIOUtil.c:
* generic/tclInt.decls:
* generic/tclInt.h:
* generic/tclIntDecls.h:
* generic/tclLoad.c:
* generic/tclStubInit.c:
* generic/tclTest.c:
* generic/tclUtil.c:
* library/init.tcl:
* mac/tclMacFCmd.c:
* mac/tclMacFile.c:
* mac/tclMacInit.c:
* mac/tclMacPort.h:
* mac/tclMacResource.c:
* mac/tclMacTime.c:
* tests/cmdAH.test:
* tests/event.test:
* tests/fCmd.test:
* tests/fileName.test:
* tests/io.test:
* tests/ioCmd.test:
* tests/proc-old.test:
* tests/registry.test:
* tests/unixFCmd.test:
* tests/winDde.test:
* tests/winFCmd.test:
* unix/mkLinks:
* unix/tclUnixFCmd.c:
* unix/tclUnixFile.c:
* unix/tclUnixInit.c:
* unix/tclUnixPipe.c:
* win/tclWinFCmd.c:
* win/tclWinFile.c:
* win/tclWinInit.c:
* win/tclWinPipe.c
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/cmdAH.test | 89 | ||||
| -rw-r--r-- | tests/event.test | 3 | ||||
| -rw-r--r-- | tests/fCmd.test | 87 | ||||
| -rw-r--r-- | tests/fileName.test | 616 | ||||
| -rw-r--r-- | tests/io.test | 135 | ||||
| -rw-r--r-- | tests/ioCmd.test | 18 | ||||
| -rw-r--r-- | tests/proc-old.test | 18 | ||||
| -rw-r--r-- | tests/registry.test | 6 | ||||
| -rw-r--r-- | tests/unixFCmd.test | 6 | ||||
| -rw-r--r-- | tests/winDde.test | 14 | ||||
| -rw-r--r-- | tests/winFCmd.test | 4 |
11 files changed, 578 insertions, 418 deletions
diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 156e1fd..51bad09 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -10,13 +10,15 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdAH.test,v 1.13 2001/07/06 09:29:36 dkf Exp $ +# RCS: @(#) $Id: cmdAH.test,v 1.14 2001/07/31 19:12:07 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } +tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]] + global env set cmdAHwd [pwd] catch {set platform [testgetplatform]} @@ -166,11 +168,13 @@ test cmdAH-5.1 {Tcl_FileObjCmd} { } {1 {wrong # args: should be "file option ?arg ...?"}} test cmdAH-5.2 {Tcl_FileObjCmd} { list [catch {file x} msg] $msg -} {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +} {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}} test cmdAH-5.3 {Tcl_FileObjCmd} { list [catch {file exists} msg] $msg } {1 {wrong # args: should be "file exists name"}} - +test cmdAH-5.4 {Tcl_FileObjCmd} { + list [catch {file exists ""} msg] $msg +} {0 0} #volume @@ -1000,38 +1004,39 @@ testsetplatform $platform # readable +makeFile abcde gorp.file +makeDirectory dir.file + if {[info commands testchmod] == {}} { puts "This application hasn't been compiled with the \"testchmod\"" puts "command, so I can't test Tcl_FileObjCmd etc." } else { -makeFile abcde gorp.file -makeDirectory dir.file - -test cmdAH-16.1 {Tcl_FileObjCmd: readable} { +test cmdAH-16.1 {Tcl_FileObjCmd: readable} {testchmod} { list [catch {file readable a b} msg] $msg } {1 {wrong # args: should be "file readable name"}} testchmod 0444 gorp.file -test cmdAH-16.2 {Tcl_FileObjCmd: readable} { +test cmdAH-16.2 {Tcl_FileObjCmd: readable} {testchmod} { file readable gorp.file } 1 testchmod 0333 gorp.file -test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot} { +test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot testchmod} { file reada gorp.file } 0 # writable -test cmdAH-17.1 {Tcl_FileObjCmd: writable} { +test cmdAH-17.1 {Tcl_FileObjCmd: writable} {testchmod} { list [catch {file writable a b} msg] $msg } {1 {wrong # args: should be "file writable name"}} testchmod 0555 gorp.file -test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot} { +test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot testchmod} { file writable gorp.file } 0 testchmod 0222 gorp.file -test cmdAH-17.3 {Tcl_FileObjCmd: writable} { +test cmdAH-17.3 {Tcl_FileObjCmd: writable} {testchmod} { file writable gorp.file } 1 +} # executable @@ -1039,13 +1044,13 @@ file delete -force dir.file gorp.file file mkdir dir.file makeFile abcde gorp.file -test cmdAH-18.1 {Tcl_FileObjCmd: executable} { +test cmdAH-18.1 {Tcl_FileObjCmd: executable} {testchmod} { list [catch {file executable a b} msg] $msg } {1 {wrong # args: should be "file executable name"}} -test cmdAH-18.2 {Tcl_FileObjCmd: executable} { +test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod} { file executable gorp.file } 0 -test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly} { +test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} { # Only on unix will setting the execute bit on a regular file # cause that file to be executable. @@ -1053,14 +1058,14 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly} { file exe gorp.file } 1 -test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly} { +test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly testchmod} { # On mac, the only executable files are of type APPL. set x [file exe gorp.file] file attrib gorp.file -type APPL lappend x [file exe gorp.file] } {0 1} -test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly} { +test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly testchmod} { # On pc, must be a .exe, .com, etc. set x [file exe gorp.file] @@ -1069,7 +1074,7 @@ test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly} { file delete gorp.exe set x } {0 1} -test cmdAH-18.6 {Tcl_FileObjCmd: executable} { +test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} { # Directories are always executable. file exe dir.file @@ -1078,7 +1083,6 @@ test cmdAH-18.6 {Tcl_FileObjCmd: executable} { file delete -force dir.file file delete gorp.file file delete link.file -} # exists @@ -1243,6 +1247,39 @@ test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} { } {1 {can't set "x(dev)": variable isn't array} NONE} catch {unset stat} +# mkdir + +test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} { + catch {file delete -force a} + file mkdir a + set res [file isdirectory a] + file delete a + set res +} {1} +test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} { + catch {file delete -force a} + file mkdir a/b + set res [file isdirectory a/b] + file delete -force a + set res +} {1} +test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} { + catch {file delete -force a} + file mkdir a/b/c + set res [file isdirectory a/b/c] + file delete -force a + set res +} {1} +test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} { + catch {file delete -force a} + catch {file delete -force b} + file mkdir a/b b/a/c + set res [list [file isdirectory a/b] [file isdirectory b/a/c]] + file delete -force a + file delete -force b + set res +} {1 1} + # mtime set file [makeFile "data" touch.me] @@ -1467,25 +1504,25 @@ test cmdAH-29.5 {Tcl_FileObjCmd: type} { test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} { list [catch {file gorp x} msg] $msg -} {1 {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +} {1 {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}} test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} { list [catch {file ex x} msg] $msg -} {1 {ambiguous option "ex": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +} {1 {ambiguous option "ex": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}} test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} { list [catch {file is x} msg] $msg -} {1 {ambiguous option "is": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +} {1 {ambiguous option "is": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}} test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} { list [catch {file z x} msg] $msg -} {1 {bad option "z": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +} {1 {bad option "z": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}} test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} { list [catch {file read x} msg] $msg -} {1 {ambiguous option "read": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +} {1 {ambiguous option "read": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}} test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} { list [catch {file s x} msg] $msg -} {1 {ambiguous option "s": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +} {1 {ambiguous option "s": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}} test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} { list [catch {file t x} msg] $msg -} {1 {ambiguous option "t": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +} {1 {ambiguous option "t": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}} test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} { list [catch {file dirname ~woohgy} msg] $msg } {1 {user "woohgy" doesn't exist}} diff --git a/tests/event.test b/tests/event.test index 9d2e5fd..44d6610 100644 --- a/tests/event.test +++ b/tests/event.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: event.test,v 1.12 2001/06/27 15:34:16 dkf Exp $ +# RCS: @(#) $Id: event.test,v 1.13 2001/07/31 19:12:07 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -170,6 +170,7 @@ test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} { set x {} update idletasks rename bgerror {} + regsub -all [file join {} non_existent] $x "non_existent" x set x } {{{a simple error} {a simple error while executing diff --git a/tests/fCmd.test b/tests/fCmd.test index 2e8d383..c9e4ca0 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.9 2000/09/29 01:12:14 hobbs Exp $ +# RCS: @(#) $Id: fCmd.test,v 1.10 2001/07/31 19:12:07 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -18,21 +18,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } -if {[string compare testgetplatform [info commands testgetplatform]] != 0} { - puts "This application hasn't been compiled with the \"testgetplatform\"" - puts "command, therefore I am skipping all of these tests." - ::tcltest::cleanupTests - return -} - -set platform [testgetplatform] - -if {"[info commands testchmod]" != "testchmod"} { - puts "Skipping fCmd tests. This application does not seem to have the" - puts "testchmod command that is needed to run these tests." - ::tcltest::cleanupTests - return -} +tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]] +tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]] # Several tests require need to match results against the unix username set user {} @@ -74,7 +61,7 @@ proc openup {path} { testchmod 777 $path if {[file isdirectory $path]} { catch { - foreach p [glob [file join $path *]] { + foreach p [glob -directory $path *] { openup $p } } @@ -82,10 +69,15 @@ proc openup {path} { } proc cleanup {args} { - foreach p ". $args" { + if {$::tcl_platform(platform) == "macintosh"} { + set wd [list :] + } else { + set wd [list .] + } + foreach p [concat $wd $args] { set x "" catch { - set x [glob [file join $p tf*] [file join $p td*]] + set x [glob -directory $p tf* td*] } foreach file $x { if {[catch {file delete -force -- $file}]} { @@ -299,7 +291,7 @@ test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} { list $x [file exist td1] } {1 1} test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \ - {unixOnly notRoot} { + {unixOnly notRoot testchmod} { cleanup file mkdir td1/td2/td3 testchmod 000 td1/td2 @@ -309,8 +301,8 @@ test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \ } {1 {can't create directory "td1/td2/td3": permission denied}} test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} { cleanup - list [catch {file mkdir nonexistantvolume:} msg] $msg -} {1 {can't create directory "nonexistantvolume:": invalid argument}} + list [catch {file mkdir nonexistentvolume:} msg] $msg +} {1 {can't create directory "nonexistentvolume:": invalid argument}} test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} { cleanup set x [file exist td1] @@ -415,7 +407,7 @@ test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} { file rename tf1 tf2 glob tf* } {tf2} -test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot} { +test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot testchmod} { cleanup file mkdir td1 testchmod 000 td1 @@ -676,7 +668,7 @@ test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} { cleanup list [catch {file rename tf1 tf2} msg] $msg } {1 {error renaming "tf1": no such file or directory}} -test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot} { +test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod} { cleanup createfile tf1 createfile tf2 @@ -685,7 +677,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot} { file rename tf2 tf4 list [lsort [glob tf*]] [file writable tf3] [file writable tf4] } {{tf3 tf4} 1 0} -test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot} { +test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} { cleanup file mkdir td1 td2 testchmod 555 td2 @@ -693,7 +685,7 @@ test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot} { file rename td2 td4 list [lsort [glob td*]] [file writable td3] [file writable td4] } {{td3 td4} 1 0} -test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot} { +test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} { cleanup createfile tf1 tf1 createfile tf2 tf2 @@ -702,7 +694,7 @@ test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot} { file rename -force tf2 tf2 list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2] } {tf1 tf2 1 0} -test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc} { +test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} { cleanup file mkdir td1 file mkdir td2 @@ -711,7 +703,7 @@ test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc} { file rename -force td2 . list [lsort [glob td*]] [file writable td1] [file writable td2] } {{td1 td2} 1 0} -test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot} { +test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} { cleanup createfile tf1 createfile tf2 @@ -734,7 +726,7 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot} { file rename -force tfs4 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} {notRoot} { +test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod} { # Under unix, you can rename a read-only directory, but you can't # move it into another directory. @@ -772,7 +764,7 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot} { list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \ [file writable [file join tdd2 tds2]] $w3 $w4 } [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}] -test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot} { +test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot testchmod} { cleanup file mkdir tds1 file mkdir tds2 @@ -790,7 +782,7 @@ test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot} { } list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2 } [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}] -test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot} { +test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} { cleanup createfile tf1 createfile tf2 @@ -798,10 +790,10 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot} testchmod 444 tf2 file rename tf1 [file join td1 tf3] file rename tf2 [file join td1 tf4] - list [catch {glob tf*}] [lsort [glob [file join td1 t*]]] \ + list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] } [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] -test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot} { +test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} { cleanup file mkdir td1 file mkdir td2 @@ -816,10 +808,10 @@ test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot} { } else { set w4 0 } - list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \ + list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] $w4 } [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}] -test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot} { +test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot testchmod} { cleanup file mkdir [file join td1 td2] [file join td2 td1] if {$tcl_platform(platform) != "macintosh"} { @@ -863,7 +855,7 @@ test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} { cleanup list [catch {file copy tf1 tf2} msg] $msg } {1 {error copying "tf1": no such file or directory}} -test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot} { +test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} { cleanup createfile tf1 tf1 createfile tf2 tf2 @@ -872,22 +864,22 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot} { file copy tf2 tf4 list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4] } {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} -test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc} { +test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc testchmod} { cleanup file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] testchmod 555 td2 file copy td1 td3 file copy td2 td4 - set msg [list [lsort [glob td*]] [glob [file join td3 t*]] \ - [glob [file join td4 t*]] [file writable td3] [file writable td4]] + set msg [list [lsort [glob td*]] [glob -directory td3 t*] \ + [glob -directory td4 t*] [file writable td3] [file writable td4]] if {$tcl_platform(platform) != "macintosh"} { testchmod 755 td2 testchmod 755 td4 } set msg } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}] -test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot} { +test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} { cleanup createfile tf1 createfile tf2 @@ -910,7 +902,7 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot} { file copy -force tfs4 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} { +test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} { cleanup file mkdir td1 file mkdir [file join td2 td1] @@ -936,7 +928,7 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot} { 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} { + {notRoot unixOrPc testchmod} { cleanup file mkdir tds1 file mkdir tds2 @@ -947,7 +939,7 @@ test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \ set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg] list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2] } [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}] -test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot} { +test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} { cleanup createfile tf1 createfile tf2 @@ -955,11 +947,11 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot} testchmod 444 tf2 file copy tf1 [file join td1 tf3] file copy tf2 [file join td1 tf4] - list [lsort [glob tf*]] [lsort [glob [file join td1 t*]]] \ + list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] } [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \ - {notRoot unixOrPc} { + {notRoot unixOrPc testchmod} { cleanup file mkdir td1 file mkdir td2 @@ -967,7 +959,7 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \ testchmod 555 td2 file copy td1 [file join td3 td3] file copy td2 [file join td3 td4] - list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \ + list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] [file writable [file join td3 td4]] } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}] test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \ @@ -2111,7 +2103,8 @@ test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly notRoot} set result } {1} -test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} { +test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {testsetplatform} { + set platform [testgetplatform] testsetplatform unix list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform] } {1 {user "_totally_bogus_user" doesn't exist} {}} diff --git a/tests/fileName.test b/tests/fileName.test index eb0b502..318b3ab 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -10,885 +10,883 @@ # 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.10 2001/05/15 21:23:53 hobbs Exp $ +# RCS: @(#) $Id: fileName.test,v 1.11 2001/07/31 19:12:07 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } -if {[info commands testsetplatform] == {}} { - puts "This application hasn't been compiled with the \"testsetplatform\"" - puts "command, so I can't test the filename conversion procedures." - ::tcltest::cleanupTests - return -} +tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]] +tcltest::testConstraint testtranslatefilename [string equal testtranslatefilename [info commands testtranslatefilename]] global env -set platform [testgetplatform] +if {[tcltest::testConstraint testsetplatform]} { + set platform [testgetplatform] +} -test filename-1.1 {Tcl_GetPathType: unix} { +test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype / } absolute -test filename-1.2 {Tcl_GetPathType: unix} { +test filename-1.2 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype /foo } absolute -test filename-1.3 {Tcl_GetPathType: unix} { +test filename-1.3 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype foo } relative -test filename-1.4 {Tcl_GetPathType: unix} { +test filename-1.4 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype c:/foo } relative -test filename-1.5 {Tcl_GetPathType: unix} { +test filename-1.5 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~ } absolute -test filename-1.6 {Tcl_GetPathType: unix} { +test filename-1.6 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~/foo } absolute -test filename-1.7 {Tcl_GetPathType: unix} { +test filename-1.7 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~foo } absolute -test filename-1.8 {Tcl_GetPathType: unix} { +test filename-1.8 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ./~foo } relative -test filename-2.1 {Tcl_GetPathType: mac, denerate names} { +test filename-2.1 {Tcl_GetPathType: mac, denerate names} {testsetplatform} { testsetplatform mac file pathtype / } relative -test filename-2.2 {Tcl_GetPathType: mac, denerate names} { +test filename-2.2 {Tcl_GetPathType: mac, denerate names} {testsetplatform} { testsetplatform mac file pathtype /. } relative -test filename-2.3 {Tcl_GetPathType: mac, denerate names} { +test filename-2.3 {Tcl_GetPathType: mac, denerate names} {testsetplatform} { testsetplatform mac file pathtype /.. } relative -test filename-2.4 {Tcl_GetPathType: mac, denerate names} { +test filename-2.4 {Tcl_GetPathType: mac, denerate names} {testsetplatform} { testsetplatform mac file pathtype //.// } relative -test filename-2.5 {Tcl_GetPathType: mac, denerate names} { +test filename-2.5 {Tcl_GetPathType: mac, denerate names} {testsetplatform} { testsetplatform mac file pathtype //.//../. } relative -test filename-2.6 {Tcl_GetPathType: mac, tilde names} { +test filename-2.6 {Tcl_GetPathType: mac, tilde names} {testsetplatform} { testsetplatform mac file pathtype ~ } absolute -test filename-2.7 {Tcl_GetPathType: mac, tilde names} { +test filename-2.7 {Tcl_GetPathType: mac, tilde names} {testsetplatform} { testsetplatform mac file pathtype ~: } absolute -test filename-2.8 {Tcl_GetPathType: mac, tilde names} { +test filename-2.8 {Tcl_GetPathType: mac, tilde names} {testsetplatform} { testsetplatform mac file pathtype ~:foo } absolute -test filename-2.9 {Tcl_GetPathType: mac, tilde names} { +test filename-2.9 {Tcl_GetPathType: mac, tilde names} {testsetplatform} { testsetplatform mac file pathtype ~/ } absolute -test filename-2.10 {Tcl_GetPathType: mac, tilde names} { +test filename-2.10 {Tcl_GetPathType: mac, tilde names} {testsetplatform} { testsetplatform mac file pathtype ~/foo } absolute -test filename-2.11 {Tcl_GetPathType: mac, unix-style names} { +test filename-2.11 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} { testsetplatform mac file pathtype /foo } absolute -test filename-2.12 {Tcl_GetPathType: mac, unix-style names} { +test filename-2.12 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} { testsetplatform mac file pathtype /./foo } absolute -test filename-2.13 {Tcl_GetPathType: mac, unix-style names} { +test filename-2.13 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} { testsetplatform mac file pathtype /..//./foo } absolute -test filename-2.14 {Tcl_GetPathType: mac, unix-style names} { +test filename-2.14 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} { testsetplatform mac file pathtype /foo/bar } absolute -test filename-2.15 {Tcl_GetPathType: mac, unix-style names} { +test filename-2.15 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} { testsetplatform mac file pathtype foo/bar } relative -test filename-2.16 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.16 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype : } relative -test filename-2.17 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.17 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype :foo } relative -test filename-2.18 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.18 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype foo: } absolute -test filename-2.19 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.19 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype foo:bar } absolute -test filename-2.20 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.20 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype :foo:bar } relative -test filename-2.21 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.21 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype ::foo:bar } relative -test filename-2.22 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.22 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype ~foo } absolute -test filename-2.23 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.23 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype :~foo } relative -test filename-2.24 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.24 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype ~foo: } absolute -test filename-2.25 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.25 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype foo/bar: } absolute -test filename-2.26 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.26 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype /foo: } absolute -test filename-2.27 {Tcl_GetPathType: mac, mac-style names} { +test filename-2.27 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype foo } relative -test filename-3.1 {Tcl_GetPathType: windows} { +test filename-3.1 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype / } volumerelative -test filename-3.2 {Tcl_GetPathType: windows} { +test filename-3.2 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype \\ } volumerelative -test filename-3.3 {Tcl_GetPathType: windows} { +test filename-3.3 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype /foo } volumerelative -test filename-3.4 {Tcl_GetPathType: windows} { +test filename-3.4 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype \\foo } volumerelative -test filename-3.5 {Tcl_GetPathType: windows} { +test filename-3.5 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:/ } absolute -test filename-3.6 {Tcl_GetPathType: windows} { +test filename-3.6 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:\\ } absolute -test filename-3.7 {Tcl_GetPathType: windows} { +test filename-3.7 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:/foo } absolute -test filename-3.8 {Tcl_GetPathType: windows} { +test filename-3.8 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:\\foo } absolute -test filename-3.9 {Tcl_GetPathType: windows} { +test filename-3.9 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c: } volumerelative -test filename-3.10 {Tcl_GetPathType: windows} { +test filename-3.10 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:foo } volumerelative -test filename-3.11 {Tcl_GetPathType: windows} { +test filename-3.11 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype foo } relative -test filename-3.12 {Tcl_GetPathType: windows} { +test filename-3.12 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype //foo/bar } absolute -test filename-3.13 {Tcl_GetPathType: windows} { +test filename-3.13 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~foo } absolute -test filename-3.14 {Tcl_GetPathType: windows} { +test filename-3.14 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~ } absolute -test filename-3.15 {Tcl_GetPathType: windows} { +test filename-3.15 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~/foo } absolute -test filename-3.16 {Tcl_GetPathType: windows} { +test filename-3.16 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ./~foo } relative -test filename-4.1 {Tcl_SplitPath: unix} { +test filename-4.1 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split / } {/} -test filename-4.2 {Tcl_SplitPath: unix} { +test filename-4.2 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo } {/ foo} -test filename-4.3 {Tcl_SplitPath: unix} { +test filename-4.3 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo/bar } {/ foo bar} -test filename-4.4 {Tcl_SplitPath: unix} { +test filename-4.4 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo/bar/baz } {/ foo bar baz} -test filename-4.5 {Tcl_SplitPath: unix} { +test filename-4.5 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo/bar } {foo bar} -test filename-4.6 {Tcl_SplitPath: unix} { +test filename-4.6 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ./foo/bar } {. foo bar} -test filename-4.7 {Tcl_SplitPath: unix} { +test filename-4.7 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo/../././foo/bar } {/ foo .. . . foo bar} -test filename-4.8 {Tcl_SplitPath: unix} { +test filename-4.8 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ../foo/bar } {.. foo bar} -test filename-4.9 {Tcl_SplitPath: unix} { +test filename-4.9 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split {} } {} -test filename-4.10 {Tcl_SplitPath: unix} { +test filename-4.10 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split . } {.} -test filename-4.11 {Tcl_SplitPath: unix} { +test filename-4.11 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ../ } {..} -test filename-4.12 {Tcl_SplitPath: unix} { +test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ../.. } {.. ..} -test filename-4.13 {Tcl_SplitPath: unix} { +test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split //foo } {/ foo} -test filename-4.14 {Tcl_SplitPath: unix} { +test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo//bar } {foo bar} -test filename-4.15 {Tcl_SplitPath: unix} { +test filename-4.15 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo } {~foo} -test filename-4.16 {Tcl_SplitPath: unix} { +test filename-4.16 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo/~bar } {~foo ./~bar} -test filename-4.17 {Tcl_SplitPath: unix} { +test filename-4.17 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo/~bar/~baz } {~foo ./~bar ./~baz} -test filename-4.18 {Tcl_SplitPath: unix} { +test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo/bar~/baz } {foo bar~ baz} -test filename-5.1 {Tcl_SplitPath: mac} { +test filename-5.1 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:b } {a: b} -test filename-5.2 {Tcl_SplitPath: mac} { +test filename-5.2 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:b:c } {a: b c} -test filename-5.3 {Tcl_SplitPath: mac} { +test filename-5.3 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:b:c: } {a: b c} -test filename-5.4 {Tcl_SplitPath: mac} { +test filename-5.4 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a: } {a:} -test filename-5.5 {Tcl_SplitPath: mac} { +test filename-5.5 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:: } {a: ::} -test filename-5.6 {Tcl_SplitPath: mac} { +test filename-5.6 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a::: } {a: :: ::} -test filename-5.7 {Tcl_SplitPath: mac} { +test filename-5.7 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split :a } {a} -test filename-5.8 {Tcl_SplitPath: mac} { +test filename-5.8 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split :a:: } {a ::} -test filename-5.9 {Tcl_SplitPath: mac} { +test filename-5.9 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split : } {:} -test filename-5.10 {Tcl_SplitPath: mac} { +test filename-5.10 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split :: } {::} -test filename-5.11 {Tcl_SplitPath: mac} { +test filename-5.11 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ::: } {:: ::} -test filename-5.12 {Tcl_SplitPath: mac} { +test filename-5.12 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:::b } {a: :: :: b} -test filename-5.13 {Tcl_SplitPath: mac} { +test filename-5.13 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /a:b } {/a: b} -test filename-5.14 {Tcl_SplitPath: mac} { +test filename-5.14 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~: } {~:} -test filename-5.15 {Tcl_SplitPath: mac} { +test filename-5.15 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~/: } {~/:} -test filename-5.16 {Tcl_SplitPath: mac} { +test filename-5.16 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~:foo } {~: foo} -test filename-5.17 {Tcl_SplitPath: mac} { +test filename-5.17 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~/foo } {~: foo} -test filename-5.18 {Tcl_SplitPath: mac} { +test filename-5.18 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~foo: } {~foo:} -test filename-5.19 {Tcl_SplitPath: mac} { +test filename-5.19 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:~foo } {a: :~foo} -test filename-5.20 {Tcl_SplitPath: mac} { +test filename-5.20 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split / } {:/} -test filename-5.21 {Tcl_SplitPath: mac} { +test filename-5.21 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:b/c } {a: :b/c} -test filename-5.22 {Tcl_SplitPath: mac} { +test filename-5.22 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /foo } {foo:} -test filename-5.23 {Tcl_SplitPath: mac} { +test filename-5.23 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /a/b } {a: b} -test filename-5.24 {Tcl_SplitPath: mac} { +test filename-5.24 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /a/b/foo } {a: b foo} -test filename-5.25 {Tcl_SplitPath: mac} { +test filename-5.25 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a/b } {a b} -test filename-5.26 {Tcl_SplitPath: mac} { +test filename-5.26 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ./foo/bar } {: foo bar} -test filename-5.27 {Tcl_SplitPath: mac} { +test filename-5.27 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ../foo/bar } {:: foo bar} -test filename-5.28 {Tcl_SplitPath: mac} { +test filename-5.28 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split {} } {} -test filename-5.29 {Tcl_SplitPath: mac} { +test filename-5.29 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split . } {:} -test filename-5.30 {Tcl_SplitPath: mac} { +test filename-5.30 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ././ } {: :} -test filename-5.31 {Tcl_SplitPath: mac} { +test filename-5.31 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ././. } {: : :} -test filename-5.32 {Tcl_SplitPath: mac} { +test filename-5.32 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ../ } {::} -test filename-5.33 {Tcl_SplitPath: mac} { +test filename-5.33 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split .. } {::} -test filename-5.34 {Tcl_SplitPath: mac} { +test filename-5.34 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ../.. } {:: ::} -test filename-5.35 {Tcl_SplitPath: mac} { +test filename-5.35 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split //foo } {foo:} -test filename-5.36 {Tcl_SplitPath: mac} { +test filename-5.36 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split foo//bar } {foo bar} -test filename-5.37 {Tcl_SplitPath: mac} { +test filename-5.37 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~foo } {~foo:} -test filename-5.38 {Tcl_SplitPath: mac} { +test filename-5.38 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~ } {~:} -test filename-5.39 {Tcl_SplitPath: mac} { +test filename-5.39 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split foo } {foo} -test filename-5.40 {Tcl_SplitPath: mac} { +test filename-5.40 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~/ } {~:} -test filename-5.41 {Tcl_SplitPath: mac} { +test filename-5.41 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~foo/~bar } {~foo: :~bar} -test filename-5.42 {Tcl_SplitPath: mac} { +test filename-5.42 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~foo/~bar/~baz } {~foo: :~bar :~baz} -test filename-5.43 {Tcl_SplitPath: mac} { +test filename-5.43 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split foo/bar~/baz } {foo bar~ baz} -test filename-5.44 {Tcl_SplitPath: mac} { +test filename-5.44 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a/../b } {a :: b} -test filename-5.45 {Tcl_SplitPath: mac} { +test filename-5.45 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a/../../b } {a :: :: b} -test filename-5.46 {Tcl_SplitPath: mac} { +test filename-5.46 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a/.././../b } {a :: : :: b} -test filename-5.47 {Tcl_SplitPath: mac} { +test filename-5.47 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /../bar } {bar:} -test filename-5.48 {Tcl_SplitPath: mac} { +test filename-5.48 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /./bar } {bar:} -test filename-5.49 {Tcl_SplitPath: mac} { +test filename-5.49 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split //.//.././bar } {bar:} -test filename-5.50 {Tcl_SplitPath: mac} { +test filename-5.50 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /.. } {:/..} -test filename-5.51 {Tcl_SplitPath: mac} { +test filename-5.51 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split //.//.././ } {://.//.././} -test filename-6.1 {Tcl_SplitPath: win} { +test filename-6.1 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split / } {/} -test filename-6.2 {Tcl_SplitPath: win} { +test filename-6.2 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo } {/ foo} -test filename-6.3 {Tcl_SplitPath: win} { +test filename-6.3 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo/bar } {/ foo bar} -test filename-6.4 {Tcl_SplitPath: win} { +test filename-6.4 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo/bar/baz } {/ foo bar baz} -test filename-6.5 {Tcl_SplitPath: win} { +test filename-6.5 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo/bar } {foo bar} -test filename-6.6 {Tcl_SplitPath: win} { +test filename-6.6 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ./foo/bar } {. foo bar} -test filename-6.7 {Tcl_SplitPath: win} { +test filename-6.7 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo/../././foo/bar } {/ foo .. . . foo bar} -test filename-6.8 {Tcl_SplitPath: win} { +test filename-6.8 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ../foo/bar } {.. foo bar} -test filename-6.9 {Tcl_SplitPath: win} { +test filename-6.9 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split {} } {} -test filename-6.10 {Tcl_SplitPath: win} { +test filename-6.10 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split . } {.} -test filename-6.11 {Tcl_SplitPath: win} { +test filename-6.11 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ../ } {..} -test filename-6.12 {Tcl_SplitPath: win} { +test filename-6.12 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ../.. } {.. ..} -test filename-6.13 {Tcl_SplitPath: win} { +test filename-6.13 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split //foo } {/ foo} -test filename-6.14 {Tcl_SplitPath: win} { +test filename-6.14 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo//bar } {foo bar} -test filename-6.15 {Tcl_SplitPath: win} { +test filename-6.15 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /\\/foo//bar } {//foo/bar} -test filename-6.16 {Tcl_SplitPath: win} { +test filename-6.16 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /\\/foo//bar } {//foo/bar} -test filename-6.17 {Tcl_SplitPath: win} { +test filename-6.17 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /\\/foo//bar } {//foo/bar} -test filename-6.18 {Tcl_SplitPath: win} { +test filename-6.18 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split \\\\foo\\bar } {//foo/bar} -test filename-6.19 {Tcl_SplitPath: win} { +test filename-6.19 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split \\\\foo\\bar/baz } {//foo/bar baz} -test filename-6.20 {Tcl_SplitPath: win} { +test filename-6.20 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:/foo } {c:/ foo} -test filename-6.21 {Tcl_SplitPath: win} { +test filename-6.21 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:foo } {c: foo} -test filename-6.22 {Tcl_SplitPath: win} { +test filename-6.22 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c: } {c:} -test filename-6.23 {Tcl_SplitPath: win} { +test filename-6.23 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:\\ } {c:/} -test filename-6.24 {Tcl_SplitPath: win} { +test filename-6.24 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:/ } {c:/} -test filename-6.25 {Tcl_SplitPath: win} { +test filename-6.25 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:/./.. } {c:/ . ..} -test filename-6.26 {Tcl_SplitPath: win} { +test filename-6.26 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo } {~foo} -test filename-6.27 {Tcl_SplitPath: win} { +test filename-6.27 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo/~bar } {~foo ./~bar} -test filename-6.28 {Tcl_SplitPath: win} { +test filename-6.28 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo/~bar/~baz } {~foo ./~bar ./~baz} -test filename-6.29 {Tcl_SplitPath: win} { +test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo/bar~/baz } {foo bar~ baz} -test filename-6.30 {Tcl_SplitPath: win} { +test filename-6.30 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:~foo } {c: ./~foo} -test filename-7.1 {Tcl_JoinPath: unix} { +test filename-7.1 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join / a } {/a} -test filename-7.2 {Tcl_JoinPath: unix} { +test filename-7.2 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a b } {a/b} -test filename-7.3 {Tcl_JoinPath: unix} { +test filename-7.3 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a c /b d } {/b/d} -test filename-7.4 {Tcl_JoinPath: unix} { +test filename-7.4 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join / } {/} -test filename-7.5 {Tcl_JoinPath: unix} { +test filename-7.5 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a } {a} -test filename-7.6 {Tcl_JoinPath: unix} { +test filename-7.6 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join {} } {} -test filename-7.7 {Tcl_JoinPath: unix} { +test filename-7.7 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a/ b } {/a/b} -test filename-7.8 {Tcl_JoinPath: unix} { +test filename-7.8 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a// b } {/a/b} -test filename-7.9 {Tcl_JoinPath: unix} { +test filename-7.9 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a/./../. b } {/a/./.././b} -test filename-7.10 {Tcl_JoinPath: unix} { +test filename-7.10 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ~ a } {~/a} -test filename-7.11 {Tcl_JoinPath: unix} { +test filename-7.11 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ~a ~b } {~b} -test filename-7.12 {Tcl_JoinPath: unix} { +test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a b } {./~a/b} -test filename-7.13 {Tcl_JoinPath: unix} { +test filename-7.13 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a ~b } {~b} -test filename-7.14 {Tcl_JoinPath: unix} { +test filename-7.14 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a ./~b } {./~a/~b} -test filename-7.15 {Tcl_JoinPath: unix} { +test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a . b } {a/./b} -test filename-7.16 {Tcl_JoinPath: unix} { +test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a . ./~b } {a/./~b} -test filename-7.17 {Tcl_JoinPath: unix} { +test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join //a b } {/a/b} -test filename-7.18 {Tcl_JoinPath: unix} { +test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /// a b } {/a/b} -test filename-8.1 {Tcl_JoinPath: mac} { +test filename-8.1 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a b } {:a:b} -test filename-8.2 {Tcl_JoinPath: mac} { +test filename-8.2 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join :a b } {:a:b} -test filename-8.3 {Tcl_JoinPath: mac} { +test filename-8.3 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a b: } {b:} -test filename-8.4 {Tcl_JoinPath: mac} { +test filename-8.4 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a: :b } {a:b} -test filename-8.5 {Tcl_JoinPath: mac} { +test filename-8.5 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a: :b: } {a:b} -test filename-8.6 {Tcl_JoinPath: mac} { +test filename-8.6 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a :: b } {:a::b} -test filename-8.7 {Tcl_JoinPath: mac} { +test filename-8.7 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a :: :: b } {:a:::b} -test filename-8.8 {Tcl_JoinPath: mac} { +test filename-8.8 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a ::: b } {:a:::b} -test filename-8.9 {Tcl_JoinPath: mac} { +test filename-8.9 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a: b: } {b:} -test filename-8.10 {Tcl_JoinPath: mac} { +test filename-8.10 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join /a/b } {a:b} -test filename-8.11 {Tcl_JoinPath: mac} { +test filename-8.11 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join /a/b c/d } {a:b:c:d} -test filename-8.12 {Tcl_JoinPath: mac} { +test filename-8.12 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join /a/b :c:d } {a:b:c:d} -test filename-8.13 {Tcl_JoinPath: mac} { +test filename-8.13 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join ~ foo } {~:foo} -test filename-8.14 {Tcl_JoinPath: mac} { +test filename-8.14 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join :: :: } {:::} -test filename-8.15 {Tcl_JoinPath: mac} { +test filename-8.15 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a: :: } {a::} -test filename-8.16 {Tcl_JoinPath: mac} { +test filename-8.16 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a {} b } {:a:b} -test filename-8.17 {Tcl_JoinPath: mac} { +test filename-8.17 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a::: b } {a:::b} -test filename-8.18 {Tcl_JoinPath: mac} { +test filename-8.18 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a : : : } {:a} -test filename-8.19 {Tcl_JoinPath: mac} { +test filename-8.19 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join : } {:} -test filename-8.20 {Tcl_JoinPath: mac} { +test filename-8.20 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join : a } {:a} -test filename-8.21 {Tcl_JoinPath: mac} { +test filename-8.21 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a: :b/c } {a:b/c} -test filename-8.22 {Tcl_JoinPath: mac} { +test filename-8.22 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join :a :b/c } {:a:b/c} -test filename-9.1 {Tcl_JoinPath: win} { +test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join a b } {a/b} -test filename-9.2 {Tcl_JoinPath: win} { +test filename-9.2 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join /a b } {/a/b} -test filename-9.3 {Tcl_JoinPath: win} { +test filename-9.3 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join /a /b } {/b} -test filename-9.4 {Tcl_JoinPath: win} { +test filename-9.4 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join c: foo } {c:foo} -test filename-9.5 {Tcl_JoinPath: win} { +test filename-9.5 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join c:/ foo } {c:/foo} -test filename-9.6 {Tcl_JoinPath: win} { +test filename-9.6 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join c:\\bar foo } {c:/bar/foo} -test filename-9.7 {Tcl_JoinPath: win} { +test filename-9.7 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join /foo c:bar } {c:bar} -test filename-9.8 {Tcl_JoinPath: win} { +test filename-9.8 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ///host//share dir } {//host/share/dir} -test filename-9.9 {Tcl_JoinPath: win} { +test filename-9.9 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~ foo } {~/foo} -test filename-9.10 {Tcl_JoinPath: win} { +test filename-9.10 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~/~foo } {~/~foo} -test filename-9.11 {Tcl_JoinPath: win} { +test filename-9.11 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~ ./~foo } {~/~foo} -test filename-9.12 {Tcl_JoinPath: win} { +test filename-9.12 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join / ~foo } {~foo} -test filename-9.13 {Tcl_JoinPath: win} { +test filename-9.13 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ./a/ b c } {./a/b/c} -test filename-9.14 {Tcl_JoinPath: win} { +test filename-9.14 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ./~a/ b c } {./~a/b/c} -test filename-9.15 {Tcl_JoinPath: win} { +test filename-9.15 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join // host share path } {/host/share/path} -test filename-9.16 {Tcl_JoinPath: win} { +test filename-9.16 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo . bar } {foo/./bar} -test filename-9.17 {Tcl_JoinPath: win} { +test filename-9.17 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo .. bar } {foo/../bar} -test filename-9.18 {Tcl_JoinPath: win} { +test filename-9.18 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo/./bar } {foo/./bar} -test filename-10.1 {Tcl_TranslateFileName} { +test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform unix list [catch {testtranslatefilename foo} msg] $msg } {0 foo} -test filename-10.2 {Tcl_TranslateFileName} { +test filename-10.2 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform windows list [catch {testtranslatefilename {c:/foo}} msg] $msg } {0 {c:\foo}} -test filename-10.3 {Tcl_TranslateFileName} { +test filename-10.3 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform windows list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg } {0 {c:\foo}} -test filename-10.4 {Tcl_TranslateFileName} { +test filename-10.4 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform mac list [catch {testtranslatefilename foo} msg] $msg } {0 :foo} -test filename-10.5 {Tcl_TranslateFileName} { +test filename-10.5 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform mac list [catch {testtranslatefilename :~foo} msg] $msg } {0 :~foo} -test filename-10.6 {Tcl_TranslateFileName} { +test filename-10.6 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "/home/test" @@ -897,7 +895,7 @@ test filename-10.6 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 /home/test/foo} -test filename-10.7 {Tcl_TranslateFileName} { +test filename-10.7 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) unset env(HOME) @@ -906,7 +904,7 @@ test filename-10.7 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {1 {couldn't find HOME environment variable to expand path}} -test filename-10.8 {Tcl_TranslateFileName} { +test filename-10.8 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "/home/test" @@ -915,7 +913,7 @@ test filename-10.8 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 /home/test} -test filename-10.9 {Tcl_TranslateFileName} { +test filename-10.9 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "/home/test/" @@ -924,7 +922,7 @@ test filename-10.9 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 /home/test} -test filename-10.10 {Tcl_TranslateFileName} { +test filename-10.10 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "/home/test/" @@ -933,7 +931,7 @@ test filename-10.10 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 /home/test/foo} -test filename-10.11 {Tcl_TranslateFileName} { +test filename-10.11 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:" @@ -942,7 +940,7 @@ test filename-10.11 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 Root:foo} -test filename-10.12 {Tcl_TranslateFileName} { +test filename-10.12 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:home" @@ -951,7 +949,7 @@ test filename-10.12 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 Root:home:foo} -test filename-10.13 {Tcl_TranslateFileName} { +test filename-10.13 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:home" @@ -960,7 +958,7 @@ test filename-10.13 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 Root:home::foo} -test filename-10.14 {Tcl_TranslateFileName} { +test filename-10.14 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:home" @@ -969,7 +967,7 @@ test filename-10.14 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 Root:home} -test filename-10.15 {Tcl_TranslateFileName} { +test filename-10.15 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:home:" @@ -978,7 +976,7 @@ test filename-10.15 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 Root:home::foo} -test filename-10.16 {Tcl_TranslateFileName} { +test filename-10.16 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:home::" @@ -987,7 +985,7 @@ test filename-10.16 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 Root:home:::foo} -test filename-10.17 {Tcl_TranslateFileName} { +test filename-10.17 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "\\home\\" @@ -996,7 +994,7 @@ test filename-10.17 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 {\home\foo}} -test filename-10.18 {Tcl_TranslateFileName} { +test filename-10.18 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "\\home\\" @@ -1005,7 +1003,7 @@ test filename-10.18 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 {\home\foo\bar}} -test filename-10.19 {Tcl_TranslateFileName} { +test filename-10.19 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "c:" @@ -1014,10 +1012,10 @@ test filename-10.19 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 c:foo} -test filename-10.20 {Tcl_TranslateFileName} { +test filename-10.20 {Tcl_TranslateFileName} {testtranslatefilename} { list [catch {testtranslatefilename ~blorp/foo} msg] $msg } {1 {user "blorp" doesn't exist}} -test filename-10.21 {Tcl_TranslateFileName} { +test filename-10.21 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "c:\\" @@ -1026,12 +1024,14 @@ test filename-10.21 {Tcl_TranslateFileName} { set env(HOME) $temp set result } {0 {c:\foo}} -test filename-10.22 {Tcl_TranslateFileName} { +test filename-10.22 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform windows list [catch {testtranslatefilename foo//bar} msg] $msg } {0 {foo\bar}} -testsetplatform $platform +if {[tcltest::testConstraint testsetplatform]} { + testsetplatform $platform +} test filename-10.23 {Tcl_TranslateFileName} {unixOnly nonPortable} { # this test fails if ~ouster is not /home/ouster @@ -1048,7 +1048,7 @@ test filename-11.1 {Tcl_GlobCmd} { } {1 {wrong # args: should be "glob ?switches? name ?name ...?"}} test filename-11.2 {Tcl_GlobCmd} { list [catch {glob -gorp} msg] $msg -} {1 {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -types, or --}} +} {1 {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}} test filename-11.3 {Tcl_GlobCmd} { list [catch {glob -nocomplai} msg] $msg } {1 {wrong # args: should be "glob ?switches? name ?name ...?"}} @@ -1067,19 +1067,19 @@ test filename-11.7 {Tcl_GlobCmd} { test filename-11.8 {Tcl_GlobCmd} { list [catch {glob -nocomplain -- -nocomplain} msg] $msg } {0 {}} -test filename-11.9 {Tcl_GlobCmd} { +test filename-11.9 {Tcl_GlobCmd} {testsetplatform} { testsetplatform unix list [catch {glob ~\\xyqrszzz/bar} msg] $msg } {1 {user "\xyqrszzz" doesn't exist}} -test filename-11.10 {Tcl_GlobCmd} { +test filename-11.10 {Tcl_GlobCmd} {testsetplatform} { testsetplatform unix list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg } {0 {}} -test filename-11.11 {Tcl_GlobCmd} { +test filename-11.11 {Tcl_GlobCmd} {testsetplatform} { testsetplatform unix list [catch {glob ~xyqrszzz\\/\\bar} msg] $msg } {1 {user "xyqrszzz" doesn't exist}} -test filename-11.12 {Tcl_GlobCmd} { +test filename-11.12 {Tcl_GlobCmd} {testsetplatform} { testsetplatform unix set home $env(HOME) unset env(HOME) @@ -1088,7 +1088,9 @@ test filename-11.12 {Tcl_GlobCmd} { set x } {1 {couldn't find HOME environment variable to expand path}} -testsetplatform $platform +if {[tcltest::testConstraint testsetplatform]} { + testsetplatform $platform +} test filename-11.13 {Tcl_GlobCmd} { list [catch {file join [lindex [glob ~] 0]} msg] $msg @@ -1124,7 +1126,7 @@ test filename-11.16 {Tcl_GlobCmd} { set globname "globTest" set horribleglobname "glob\[\{Test" -test filename-11.17 {Tcl_GlobCmd} { +test filename-11.17 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -directory $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ @@ -1132,15 +1134,33 @@ test filename-11.17 {Tcl_GlobCmd} { [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] -test filename-11.18 {Tcl_GlobCmd} { +test filename-11.17.1 {Tcl_GlobCmd} {pcOnly macOnly} { + list [catch {lsort [glob -directory $globname *]} msg] $msg +} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname .1]\ + [file join $globname a3]\ + [file join $globname "weird name.c"]\ + [file join $globname x,z1.c]\ + [file join $globname x1.c]\ + [file join $globname y1.c] [file join $globname z1.c]]]] +test filename-11.18 {Tcl_GlobCmd} {unixOnly} { + list [catch {lsort [glob -path $globname/ *]} msg] $msg +} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname a3]\ + [file join $globname "weird name.c"]\ + [file join $globname x,z1.c]\ + [file join $globname x1.c]\ + [file join $globname y1.c] [file join $globname z1.c]]]] +test filename-11.18.1 {Tcl_GlobCmd} {pcOnly macOnly} { list [catch {lsort [glob -path $globname/ *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] -test filename-11.19 {Tcl_GlobCmd} { +test filename-11.19 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -join -path \ [string range $globname 0 5] * *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ @@ -1149,6 +1169,16 @@ test filename-11.19 {Tcl_GlobCmd} { [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] +test filename-11.19.1 {Tcl_GlobCmd} {pcOnly macOnly} { + list [catch {lsort [glob -join -path \ + [string range $globname 0 5] * *]} msg] $msg +} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname .1]\ + [file join $globname a3]\ + [file join $globname "weird name.c"]\ + [file join $globname x,z1.c]\ + [file join $globname x1.c]\ + [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.20 {Tcl_GlobCmd} { list [catch {lsort [glob -type d -dir $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1]\ @@ -1161,7 +1191,7 @@ test filename-11.21 {Tcl_GlobCmd} { file rename globTest $horribleglobname set globname $horribleglobname -test filename-11.22 {Tcl_GlobCmd} { +test filename-11.22 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -dir $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ @@ -1169,7 +1199,16 @@ test filename-11.22 {Tcl_GlobCmd} { [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] -test filename-11.23 {Tcl_GlobCmd} { +test filename-11.22.1 {Tcl_GlobCmd} {pcOnly macOnly} { + list [catch {lsort [glob -dir $globname *]} msg] $msg +} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname .1]\ + [file join $globname a3]\ + [file join $globname "weird name.c"]\ + [file join $globname x,z1.c]\ + [file join $globname x1.c]\ + [file join $globname y1.c] [file join $globname z1.c]]]] +test filename-11.23 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -path $globname/ *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ @@ -1177,7 +1216,16 @@ test filename-11.23 {Tcl_GlobCmd} { [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] -test filename-11.24 {Tcl_GlobCmd} { +test filename-11.23.1 {Tcl_GlobCmd} {pcOnly macOnly} { + list [catch {lsort [glob -path $globname/ *]} msg] $msg +} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname .1]\ + [file join $globname a3]\ + [file join $globname "weird name.c"]\ + [file join $globname x,z1.c]\ + [file join $globname x1.c]\ + [file join $globname y1.c] [file join $globname z1.c]]]] +test filename-11.24 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -join -path \ [string range $globname 0 5] * *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ @@ -1186,6 +1234,16 @@ test filename-11.24 {Tcl_GlobCmd} { [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] +test filename-11.24.1 {Tcl_GlobCmd} {pcOnly macOnly} { + list [catch {lsort [glob -join -path \ + [string range $globname 0 5] * *]} msg] $msg +} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname .1]\ + [file join $globname a3]\ + [file join $globname "weird name.c"]\ + [file join $globname x,z1.c]\ + [file join $globname x1.c]\ + [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.25 {Tcl_GlobCmd} { list [catch {lsort [glob -type d -dir $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1]\ @@ -1221,7 +1279,39 @@ test filename-11.34 {Tcl_GlobCmd} { } {1 {missing argument to "-directory"}} test filename-11.35 {Tcl_GlobCmd} { list [catch {glob -paths *} msg] $msg -} {1 {bad option "-paths": must be -directory, -join, -nocomplain, -path, -types, or --}} +} {1 {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}} +# Test '-tails' flag to glob. +test filename-11.36 {Tcl_GlobCmd} { + list [catch {glob -tails *} msg] $msg +} {1 {"-tails" must be used with either "-directory" or "-path"}} +test filename-11.37 {Tcl_GlobCmd} { + list [catch {glob -type d -tails -path $globname *} msg] $msg +} [list 0 [list $globname]] +test filename-11.38 {Tcl_GlobCmd} { + list [catch {glob -tails -path $globname *} msg] $msg +} [list 0 [list $globname]] +test filename-11.39 {Tcl_GlobCmd} { + list [catch {glob -tails -join -path $globname *} msg] $msg +} [list 0 [list $globname]] +test filename-11.40 {Tcl_GlobCmd} { + expr {[glob -dir [pwd] -tails *] == [glob *]} +} {1} +test filename-11.41 {Tcl_GlobCmd} { + expr {[glob -dir [pwd] -tails *] != [glob -dir [pwd] *]} +} {1} +test filename-11.42 {Tcl_GlobCmd} { + set res [list] + foreach f [glob -dir [pwd] *] { + lappend res [file tail $f] + } + expr {$res == [glob *]} +} {1} +test filename-11.43 {Tcl_GlobCmd} { + list [catch {glob -t *} msg] $msg +} {1 {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}} +test filename-11.44 {Tcl_GlobCmd} { + list [catch {glob -tails -path hello -directory hello *} msg] $msg +} {1 {"-directory" cannot be used with "-path"}} file rename $horribleglobname globTest set globname globTest @@ -1339,9 +1429,12 @@ test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} { test filename-14.6 {asterisks, question marks, and brackets} {macOnly} { lsort [glob */*/*/*.c] } {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c} -test filename-14.7 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.7 {asterisks, question marks, and brackets} {unixOnly} { lsort [glob globTest/*] } {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.7.1 {asterisks, question marks, and brackets} {pcOnly} { + 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.8 {asterisks, question marks, and brackets} {macOnly} { 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} @@ -1398,13 +1491,21 @@ test filename-14.23 {slash globbing} {unixOrPc} { test filename-14.24 {slash globbing} {pcOnly} { glob {\\} } / -test filename-14.25 {type specific globbing} { +test filename-14.25 {type specific globbing} {unixOnly} { list [catch {lsort [glob -dir globTest -types f *]} msg] $msg } [list 0 [lsort [list \ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] +test filename-14.25.1 {type specific globbing} {pcOnly macOnly} { + list [catch {lsort [glob -dir globTest -types f *]} msg] $msg +} [list 0 [lsort [list \ + [file join $globname .1]\ + [file join $globname "weird name.c"]\ + [file join $globname x,z1.c]\ + [file join $globname x1.c]\ + [file join $globname y1.c] [file join $globname z1.c]]]] test filename-14.26 {type specific globbing} { list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg } [list 0 {}] @@ -1518,7 +1619,10 @@ file delete -force C:/globTest cd $oldDir file delete -force globTest set env(HOME) $oldhome -testsetplatform $platform -catch {unset oldhome platform temp result} +if {[tcltest::testConstraint testsetplatform]} { + testsetplatform $platform + catch {unset platform} +} +catch {unset oldhome temp result} ::tcltest::cleanupTests return diff --git a/tests/io.test b/tests/io.test index 792a2a2..3c4d8ed 100644 --- a/tests/io.test +++ b/tests/io.test @@ -12,18 +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: io.test,v 1.19 2001/07/17 18:46:47 andreas_kupries Exp $ +# RCS: @(#) $Id: io.test,v 1.20 2001/07/31 19:12:07 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } -if {"[info commands testchannel]" != "testchannel"} { - puts "Skipping io tests. This application does not seem to have the" - puts "testchannel command that is needed to run these tests." - return -} +tcltest::testConstraint testchannel [string equal testchannel [info commands testchannel]] ::tcltest::saveState @@ -630,7 +626,7 @@ test io-6.29 {Tcl_GetsObj: crlf mode: several chars} { close $f set x } [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""] -test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} { +test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} { # if (eol >= dstEnd) set f [open test1 w] @@ -643,7 +639,7 @@ test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} { close $f set x } [list 15 "123456789012345" 15] -test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio} { +test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel} { # (FilterInputBytes() != 0) set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -656,7 +652,7 @@ test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio} { close $f set x } [list "bbbbbbbbbbbbbb" -1 "" 1 16] -test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} { +test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} { # not (FilterInputBytes() != 0) set f [open test1 w] @@ -782,7 +778,7 @@ test io-6.42 {Tcl_GetsObj: auto mode: several chars} { close $f set x } [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""] -test io-6.43 {Tcl_GetsObj: input saw cr} {stdio} { +test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel} { # if (chanPtr->flags & INPUT_SAW_CR) set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -799,7 +795,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio} { close $f set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] -test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio} { +test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel} { # not (*eol == '\n') set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -816,7 +812,7 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio} { close $f set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] -test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio} { +test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel} { # Tcl_ExternalToUtf() set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -833,7 +829,7 @@ test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio} { close $f set x } [list 15 "123456789abcdef" 1 4 "abcd" 0] -test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio} { +test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel} { # memmove() set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -849,7 +845,7 @@ test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {s close $f set x } [list 15 "123456789abcdef" 1 -1 "" 0] -test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} { +test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testchannel} { # (eol == dstEnd) set f [open test1 w] @@ -862,7 +858,7 @@ test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} { close $f set x } [list "123456789012345" 15] -test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} { +test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} { # PeekAhead() did not get any, so (eol >= dstEnd) set f [open test1 w] @@ -875,7 +871,7 @@ test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} { close $f set x } [list "123456789012345" 1] -test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} { +test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} { # if (*eol == '\n') {skip++} set f [open test1 w] @@ -887,7 +883,7 @@ test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} { close $f set x } [list "123456" 0 8 "78901"] -test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} { +test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} { # not (*eol == '\n') set f [open test1 w] @@ -911,7 +907,7 @@ test io-6.51 {Tcl_GetsObj: auto mode: \n} { close $f set x } [list "123456" 7 "78901"] -test io-6.52 {Tcl_GetsObj: saw EOF character} { +test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} { # if (eof != NULL) set f [open test1 w] @@ -1005,7 +1001,7 @@ test io-7.2 {FilterInputBytes: split up character in middle of buffer} { close $f set x } [list 10 "1234567890" 0] -test io-7.3 {FilterInputBytes: split up character at EOF} { +test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} { set f [open test1 w] fconfigure $f -encoding binary puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82" @@ -1037,7 +1033,7 @@ test io-7.4 {FilterInputBytes: recover from split up character} {stdio} { set x } [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0] -test io-8.1 {PeekAhead: only go to device if no more cached data} { +test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} { # (bufPtr->nextPtr == NULL) set f [open "test1" w] @@ -1052,7 +1048,7 @@ test io-8.1 {PeekAhead: only go to device if no more cached data} { close $f set x } "7" -test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio} { +test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel} { # not (bufPtr->nextPtr == NULL) set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -1071,7 +1067,7 @@ test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio} { close $f set x } [list -1 "" 42 15 "123456789012345" 25] -test io-8.3 {PeekAhead: no cached data available} {stdio} { +test io-8.3 {PeekAhead: no cached data available} {stdio testchannel} { # (bytesLeft == 0) set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -1104,7 +1100,7 @@ test io-8.4 {PeekAhead: cached data available in this buffer} { set x } $a unset a -test io-8.5 {PeekAhead: don't peek if last read was short} {stdio} { +test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel} { # (bufPtr->nextAdded < bufPtr->length) set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -1116,7 +1112,7 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio} { close $f set x } {15 abcdefghijklmno 1} -test io-8.6 {PeekAhead: change to non-blocking mode} {stdio} { +test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel} { # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -1128,7 +1124,7 @@ test io-8.6 {PeekAhead: change to non-blocking mode} {stdio} { close $f set x } {15 abcdefghijklmno 1} -test io-8.7 {PeekAhead: cleanup} {stdio} { +test io-8.7 {PeekAhead: cleanup} {stdio testchannel} { # Make sure bytes are removed from buffer. set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -1294,7 +1290,7 @@ test io-12.3 {ReadChars: allocate more space} { close $f set x } {abcdefghijklmnopqrstuvwxyz} -test io-12.4 {ReadChars: split-up char} {stdio} { +test io-12.4 {ReadChars: split-up char} {stdio testchannel} { # (srcRead == 0) set f [open "|[list $::tcltest::tcltest cat]" w+] @@ -1413,7 +1409,7 @@ test io-13.5 {TranslateInputEOL: crlf mode: naked lf} { close $f set x } "abcd\ndef\nfgh" -test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio} { +test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel} { # (chanPtr->flags & INPUT_SAW_CR) # This test may fail on slower machines. @@ -1437,7 +1433,7 @@ test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio} { close $f set x } [list "abcdefghj\n" 1 "01234" 0] -test io-13.7 {TranslateInputEOL: auto mode: naked \r} { +test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel} { # (src >= srcMax) set f [open test1 w] @@ -1518,12 +1514,18 @@ test io-13.12 {TranslateInputEOL: find EOF char in src} { # Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are # also testing channel table management. -if {$tcl_platform(platform) == "macintosh"} { - set consoleFileNames [list console0 console1 console2] +if {[info commands testchannel] != ""} { + if {$tcl_platform(platform) == "macintosh"} { + set consoleFileNames [list console0 console1 console2] + } else { + set consoleFileNames [lsort [testchannel open]] + } } else { - set consoleFileNames [lsort [testchannel open]] + # just to avoid an error + set consoleFileNames [list] } -test io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} { + +test io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {testchannel} { set l "" lappend l [fconfigure stdin -buffering] lappend l [fconfigure stdout -buffering] @@ -1677,7 +1679,7 @@ test io-16.1 {Tcl_DeleteCloseHandler} { # These functions use "eof stdin" to ensure that the standard # channels are added to the channel table of the interpreter. -test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} { +test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stdin] eof stdin interp create x @@ -1689,7 +1691,7 @@ test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} { lappend l [expr [testchannel refcount stdin] - $l1] set l } {0 1 0} -test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} { +test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stdout] eof stdin interp create x @@ -1701,7 +1703,7 @@ test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} { lappend l [expr [testchannel refcount stdout] - $l1] set l } {0 1 0} -test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} { +test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stderr] eof stdin interp create x @@ -1714,7 +1716,7 @@ test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} { set l } {0 1 0} -test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} { +test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} { removeFile test1 set l "" set f [open test1 w] @@ -1728,7 +1730,7 @@ test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} { string compare [string tolower $l] \ [list 1 [format "can not find channel named \"%s\"" $f]] } 0 -test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} { +test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} { removeFile test1 set l "" set f [open test1 w] @@ -1749,7 +1751,7 @@ test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} { string compare [string tolower $l] \ [list 1 2 1 1 [format "can not find channel named \"%s\"" $f]] } 0 -test io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} { +test io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} { removeFile test1 set l "" set f [open test1 w] @@ -1782,7 +1784,7 @@ test io-19.2 {testing Tcl_GetChannel, user opened handle} { test io-19.3 {Tcl_GetChannel, channel not found} { list [catch {eof file34} msg] $msg } {1 {can not find channel named "file34"}} -test io-19.4 {Tcl_CreateChannel, insertion into channel table} { +test io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel} { removeFile test1 set f [open test1 w] set l "" @@ -1853,7 +1855,7 @@ test io-22.1 {Tcl_GetChannelMode} { # Not used anywhere in Tcl. } {} -test io-23.1 {Tcl_GetChannelName} { +test io-23.1 {Tcl_GetChannelName} {testchannel} { removeFile test1 set f [open test1 w] set n [testchannel name $f] @@ -1861,7 +1863,7 @@ test io-23.1 {Tcl_GetChannelName} { string compare $n $f } 0 -test io-24.1 {Tcl_GetChannelType} { +test io-24.1 {Tcl_GetChannelType} {testchannel} { removeFile test1 set f [open test1 w] set t [testchannel type $f] @@ -1869,7 +1871,7 @@ test io-24.1 {Tcl_GetChannelType} { string compare $t file } 0 -test io-25.1 {Tcl_GetChannelHandle, input} { +test io-25.1 {Tcl_GetChannelHandle, input} {testchannel} { set f [open test1 w] fconfigure $f -translation lf -eofchar {} puts $f "1234567890\n098765432" @@ -1882,7 +1884,7 @@ test io-25.1 {Tcl_GetChannelHandle, input} { close $f set l } {10 11} -test io-25.2 {Tcl_GetChannelHandle, output} { +test io-25.2 {Tcl_GetChannelHandle, output} {testchannel} { removeFile test1 set f [open test1 w] fconfigure $f -translation lf @@ -2012,7 +2014,7 @@ test io-27.6 {FlushChannel, async flushing, async close} \ # Tests closing a channel. The functions tested are CloseChannel and Tcl_Close. -test io-28.1 {CloseChannel called when all references are dropped} { +test io-28.1 {CloseChannel called when all references are dropped} {testchannel} { removeFile test1 set f [open test1 w] interp create x @@ -2086,7 +2088,7 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \ set result ok } } ok -test io-28.4 {Tcl_Close} { +test io-28.4 {Tcl_Close} {testchannel} { removeFile test1 set l "" lappend l [lsort [testchannel open]] @@ -2099,7 +2101,7 @@ test io-28.4 {Tcl_Close} { $consoleFileNames] string compare $l $x } 0 -test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly} { +test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly testchannel} { removeFile script set f [open script w] puts $f { @@ -2132,7 +2134,7 @@ test io-29.3 {Tcl_WriteChars, nonempty string} { close $f file size test1 } 5 -test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} { +test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {testchannel} { removeFile test1 set f [open test1 w] fconfigure $f -translation lf -buffering full -eofchar {} @@ -2146,7 +2148,7 @@ test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} { close $f set l } {6 0 0 6} -test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} { +test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {testchannel} { removeFile test1 set f [open test1 w] fconfigure $f -translation lf -buffering line -eofchar {} @@ -2160,7 +2162,7 @@ test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} { close $f set l } {5 0 0 11} -test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} { +test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {testchannel} { removeFile test1 set f [open test1 w] fconfigure $f -translation lf -buffering none -eofchar {} @@ -2175,7 +2177,7 @@ test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} { set l } {0 5 0 11} -test io-29.7 {Tcl_Flush, full buffering} { +test io-29.7 {Tcl_Flush, full buffering} {testchannel} { removeFile test1 set f [open test1 w] fconfigure $f -translation lf -buffering full -eofchar {} @@ -2192,7 +2194,7 @@ test io-29.7 {Tcl_Flush, full buffering} { close $f set l } {5 0 11 0 0 11} -test io-29.8 {Tcl_Flush, full buffering} { +test io-29.8 {Tcl_Flush, full buffering} {testchannel} { removeFile test1 set f [open test1 w] fconfigure $f -translation lf -buffering line @@ -4671,7 +4673,7 @@ test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} { # Test Tcl_InputBuffered -test io-37.1 {Tcl_InputBuffered} { +test io-37.1 {Tcl_InputBuffered} {testchannel} { set f [open longfile r] fconfigure $f -buffersize 4096 read $f 3 @@ -4681,7 +4683,7 @@ test io-37.1 {Tcl_InputBuffered} { close $f set l } {4093 3} -test io-37.2 {Tcl_InputBuffered, test input flushing on seek} { +test io-37.2 {Tcl_InputBuffered, test input flushing on seek} {testchannel} { set f [open longfile r] fconfigure $f -buffersize 4096 read $f 3 @@ -5097,6 +5099,7 @@ test io-40.6 {POSIX open access modes: EXCL} { close $f set msg [list [catch {open test3 {WRONLY CREAT EXCL}} msg] $msg] regsub " already " $msg " " msg + regsub [file join {} test3] $msg "test3" msg string tolower $msg } {1 {couldn't open "test3": file exists}} test io-40.7 {POSIX open access modes: EXCL} { @@ -5144,11 +5147,15 @@ test io-40.10 {POSIX open access modes: RDONLY} { } 0 test io-40.11 {POSIX open access modes: RDONLY} { removeFile test3 - string tolower [list [catch {open test3 RDONLY} msg] $msg] + set msg [list [catch {open test3 RDONLY} msg] $msg] + regsub [file join {} test3] $msg "test3" msg + string tolower $msg } {1 {couldn't open "test3": no such file or directory}} test io-40.12 {POSIX open access modes: WRONLY} { removeFile test3 - string tolower [list [catch {open test3 WRONLY} msg] $msg] + set msg [list [catch {open test3 WRONLY} msg] $msg] + regsub [file join {} test3] $msg "test3" msg + string tolower $msg } {1 {couldn't open "test3": no such file or directory}} test io-40.13 {POSIX open access modes: WRONLY} { makeFile xyzzy test3 @@ -5164,7 +5171,9 @@ test io-40.13 {POSIX open access modes: WRONLY} { } 0 test io-40.14 {POSIX open access modes: RDWR} { removeFile test3 - string tolower [list [catch {open test3 RDWR} msg] $msg] + set msg [list [catch {open test3 RDWR} msg] $msg] + regsub [file join {} test3] $msg "test3" msg + string tolower $msg } {1 {couldn't open "test3": no such file or directory}} test io-40.15 {POSIX open access modes: RDWR} { makeFile xyzzy test3 @@ -6054,7 +6063,7 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} { set l } [list 7 a\rb\rc 7 {} 7 1] -test io-50.1 {testing handler deletion} {} { +test io-50.1 {testing handler deletion} {testchannel} { removeFile test1 set f [open test1 w] close $f @@ -6070,7 +6079,7 @@ test io-50.1 {testing handler deletion} {} { close $f set z } called -test io-50.2 {testing handler deletion with multiple handlers} {} { +test io-50.2 {testing handler deletion with multiple handlers} {testchannel} { removeFile test1 set f [open test1 w] close $f @@ -6088,7 +6097,7 @@ test io-50.2 {testing handler deletion with multiple handlers} {} { string compare [string tolower $z] \ [list [list called delhandler $f 0] [list called delhandler $f 1]] } 0 -test io-50.3 {testing handler deletion with multiple handlers} {} { +test io-50.3 {testing handler deletion with multiple handlers} {testchannel} { removeFile test1 set f [open test1 w] close $f @@ -6114,7 +6123,7 @@ test io-50.3 {testing handler deletion with multiple handlers} {} { [list [list delhandler $f 0 called] \ [list delhandler $f 0 deleted myself]] } 0 -test io-50.4 {testing handler deletion vs reentrant calls} {} { +test io-50.4 {testing handler deletion vs reentrant calls} {testchannel} { removeFile test1 set f [open test1 w] close $f @@ -6138,7 +6147,7 @@ test io-50.4 {testing handler deletion vs reentrant calls} {} { string compare [string tolower $z] \ {{delrecursive calling recursive} {delrecursive deleting recursive}} } 0 -test io-50.5 {testing handler deletion vs reentrant calls} {} { +test io-50.5 {testing handler deletion vs reentrant calls} {testchannel} { removeFile test1 set f [open test1 w] close $f @@ -6171,7 +6180,7 @@ test io-50.5 {testing handler deletion vs reentrant calls} {} { [list {del calling recursive} {del deleted notcalled} \ {del deleted myself} {del after update}] } 0 -test io-50.6 {testing handler deletion vs reentrant calls} {} { +test io-50.6 {testing handler deletion vs reentrant calls} {testchannel} { removeFile test1 set f [open test1 w] close $f @@ -6723,7 +6732,7 @@ test io-55.1 {ChannelEventScriptInvoker: deletion} { set x } {got_error} -test io-56.1 {ChannelTimerProc} { +test io-56.1 {ChannelTimerProc} {testchannel} { set f [open fooBar w] puts $f "this is a test" close $f diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 5655c7b..38a3e32 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.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: ioCmd.test,v 1.8 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.9 2001/07/31 19:12:07 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -361,11 +361,15 @@ test iocmd-12.1 {POSIX open access modes: RDONLY} { } 0 test iocmd-12.2 {POSIX open access modes: RDONLY} { removeFile test3 - string tolower [list [catch {open test3 RDONLY} msg] $msg] + set msg [list [catch {open test3 RDONLY} msg] $msg] + regsub [file join {} test3] $msg "test3" msg + string tolower $msg } {1 {couldn't open "test3": no such file or directory}} test iocmd-12.3 {POSIX open access modes: WRONLY} { removeFile test3 - string tolower [list [catch {open test3 WRONLY} msg] $msg] + set msg [list [catch {open test3 WRONLY} msg] $msg] + regsub [file join {} test3] $msg "test3" msg + string tolower $msg } {1 {couldn't open "test3": no such file or directory}} # # Test 13.4 relies on assigning the same channel name twice. @@ -391,7 +395,9 @@ test iocmd-12.4 {POSIX open access modes: WRONLY} {unixOnly} { } 0 test iocmd-12.5 {POSIX open access modes: RDWR} { removeFile test3 - string tolower [list [catch {open test3 RDWR} msg] $msg] + set msg [list [catch {open test3 RDWR} msg] $msg] + regsub [file join {} test3] $msg "test3" msg + string tolower $msg } {1 {couldn't open "test3": no such file or directory}} test iocmd-12.6 {POSIX open access modes: errors} { concat [catch {open test3 "FOO \{BAR BAZ"} msg] $msg\n$errorInfo @@ -423,7 +429,9 @@ test iocmd-13.5 {errors in open command} { list [catch {open test1 r+1} msg] $msg } {1 {illegal access mode "r+1"}} test iocmd-13.6 {errors in open command} { - string tolower [list [catch {open _non_existent_} msg] $msg $errorCode] + set msg [list [catch {open _non_existent_} msg] $msg $errorCode] + regsub [file join {} _non_existent_] $msg "_non_existent_" msg + string tolower $msg } {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}} test iocmd-14.1 {file id parsing errors} { diff --git a/tests/proc-old.test b/tests/proc-old.test index 9365042..e4dae6a 100644 --- a/tests/proc-old.test +++ b/tests/proc-old.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: proc-old.test,v 1.7 2000/05/03 00:14:36 hobbs Exp $ +# RCS: @(#) $Id: proc-old.test,v 1.8 2001/07/31 19:12:07 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -433,7 +433,9 @@ test proc-old-7.11 {return with special completion code} { catch {open _bad_file_name r} msg return -code error -errorinfo $errorInfo -errorcode $errorCode $msg } - normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg + normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "open _bad_file_name r" @@ -445,7 +447,9 @@ test proc-old-7.12 {return with special completion code} { catch {open _bad_file_name r} msg return -code error -errorcode $errorCode $msg } - normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg + normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "tproc2"} {posix enoent {no such file or directory}}} @@ -455,7 +459,9 @@ test proc-old-7.13 {return with special completion code} { catch {open _bad_file_name r} msg return -code error -errorinfo $errorInfo $msg } - normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg + normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "open _bad_file_name r" @@ -467,7 +473,9 @@ test proc-old-7.14 {return with special completion code} { catch {open _bad_file_name r} msg return -code error $msg } - normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg + normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "tproc2"} none} diff --git a/tests/registry.test b/tests/registry.test index f9e7055..4b22cc8 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -10,7 +10,7 @@ # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# RCS: @(#) $Id: registry.test,v 1.10 2000/04/10 17:19:03 ericm Exp $ +# RCS: @(#) $Id: registry.test,v 1.11 2001/07/31 19:12:07 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -19,8 +19,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { if {$tcl_platform(platform) == "windows"} { if [catch { - set lib [lindex [glob [file join [pwd] [file dirname \ - [info nameofexecutable]] tclreg*.dll]] 0] + set lib [lindex [glob -directory [file join [pwd] [file dirname \ + [info nameofexecutable]]] tclreg*.dll] 0] load $lib registry }] { puts "Unable to find the registry package. Skipping registry tests." diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index 7a388c8..d2d8f9d 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.11 2000/04/10 17:19:05 ericm Exp $ +# RCS: @(#) $Id: unixFCmd.test,v 1.12 2001/07/31 19:12:07 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -32,7 +32,7 @@ proc openup {path} { testchmod 777 $path if {[file isdirectory $path]} { catch { - foreach p [glob [file join $path *]] { + foreach p [glob -directory $path *] { openup $p } } @@ -43,7 +43,7 @@ proc cleanup {args} { foreach p ". $args" { set x "" catch { - set x [glob [file join $p tf*] [file join $p td*]] + set x [glob -directory $p tf* td*] } foreach file $x { if {[catch {file delete -force -- $file}]} { diff --git a/tests/winDde.test b/tests/winDde.test index 90c51ed..3657d43 100644 --- a/tests/winDde.test +++ b/tests/winDde.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: winDde.test,v 1.9 2001/01/12 09:54:17 dkf Exp $ +# RCS: @(#) $Id: winDde.test,v 1.10 2001/07/31 19:12:07 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -18,11 +18,11 @@ if {[lsearch [namespace children] ::tcltest] == -1} { if {$tcl_platform(platform) == "windows"} { if [catch { - set lib [lindex [glob [file join [pwd] [file dirname \ - [info nameofexecutable]] tcldde*.dll]] 0] + set lib [lindex [glob -directory [file join [pwd] [file dirname \ + [info nameofexecutable]]] tcldde*.dll] 0] load $lib dde }] { - puts "Unable to find the dde package. Skipping registry tests." + puts "Unable to find the dde package. Skipping dde tests." ::tcltest::cleanupTests return } @@ -38,11 +38,11 @@ proc createChildProcess { ddeServerName } { set f [open $::scriptName w+] puts $f { if [catch { - set lib [lindex [glob [file join [pwd] [file dirname \ - [info nameofexecutable]] tcldde*.dll]] 0] + set lib [lindex [glob -directory [file join [pwd] [file dirname \ + [info nameofexecutable]]] tcldde*.dll] 0] load $lib dde }] { - puts "Unable to find the dde package. Skipping registry tests." + puts "Unable to find the dde package. Skipping dde tests." ::tcltest::cleanupTests return } diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 97fc2d5..b26f385 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.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: winFCmd.test,v 1.9 2000/04/10 17:19:06 ericm Exp $ +# RCS: @(#) $Id: winFCmd.test,v 1.10 2001/07/31 19:12:07 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -36,7 +36,7 @@ proc cleanup {args} { foreach p ". $args" { set x "" catch { - set x [glob [file join $p tf*] [file join $p td*]] + set x [glob -directory $p tf* td*] } if {$x != ""} { catch {eval file delete -force -- $x} |