Update tests for TIP 602

1 files changed, 185 insertions, 35 deletions

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