diff options
author | apnadkarni <apnmbx-wits@yahoo.com> | 2022-08-01 17:07:54 (GMT) |
---|---|---|
committer | apnadkarni <apnmbx-wits@yahoo.com> | 2022-08-01 17:07:54 (GMT) |
commit | 7754129cabaa2aa7f6a487106c0551d0c5f2c2d3 (patch) | |
tree | c9596e5a21332d0595b316f8a390bd290a9d2867 | |
parent | 515f8ab0440b2d4cb6411790c2c08210cadfee6a (diff) | |
download | tcl-7754129cabaa2aa7f6a487106c0551d0c5f2c2d3.zip tcl-7754129cabaa2aa7f6a487106c0551d0c5f2c2d3.tar.gz tcl-7754129cabaa2aa7f6a487106c0551d0c5f2c2d3.tar.bz2 |
Update tests for TIP 602
-rw-r--r-- | generic/tclCmdAH.c | 5 | ||||
-rw-r--r-- | generic/tclFCmd.c | 5 | ||||
-rw-r--r-- | generic/tclInt.h | 1 | ||||
-rw-r--r-- | generic/tclPathObj.c | 26 | ||||
-rw-r--r-- | tests/chanio.test | 21 | ||||
-rw-r--r-- | tests/cmdAH.test | 74 | ||||
-rw-r--r-- | tests/exec.test | 16 | ||||
-rw-r--r-- | tests/fCmd.test | 220 | ||||
-rw-r--r-- | tests/fileName.test | 138 | ||||
-rw-r--r-- | tests/fileSystem.test | 24 | ||||
-rw-r--r-- | tests/io.test | 2 | ||||
-rw-r--r-- | tests/safe.test | 8 | ||||
-rw-r--r-- | tests/winFile.test | 2 |
13 files changed, 345 insertions, 197 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 48b90bc..eec3e0f 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -271,7 +271,10 @@ Tcl_CdObjCmd( if (objc == 2) { dir = objv[1]; } else { - TclNewLiteralStringObj(dir, "~"); + dir = TclGetHomeDirObj(interp, NULL); + if (dir == NULL) { + return TCL_ERROR; + } Tcl_IncrRefCount(dir); } if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) { diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index c786395..9a107da 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -1677,16 +1677,15 @@ TclFileHomeCmd( Tcl_Obj *const objv[]) { Tcl_Obj *homeDirObj; - Tcl_DString dirString; if (objc != 1 && objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "?user?"); return TCL_ERROR; } - if (TclGetHomeDir(interp, objc == 1 ? NULL : Tcl_GetString(objv[1]), &dirString) != TCL_OK) { + homeDirObj = TclGetHomeDirObj(interp, objc == 1 ? NULL : Tcl_GetString(objv[1])); + if (homeDirObj == NULL) { return TCL_ERROR; } - homeDirObj = TclDStringToObj(&dirString); Tcl_SetObjResult(interp, homeDirObj); return TCL_OK; } diff --git a/generic/tclInt.h b/generic/tclInt.h index b09ef8f..51f7e75 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3023,6 +3023,7 @@ MODULE_SCOPE Tcl_Obj * TclJoinPath(size_t elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int TclGetHomeDir(Tcl_Interp *interp, const char *user, Tcl_DString *dsPtr); +MODULE_SCOPE Tcl_Obj * TclGetHomeDirObj(Tcl_Interp *interp, const char *user); MODULE_SCOPE Tcl_Obj * TclResolveTildePath(Tcl_Interp *interp, Tcl_Obj *pathObj); MODULE_SCOPE Tcl_Obj * TclResolveTildePathList(Tcl_Obj *pathsObj); diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index d9fccb7..c123613 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -2631,6 +2631,32 @@ TclGetHomeDir( /* *---------------------------------------------------------------------- * + * TclGetHomeDirObj -- + * + * Wrapper around TclGetHomeDir. See that function. + * + * Results: + * Returns a Tcl_Obj containing the home directory of a user + * or NULL on failure with error message in interp if non-NULL. + * + *---------------------------------------------------------------------- + */ +Tcl_Obj * +TclGetHomeDirObj( + Tcl_Interp *interp, /* May be NULL. Only used for error messages */ + const char *user) /* User name. NULL -> current user */ +{ + Tcl_DString dirString; + + if (TclGetHomeDir(interp, user, &dirString) != TCL_OK) { + return NULL; + } + return TclDStringToObj(&dirString); +} + +/* + *---------------------------------------------------------------------- + * * TclResolveTildePath -- * * If the passed path is begins with a tilde, does tilde resolution diff --git a/tests/chanio.test b/tests/chanio.test index 8d922a2..c1085f4 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -61,7 +61,7 @@ namespace eval ::tcl::test::io { set umaskValue 0 testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}] - testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}] + testConstraint makeFileInHome [expr {![file exists $::env(HOME)/_test_] && [file writable $::env(HOME)]}] # set up a long data file for some of the following tests @@ -5488,21 +5488,16 @@ test chan-io-40.15 {POSIX open access modes: RDWR} { chan close $f lappend x [viewFile test3] } {zzy abzzy} -test chan-io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup { - makeFile {Some text} _test_ ~ +test chan-io-40.16 {verify no tilde substitution in open} -setup { + set curdir [pwd] + cd [temporaryDirectory] } -body { - file exists [file join $::env(HOME) _test_] + close [open ~ w] + list [file isfile ~] } -cleanup { - removeFile _test_ ~ + file delete ./~ ;# ./ because don't want to delete home in case of bugs! + cd $curdir } -result 1 -test chan-io-40.17 {tilde substitution in open} -setup { - set home $::env(HOME) -} -body { - unset ::env(HOME) - open ~/foo -} -returnCodes error -cleanup { - set ::env(HOME) $home -} -result {couldn't find HOME environment variable to expand path} test chan-io-41.1 {Tcl_FileeventCmd: errors} -constraints fileevent -body { chan event foo diff --git a/tests/cmdAH.test b/tests/cmdAH.test index fb74b7f..3c78842 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -100,7 +100,7 @@ test cmdAH-2.3 {Tcl_CdObjCmd} -setup { set env(HOME) $oldpwd file mkdir $foodir cd $foodir - cd ~ + cd [file home] string equal [pwd] $oldpwd } -cleanup { cd $oldpwd @@ -124,8 +124,21 @@ test cmdAH-2.4 {Tcl_CdObjCmd} -setup { set env(HOME) $temp } -result 1 test cmdAH-2.5 {Tcl_CdObjCmd} -returnCodes error -body { - cd ~~ -} -result {user "~" doesn't exist} + cd ~ +} -result {couldn't change working directory to "~": no such file or directory} +test cmdAH-2.5.1 {Tcl_CdObjCmd} -setup { + set oldpwd [pwd] + cd [temporaryDirectory] + file delete ./~ + file mkdir ~ +} -body { + cd ~ + pwd +} -cleanup { + cd [temporaryDirectory] + file delete ./~ + cd $oldpwd +} -result [file join [temporaryDirectory] ~] test cmdAH-2.6 {Tcl_CdObjCmd} -returnCodes error -body { cd _foobar } -result {couldn't change working directory to "_foobar": no such file or directory} @@ -349,7 +362,7 @@ test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body { } -result {wrong # args: should be "file subcommand ?arg ...?"} test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body { file x -} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable} +} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, home, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable} test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body { file exists } -result {wrong # args: should be "file exists name"} @@ -496,7 +509,7 @@ test cmdAH-8.43 {Tcl_FileObjCmd: dirname} -setup { } -constraints testsetplatform -body { set env(HOME) "/homewontexist/test" testsetplatform unix - file dirname ~ + file dirname [file home] } -cleanup { set env(HOME) $temp } -result /homewontexist @@ -506,19 +519,13 @@ test cmdAH-8.44 {Tcl_FileObjCmd: dirname} -setup { } -constraints testsetplatform -body { set env(HOME) "~" testsetplatform unix - file dirname ~ + file dirname [file home] } -cleanup { set env(HOME) $temp -} -result ~ -test cmdAH-8.45 {Tcl_FileObjCmd: dirname} -setup { - set temp $::env(HOME) -} -constraints {win testsetplatform} -match regexp -body { - set ::env(HOME) "/homewontexist/test" - testsetplatform windows +} -result . +test cmdAH-8.45 {Tcl_FileObjCmd: dirname ~} -body { file dirname ~ -} -cleanup { - set ::env(HOME) $temp -} -result {([a-zA-Z]:?)/homewontexist} +} -result . test cmdAH-8.46 {Tcl_FileObjCmd: dirname} { set f [file normalize [info nameof]] file exists $f @@ -626,36 +633,19 @@ test cmdAH-9.26 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {//foo/bar} } {} -test cmdAH-9.42 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { - global env - set temp $env(HOME) -} -body { - set env(HOME) "/home/test" - testsetplatform unix +test cmdAH-9.42 {Tcl_FileObjCmd: tail ~} -body { file tail ~ -} -cleanup { - set env(HOME) $temp -} -result test +} -result ~ test cmdAH-9.43 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { global env set temp $env(HOME) } -body { set env(HOME) "~" testsetplatform unix - file tail ~ -} -cleanup { - set env(HOME) $temp -} -result {} -test cmdAH-9.44 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { - global env - set temp $env(HOME) -} -body { - set env(HOME) "/home/test" - testsetplatform windows - file tail ~ + file tail [file home] } -cleanup { set env(HOME) $temp -} -result test +} -result ~ test cmdAH-9.46 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {f.oo\bar/baz.bat} @@ -686,7 +676,7 @@ test cmdAH-9.52 {Tcl_FileObjCmd: tail / normalize, bug 7a9dc52b29} { [file tail {~/test/~foo}] \ [file tail [file normalize {~/~foo}]] \ [file tail [file normalize {~/test/~foo}]] -} [lrepeat 4 ./~foo] +} [lrepeat 4 ~foo] # rootname test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body { @@ -940,7 +930,7 @@ test cmdAH-14.3 {Tcl_FileObjCmd: join} testsetplatform { test cmdAH-15.1 {Tcl_FileObjCmd} -constraints testsetplatform -body { testsetplatform unix file atime ~_bad_user -} -returnCodes error -result {user "_bad_user" doesn't exist} +} -returnCodes error -result {could not read "~_bad_user": no such file or directory} catch {testsetplatform $platform} @@ -1063,9 +1053,8 @@ test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} { file exists ~nOsUcHuSeR } 0 test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} -body { - # should probably be a non-error in fact... file nativename ~nOsUcHuSeR -} -returnCodes error -match glob -result * +} -result ~nOsUcHuSeR # The test below has to be done in /tmp rather than the current directory in # order to guarantee (?) a local file system: some NFS file systems won't do # the stuff below correctly. @@ -1680,7 +1669,7 @@ test cmdAH-29.6.1 { # Error conditions test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file gorp x -} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable} +} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, home, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable} test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file ex x } -match glob -result {unknown or ambiguous subcommand "ex": must be *} @@ -1699,9 +1688,6 @@ test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file t x } -match glob -result {unknown or ambiguous subcommand "t": must be *} -test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { - file dirname ~woohgy -} -result {user "woohgy" doesn't exist} # channels # In testing 'file channels', we need to make sure that a channel created in diff --git a/tests/exec.test b/tests/exec.test index 6e4718a..5ecfcac 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -440,15 +440,21 @@ test exec-10.19 {errors in exec invocation} -constraints {exec} -body { exec cat >@ $f } -returnCodes error -result "channel \"$f\" wasn't opened for writing" close $f -test exec-10.20 {errors in exec invocation} -constraints {exec notValgrind} -body { +test exec-10.20.1 {errors in exec invocation} -constraints {unix exec notValgrind} -body { exec ~non_existent_user/foo/bar -} -returnCodes error -result {user "non_existent_user" doesn't exist} -test exec-10.21 {errors in exec invocation} -constraints {exec notValgrind} -body { +} -returnCodes error -result {couldn't execute "~non_existent_user/foo/bar": no such file or directory} +test exec-10.20.1 {errors in exec invocation} -constraints {win exec notValgrind} -body { + exec ~non_existent_user/foo/bar +} -returnCodes error -result {couldn't execute "~non_existent_user\foo\bar": no such file or directory} +test exec-10.21.1 {errors in exec invocation} -constraints {unix exec notValgrind} -body { + exec [interpreter] true | ~xyzzy_bad_user/x | false +} -returnCodes error -result {couldn't execute "~xyzzy_bad_user/x": no such file or directory} +test exec-10.21.2 {errors in exec invocation} -constraints {win exec notValgrind} -body { exec [interpreter] true | ~xyzzy_bad_user/x | false -} -returnCodes error -result {user "xyzzy_bad_user" doesn't exist} +} -returnCodes error -result {couldn't execute "~xyzzy_bad_user\x": no such file or directory} test exec-10.22 {errors in exec invocation} -constraints {exec notValgrind} -body { exec echo test > ~non_existent_user/foo/bar -} -returnCodes error -result {user "non_existent_user" doesn't exist} +} -returnCodes error -result {couldn't write file "~non_existent_user/foo/bar": no such file or directory} # Commands in background. test exec-11.1 {commands in background} {exec} { diff --git a/tests/fCmd.test b/tests/fCmd.test index 13f3720..e9d7667 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -96,6 +96,14 @@ if {[testConstraint unix]} { set user "root" } } +if {[testConstraint win]} { + catch { + set user $::env(USERNAME) + } + if {$user eq ""} { + set user Administrator + } +} proc createfile {file {string a}} { set f [open $file w] @@ -122,6 +130,10 @@ proc checkcontent {file matchString} { } proc openup {path} { + # Double check for inadvertent ~ -> home directory mapping + if {[string match ~* $path]} { + set file ./$path + } testchmod 0o777 $path if {[file isdirectory $path]} { catch { @@ -137,9 +149,13 @@ proc cleanup {args} { foreach p [concat $wd $args] { set x "" catch { - set x [glob -directory $p tf* td*] + set x [glob -directory $p tf* td* ~*] } foreach file $x { + # Double check for inadvertent ~ -> home directory mapping + if {[string match ~* $file]} { + set file ./$file + } if { [catch {file delete -force -- $file}] && [testConstraint testchmod] @@ -179,6 +195,43 @@ test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup { file rename tf1 tf2 glob tf* } -result {tf2} +test fCmd-1.2 {TclFileRenameCmd when target is ~} -setup { + cleanup + createfile tf1 +} -cleanup { + file delete ./~ +} -body { + file rename tf1 ~ + file isfile ~ +} -result 1 +test fCmd-1.3 {TclFileRenameCmd when target is ~user} -setup { + cleanup + createfile tf1 +} -cleanup { + file delete ./~$user +} -body { + file rename tf1 ~$user + file isfile ~$user +} -result 1 +test fCmd-1.4 {TclFileRenameCmd when source is ~} -setup { + cleanup + createfile ./~ +} -cleanup { + file delete ./~ +} -body { + file rename ~ tf1 + list [file exists ~] [file exists tf1] +} -result {0 1} +test fCmd-1.5 {TclFileRenameCmd when source is ~user} -setup { + cleanup + createfile ./~$user +} -cleanup { + file delete ./~$user +} -body { + file rename ~$user tf1 + list [file exists ~$user] [file exists tf1] +} -result {0 1} + test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup { cleanup @@ -187,6 +240,42 @@ test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup { file copy tf1 tf2 lsort [glob tf*] } -result {tf1 tf2} +test fCmd-2.2 {TclFileCopyCmd when target is ~} -setup { + cleanup + createfile tf1 +} -cleanup { + file delete ./~ +} -body { + file copy tf1 ~ + list [file exists tf1] [file exists ~] +} -result {1 1} +test fCmd-2.3 {TclFileCopyCmd when target is ~user} -setup { + cleanup + createfile tf1 +} -cleanup { + file delete ./~$user +} -body { + file copy tf1 ~$user + list [file exists tf1] [file exists ~$user] +} -result {1 1} +test fCmd-2.4 {TclFileCopyCmd when source is ~} -setup { + cleanup + createfile ./~ +} -cleanup { + file delete ./~ +} -body { + file copy ~ tf1 + list [file exists ~] [file exists tf1] +} -result {1 1} +test fCmd-2.5 {TclFileCopyCmd when source is ~user} -setup { + cleanup + createfile ./~$user +} -cleanup { + file delete ./~$user +} -body { + file copy ~$user tf1 + list [file exists ~$user] [file exists tf1] +} -result {1 1} test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body { file rename -xyz @@ -196,7 +285,7 @@ test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body { } -returnCodes error -result {wrong # args: should be "file rename ?-option value ...? source ?source ...? target"} test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} -constraints {notRoot} -body { file rename xyz ~_totally_bogus_user -} -returnCodes error -result {user "_totally_bogus_user" doesn't exist} +} -returnCodes error -result {error renaming "xyz": no such file or directory} test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -270,7 +359,7 @@ test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup { } -constraints {notRoot} -returnCodes error -body { file mkdir td1 file rename ~_totally_bogus_user td1 -} -result {user "_totally_bogus_user" doesn't exist} +} -result {error renaming "~_totally_bogus_user": no such file or directory} test fCmd-3.15 {FileCopyRename: source[0] == '\x00'} -setup { cleanup } -constraints {notRoot unixOrWin} -returnCodes error -body { @@ -308,11 +397,17 @@ test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} -setup { catch {file mkdir td1 td2 tf1 td3 td4} glob td1 td2 tf1 td3 td4 } -result {td1 td2 tf1} -test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup { +test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName treats ~ as normal char} -setup { cleanup -} -constraints {notRoot} -returnCodes error -body { +} -constraints {notRoot} -body { + list [file isdir ~] [file mkdir ~] [file isdir ~] +} -result {0 {} 1} +test fCmd-4.4.1 {TclFileMakeDirsCmd: Tcl_TranslateFileName treats ~ as normal char} -setup { + cleanup +} -constraints {notRoot} -body { file mkdir ~_totally_bogus_user -} -result {user "_totally_bogus_user" doesn't exist} + file isdir ~_totally_bogus_user +} -result 1 test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\x00'} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -420,15 +515,16 @@ test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup { catch {file delete tf1 td1 $root tf2} list [file exists tf1] [file exists tf2] [file exists td1] } -cleanup {cleanup} -result {0 1 0} -test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body { +test fCmd-5.6 { + TclFileDeleteCmd: Tcl_TranslateFileName treats ~user as normal char +} -constraints {notRoot} -body { file delete ~_totally_bogus_user -} -returnCodes error -result {user "_totally_bogus_user" doesn't exist} -test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} -setup { - catch {file delete ~/tf1} +} -result {} +test fCmd-5.7 { + TclFileDeleteCmd: Tcl_TranslateFileName treats ~ as normal char } -constraints {notRoot} -body { createfile ~/tf1 - file delete ~/tf1 -} -result {} +} -returnCodes error -result {couldn't open "~/tf1": no such file or directory} test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} -setup { cleanup } -constraints {notRoot} -body { @@ -627,37 +723,37 @@ test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup { cleanup } -constraints {unix notRoot} -body { - file mkdir ~/td1/td2 - set td1name [file join [file dirname ~] [file tail ~] td1] + file mkdir [file home]/td1/td2 + set td1name [file join [file dirname [file home]] [file tail [file home]] td1] file attributes $td1name -permissions 0 - file copy ~/td1 td1 + file copy [file home]/td1 td1 } -returnCodes error -cleanup { file attributes $td1name -permissions 0o755 - file delete -force ~/td1 -} -result {error copying "~/td1": permission denied} + file delete -force [file home]/td1 +} -result "error copying \"[file home]/td1\": permission denied" test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir td2 - file mkdir ~/td1 - set td1name [file join [file dirname ~] [file tail ~] td1] + file mkdir [file home]/td1 + set td1name [file join [file dirname [file home]] [file tail [file home]] td1] file attributes $td1name -permissions 0 - file copy td2 ~/td1 + file copy td2 [file home]/td1 } -returnCodes error -cleanup { file attributes $td1name -permissions 0o755 - file delete -force ~/td1 -} -result {error copying "td2" to "~/td1/td2": permission denied} + file delete -force [file home]/td1 +} -result "error copying \"td2\" to \"[file home]/td1/td2\": permission denied" test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup { cleanup } -constraints {unix notRoot} -body { - file mkdir ~/td1/td2 - set td2name [file join [file dirname ~] [file tail ~] td1 td2] + file mkdir [file home]/td1/td2 + set td2name [file join [file dirname [file home]] [file tail [file home]] td1 td2] file attributes $td2name -permissions 0 - file copy ~/td1 td1 + file copy [file home]/td1 td1 } -returnCodes error -cleanup { file attributes $td2name -permissions 0o755 - file delete -force ~/td1 -} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied" + file delete -force [file home]/td1 +} -result "error copying \"[file home]/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied" test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace } -constraints {notRoot xdev} -returnCodes error -body { @@ -741,7 +837,7 @@ test fCmd-7.5 {FileForceOption: multiple times through loop} -setup { } -result {no files matched glob patterns "-- -force"} test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ - -constraints {unix notRoot knownBug} -body { + -constraints {unix notRoot knownBug tildeexpansion} -body { # Labelled knownBug because it is dangerous [Bug: 3881] file mkdir td1 file attr td1 -perm 0o40000 @@ -752,11 +848,11 @@ test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ -constraints {unix notRoot} -body { string equal [file tail ~$user] ~$user -} -result 0 +} -result 1 test fCmd-8.3 {file copy and path translation: ensure correct error} -body { - file copy ~ [file join this file doesnt exist] + file copy [file home] [file join this file doesnt exist] } -returnCodes error -result [subst \ - {error copying "~" to "[file join this file doesnt exist]": no such file or directory}] + {error copying "[file home]" to "[file join this file doesnt exist]": no such file or directory}] test fCmd-9.1 {file rename: comprehensive: EACCES} -setup { cleanup @@ -1498,15 +1594,17 @@ test fCmd-14.8 {copyfile: copy directory failing} -setup { # # Coverage tests for TclMkdirCmd() # + +# ~ is no longer a special char. Need a test case where translation fails. test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup { set temp $::env(HOME) -} -constraints {notRoot} -body { +} -constraints {notRoot TODO} -body { global env unset env(HOME) catch {file mkdir ~/tfa} } -cleanup { set ::env(HOME) $temp -} -result {1} +} -result 1 # # Can Tcl_SplitPath return argc == 0? If so them we need a test for that code. # @@ -1599,9 +1697,10 @@ test fCmd-16.4 {accept zero files (TIP 323)} -body { test fCmd-16.5 {accept zero files (TIP 323)} -body { file delete -- } -result {} +# ~ is no longer a special char. Need a test case where translation fails. test fCmd-16.6 {delete: source filename translation failing} -setup { set temp $::env(HOME) -} -constraints {notRoot} -body { +} -constraints {notRoot TODO} -body { global env unset env(HOME) catch {file delete ~/tfa} @@ -2227,7 +2326,7 @@ test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} -setup { file attributes ~_totally_bogus_user } -returnCodes error -cleanup { testsetplatform $platform -} -result {user "_totally_bogus_user" doesn't exist} +} -result {could not read "~_totally_bogus_user": no such file or directory} test fCmd-27.3 {TclFileAttrsCmd - all attributes} -setup { catch {file delete -force -- foo.tmp} } -body { @@ -2556,6 +2655,57 @@ test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notInCIenv} - } return $r } -result {exists 1 readable 0 stat 0 {}} + +test fCmd-31.1 {file home} -body { + file home +} -result [file join $::env(HOME)] +test fCmd-31.2 {file home - obeys env} -setup { + set ::env(HOME) $::env(HOME)/xxx +} -cleanup { + set ::env(HOME) [file dirname $::env(HOME)] +} -body { + file home +} -result [file join $::env(HOME) xxx] +test fCmd-31.3 {file home - \ -> /} -constraints win -setup { + set saved $::env(HOME) + set ::env(HOME) C:\\backslash\\path +} -cleanup { + set ::env(HOME) $saved +} -body { + file home +} -result C:/backslash/path +test fCmd-31.4 {file home - error} -setup { + set saved $::env(HOME) + unset ::env(HOME) +} -cleanup { + set ::env(HOME) $saved +} -body { + file home +} -returnCodes error -result {couldn't find HOME environment variable to expand path} +test fCmd-31.5 { + file home - relative path. Following 8.x ~ expansion behavior, relative + paths are not made absolute +} -setup { + set saved $::env(HOME) + set ::env(HOME) relative/path +} -cleanup { + set ::env(HOME) $saved +} -body { + file home +} -result relative/path +test fCmd-31.6 {file home USER} -body { + # Note - as in 8.x this form does NOT necessarily give same result as + # env(HOME) even when user is current user. Assume result contains user + # name, else not sure how to check + file home $::tcl_platform(user) +} -match glob -result "*$::tcl_platform(user)*" +test fCmd-31.6 {file home UNKNOWNUSER} -body { + file home nosuchuser +} -returnCodes error -result {user "nosuchuser" doesn't exist} +test fCmd-31.7 {file home extra arg} -body { + file home $::tcl_platform(user) arg +} -returnCodes error -result {wrong # args: should be "file home ?user?"} + # cleanup cleanup diff --git a/tests/fileName.test b/tests/fileName.test index 04273d7..0dd6f86 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -71,15 +71,15 @@ test filename-1.4 {Tcl_GetPathType: unix} {testsetplatform} { test filename-1.5 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~ -} absolute +} relative test filename-1.6 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~/foo -} absolute +} relative test filename-1.7 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~foo -} absolute +} relative test filename-1.8 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ./~foo @@ -136,15 +136,15 @@ test filename-3.12 {Tcl_GetPathType: windows} {testsetplatform} { test filename-3.13 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~foo -} absolute +} relative test filename-3.14 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~ -} absolute +} relative test filename-3.15 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~/foo -} absolute +} relative test filename-3.16 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ./~foo @@ -213,11 +213,11 @@ test filename-4.15 {Tcl_SplitPath: unix} {testsetplatform} { test filename-4.16 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo/~bar -} {~foo ./~bar} +} {~foo ~bar} test filename-4.17 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo/~bar/~baz -} {~foo ./~bar ./~baz} +} {~foo ~bar ~baz} test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo/bar~/baz @@ -357,11 +357,11 @@ test filename-6.26 {Tcl_SplitPath: win} {testsetplatform} { test filename-6.27 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo/~bar -} {~foo ./~bar} +} {~foo ~bar} test filename-6.28 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo/~bar/~baz -} {~foo ./~bar ./~baz} +} {~foo ~bar ~baz} test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo/bar~/baz @@ -369,7 +369,7 @@ test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} { test filename-6.30 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:~foo -} {c: ./~foo} +} {c: ~foo} test filename-7.1 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix @@ -414,7 +414,7 @@ test filename-7.10 {Tcl_JoinPath: unix} {testsetplatform} { test filename-7.11 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ~a ~b -} {~b} +} {~a/~b} test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a b @@ -422,11 +422,11 @@ test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} { test filename-7.13 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a ~b -} {~b} +} {./~a/~b} test filename-7.14 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a ./~b -} {./~a/~b} +} {./~a/./~b} test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a . b @@ -434,7 +434,7 @@ test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} { test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a . ./~b -} {a/./~b} +} {a/././~b} test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join //a b @@ -490,11 +490,11 @@ test filename-9.10 {Tcl_JoinPath: win} {testsetplatform} { test filename-9.11 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~ ./~foo -} {~/~foo} +} {~/./~foo} test filename-9.12 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join / ~foo -} {~foo} +} {/~foo} test filename-9.13 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ./a/ b c @@ -600,7 +600,7 @@ test filename-10.6 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp -} -result {/home/test/foo} +} -result {~/foo} test filename-10.7 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -608,9 +608,9 @@ test filename-10.7 {Tcl_TranslateFileName} -setup { unset env(HOME) testsetplatform unix testtranslatefilename ~/foo -} -returnCodes error -cleanup { +} -cleanup { set env(HOME) $temp -} -result {couldn't find HOME environment variable to expand path} +} -result {~/foo} test filename-10.8 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -620,7 +620,7 @@ test filename-10.8 {Tcl_TranslateFileName} -setup { testtranslatefilename ~ } -cleanup { set env(HOME) $temp -} -result {/home/test} +} -result {~} test filename-10.9 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -630,7 +630,7 @@ test filename-10.9 {Tcl_TranslateFileName} -setup { testtranslatefilename ~ } -cleanup { set env(HOME) $temp -} -result {/home/test} +} -result {~} test filename-10.10 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -640,7 +640,7 @@ test filename-10.10 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp -} -result {/home/test/foo} +} -result {~/foo} test filename-10.17 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -650,7 +650,7 @@ test filename-10.17 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp -} -result {\home\foo} +} -result {~\foo} test filename-10.18 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -660,7 +660,7 @@ test filename-10.18 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo\\bar } -cleanup { set env(HOME) $temp -} -result {\home\foo\bar} +} -result {~\foo\bar} test filename-10.19 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -670,11 +670,11 @@ test filename-10.19 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp -} -result {c:foo} -test filename-10.20 {Tcl_TranslateFileName} -returnCodes error -body { +} -result {~\foo} +test filename-10.20 {Tcl_TranslateFileName} -body { testtranslatefilename ~blorp/foo } -constraints {testtranslatefilename testtranslatefilename} \ - -result {user "blorp" doesn't exist} + -result {~blorp\foo} test filename-10.21 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -684,7 +684,7 @@ test filename-10.21 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp -} -result {c:\foo} +} -result {~\foo} test filename-10.22 {Tcl_TranslateFileName} -body { testsetplatform windows testtranslatefilename foo//bar @@ -713,12 +713,13 @@ test filename-11.3 {Tcl_GlobCmd} -body { test filename-11.4 {Tcl_GlobCmd} -body { glob -nocomplain } -result {} -test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body { - glob -nocomplain * ~xyqrszzz -} -result {user "xyqrszzz" doesn't exist} +test filename-11.5 {Tcl_GlobCmd} -body { + # Should not error out because of ~ + catch {glob -nocomplain * ~xyqrszzz} +} -result 0 test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body { glob ~xyqrszzz -} -result {user "xyqrszzz" doesn't exist} +} -result {no files matched glob pattern "~xyqrszzz"} test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body { glob -- -nocomplain } -result {no files matched glob pattern "-nocomplain"} @@ -728,15 +729,15 @@ test filename-11.8 {Tcl_GlobCmd} -body { test filename-11.9 {Tcl_GlobCmd} -constraints {testsetplatform} -body { testsetplatform unix glob ~\\xyqrszzz/bar -} -returnCodes error -result {user "\xyqrszzz" doesn't exist} +} -returnCodes error -result {no files matched glob pattern "~\xyqrszzz/bar"} test filename-11.10 {Tcl_GlobCmd} -constraints {testsetplatform} -body { testsetplatform unix glob -nocomplain ~\\xyqrszzz/bar -} -returnCodes error -result {user "\xyqrszzz" doesn't exist} +} -result {} test filename-11.11 {Tcl_GlobCmd} -constraints {testsetplatform} -body { testsetplatform unix glob ~xyqrszzz\\/\\bar -} -returnCodes error -result {user "xyqrszzz" doesn't exist} +} -returnCodes error -result {no files matched glob pattern "~xyqrszzz\/\bar"} test filename-11.12 {Tcl_GlobCmd} -constraints {testsetplatform} -setup { testsetplatform unix set home $env(HOME) @@ -745,13 +746,13 @@ test filename-11.12 {Tcl_GlobCmd} -constraints {testsetplatform} -setup { glob ~/* } -returnCodes error -cleanup { set env(HOME) $home -} -result {couldn't find HOME environment variable to expand path} +} -result {no files matched glob pattern "~/*"} if {[testConstraint testsetplatform]} { testsetplatform $platform } -test filename-11.13 {Tcl_GlobCmd} { +test filename-11.13 {Tcl_GlobCmd} -body { file join [lindex [glob ~] 0] -} [file join $env(HOME)] +} -returnCodes error -result {no files matched glob pattern "~"} set oldpwd [pwd] set oldhome $env(HOME) catch {cd [makeDirectory tcl[pid]]} @@ -769,12 +770,12 @@ touch globTest/a1/b1/x2.c touch globTest/a1/b2/y2.c touch globTest/.1 touch globTest/x,z1.c -test filename-11.14 {Tcl_GlobCmd} { +test filename-11.14 {Tcl_GlobCmd} -body { glob ~/globTest -} [list [file join $env(HOME) globTest]] -test filename-11.15 {Tcl_GlobCmd} { +} -returnCodes error -result {no files matched glob pattern "~/globTest"} +test filename-11.15 {Tcl_GlobCmd} -body { glob ~\\/globTest -} [list [file join $env(HOME) globTest]] +} -returnCodes error -result {no files matched glob pattern "~\/globTest"} test filename-11.16 {Tcl_GlobCmd} { glob globTest } {globTest} @@ -1252,7 +1253,7 @@ test filename-14.17 {asterisks, question marks, and brackets} -setup { set temp $env(HOME) } -body { set env(HOME) [file join $env(HOME) globTest] - glob ~/z* + glob [file home]/z* } -cleanup { set env(HOME) $temp } -result [list [file join $env(HOME) globTest z1.c]] @@ -1349,11 +1350,10 @@ test filename-15.4 {unix specific no complain: no errors, good result} \ glob -nocomplain ~ouster ~foo ~welch } {/home/ouster /home/welch} test filename-15.4.1 {no complain: errors, sequencing} { - # test used to fail because if an error occurs, the interp's result is - # reset... But, the sequence means we throw a different error first. + # ~xxx no longer expanded so errors about unknown users should not occur list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1 \ [catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2 -} {1 {user "wontexist" doesn't exist} 1 {user "blahxyz" doesn't exist}} +} {0 {} 0 {}} test filename-15.4.2 {no complain: errors, sequencing} -body { # test used to fail because if an error occurs, the interp's result is # reset... @@ -1363,20 +1363,12 @@ test filename-15.4.2 {no complain: errors, sequencing} -body { test filename-15.5 {unix specific globbing} {unix nonPortable} { glob ~ouster/.csh* } "/home/ouster/.cshrc" -touch globTest/odd\\\[\]*?\{\}name -test filename-15.6 {unix specific globbing} -constraints {unix} -setup { - global env - set temp $env(HOME) -} -body { - set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name - glob ~ -} -cleanup { - set env(HOME) $temp -} -result [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name] -catch {file delete -force globTest/odd\\\[\]*?\{\}name} -test filename-15.7 {win specific globbing} -constraints {win} -body { +# 15.6 removed. It checked if glob ~ returned valid information if +# home directory contained glob chars. Since ~ expansion is no longer +# supported, the test was meaningless +test filename-15.7 {glob tilde} -body { glob ~ -} -match regexp -result {[^/]$} +} -returnCodes error -result {no files matched glob pattern "~"} test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -setup { global env set temp $env(HOME) @@ -1387,7 +1379,7 @@ test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -se } -cleanup { set env(HOME) $temp catch {file delete -force $env(HOME)/globTest/anyname} -} -result [list [lindex [glob ~] 0]/globTest/anyname] +} -returnCodes error -result {no files matched glob pattern "~"} # The following tests are only valid for Windows systems. set oldDir [pwd] @@ -1566,7 +1558,7 @@ test fileName-20.5 {Bug 2837800} -setup { test fileName-20.6 {Bug 2837800} -setup { # Recall that we have $env(HOME) set so that references # to ~ point to [temporaryDirectory] - makeFile {} test ~ + makeFile {} test [file home] set dd [makeDirectory isolate] set d [makeDirectory ./~ $dd] set savewd [pwd] @@ -1602,33 +1594,21 @@ test fileName-20.8 {Bug 2806250} -setup { removeFile ./~test $d removeDirectory isolate cd $savewd -} -result ./~test -test fileName-20.9 {globbing for special chars} -setup { - makeFile {} test ~ - set d [makeDirectory isolate] - set savewd [pwd] - cd $d -} -body { - glob -nocomplain -directory ~ test -} -cleanup { - cd $savewd - removeDirectory isolate - removeFile test ~ -} -result ~/test +} -result ~test test fileName-20.10 {globbing for special chars} -setup { - set s [makeDirectory sub ~] + set s [makeDirectory sub [file home]] makeFile {} fileName-20.10 $s set d [makeDirectory isolate] set savewd [pwd] cd $d } -body { - glob -nocomplain -directory ~ -join * fileName-20.10 + glob -nocomplain -directory [file home] -join * fileName-20.10 } -cleanup { cd $savewd removeDirectory isolate removeFile fileName-20.10 $s - removeDirectory sub ~ -} -result ~/sub/fileName-20.10 + removeDirectory sub [file home] +} -result [file home]/sub/fileName-20.10 # cleanup catch {file delete -force C:/globTest} diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 0b53be5..462b61e 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -267,15 +267,14 @@ file delete -force [file join dir.dir dirinside.link] removeFile [file join dir.dir inside.file] removeDirectory [file join dir.dir dirinside.dir] removeDirectory dir.dir -test filesystem-1.30 {normalisation of nonexistent user} -body { +test filesystem-1.30 { + normalisation of nonexistent user - verify no tilde expansion +} -body { file normalize ~noonewiththisname -} -returnCodes error -result {user "noonewiththisname" doesn't exist} +} -result [file join [pwd] ~noonewiththisname] test filesystem-1.30.1 {normalisation of existing user} -body { - catch {file normalize ~$::tcl_platform(user)} -} -result {0} -test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} -body { - file normalize ~nonexistentuser@nonexistentdomain -} -returnCodes error -result {user "nonexistentuser@nonexistentdomain" doesn't exist} + file normalize ~$::tcl_platform(user) +} -result [file join [pwd] ~$::tcl_platform(user)] test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} { testsetplatform unix file normalize /foo/../bar @@ -473,7 +472,10 @@ test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body { return $filesystemReport } -match glob -result {*{matchindirectory *}*} -test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup { +# This test is meaningless if there is no tilde expansion +test filesystem-5.1 {cache and ~} -constraints { + testfilesystem tildeexpansion +} -setup { set orig $::env(HOME) } -body { set ::env(HOME) /foo/bar/blah @@ -939,7 +941,7 @@ test filesystem-9.7 {path objects and glob and file tail and tilde} -setup { cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir -} -result {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} +} -result {1 0 ~testNotExist ~testNotExist 1 0 ~testNotExist 0 ~testNotExist} test filesystem-9.8 {path objects and glob and file tail and tilde} -setup { set res {} set origdir [pwd] @@ -957,7 +959,7 @@ test filesystem-9.8 {path objects and glob and file tail and tilde} -setup { cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir -} -result {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} +} -result {~testNotExist ~testNotExist 0 ~testNotExist 0 ~testNotExist} test filesystem-9.9 {path objects and glob and file tail and tilde} -setup { set res {} set origdir [pwd] @@ -975,7 +977,7 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} -setup { cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir -} -result {0 0 0 0 1} +} -result {0 1 0 1 1} # ---------------------------------------------------------------------- diff --git a/tests/io.test b/tests/io.test index dca88a4..c4a6b5a 100644 --- a/tests/io.test +++ b/tests/io.test @@ -5956,7 +5956,7 @@ test io-40.17 {tilde substitution in open} { set x [list [catch {open ~/foo} msg] $msg] set ::env(HOME) $home set x -} {1 {couldn't find HOME environment variable to expand path}} +} {1 {couldn't open "~/foo": no such file or directory}} test io-41.1 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent foo} msg] $msg diff --git a/tests/safe.test b/tests/safe.test index c355171..6fc4fbe 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -1621,7 +1621,7 @@ test safe-16.5 {Bug 3529949: defang ~ in paths used by AliasGlob (1)} -setup { safe::interpDelete $i set env(HOME) $savedHOME unset savedHOME -} -result {~} +} -result {$p(:0:)/~} test safe-16.6 {Bug 3529949: defang ~ in paths used by AliasGlob (2)} -setup { set savedHOME $env(HOME) set env(HOME) /foo/bar @@ -1635,7 +1635,7 @@ test safe-16.6 {Bug 3529949: defang ~ in paths used by AliasGlob (2)} -setup { safe::interpDelete $i set env(HOME) $savedHOME unset savedHOME -} -result {~} +} -result {$p(:0:)/foo/bar/~} test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup { set i [safe::interpCreate] set user $tcl_platform(user) @@ -1644,7 +1644,7 @@ test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup } -cleanup { safe::interpDelete $i unset user -} -result {~USER} +} -result {$p(:0:)/~USER} test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup { set i [safe::interpCreate] set user $tcl_platform(user) @@ -1653,7 +1653,7 @@ test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup } -cleanup { safe::interpDelete $i unset user -} -result {~USER} +} -result {$p(:0:)/foo/bar/~USER} # cleanup set ::auto_path $SaveAutoPath diff --git a/tests/winFile.test b/tests/winFile.test index 0c13a0e..38f6954 100644 --- a/tests/winFile.test +++ b/tests/winFile.test @@ -28,7 +28,7 @@ testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}] test winFile-1.1 {TclpGetUserHome} -constraints {win} -body { glob ~nosuchuser -} -returnCodes error -result {user "nosuchuser" doesn't exist} +} -returnCodes error -result {no files matched glob pattern "~nosuchuser"} test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body { # The administrator account should always exist. glob ~administrator |