diff options
author | apnadkarni <apnmbx-wits@yahoo.com> | 2023-03-05 11:09:10 (GMT) |
---|---|---|
committer | apnadkarni <apnmbx-wits@yahoo.com> | 2023-03-05 11:09:10 (GMT) |
commit | 6e7d72c158143064e634c6d95f4c1107178d4b31 (patch) | |
tree | 565e6bea632b352b6efffb60b8ba2a7df5c48af1 /tests/fCmd.test | |
parent | 7b3ef36925e938aa7a1aff22d3d3e521e32f243d (diff) | |
parent | 1f7d2aae34515de9d6d64ab799f670a1ce5141fc (diff) | |
download | tcl-6e7d72c158143064e634c6d95f4c1107178d4b31.zip tcl-6e7d72c158143064e634c6d95f4c1107178d4b31.tar.gz tcl-6e7d72c158143064e634c6d95f4c1107178d4b31.tar.bz2 |
Merge 8.6: Bug [9c5a00c69d]. Fix ~user on Windows
Diffstat (limited to 'tests/fCmd.test')
-rw-r--r-- | tests/fCmd.test | 66 |
1 files changed, 61 insertions, 5 deletions
diff --git a/tests/fCmd.test b/tests/fCmd.test index 13f4cf1..246d65b 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -27,7 +27,7 @@ testConstraint winLessThan10 0 testConstraint notNetworkFilesystem 0 testConstraint reg 0 if {[testConstraint win]} { - catch { + if {[catch { # Is the registry extension already static to this shell? try { load {} Registry @@ -38,8 +38,11 @@ if {[testConstraint win]} { load $::reglib Registry } testConstraint reg 1 + } regError]} { + catch {package require registry; testConstraint reg 1} } } + testConstraint notInCIenv [expr {![info exists ::env(CI)] || !$::env(CI)}] # File permissions broken on wsl without some "exotic" wsl configuration @@ -100,6 +103,45 @@ if {[testConstraint unix]} { } } +# Try getting a lower case glob pattern that will match the home directory of +# a given user to test ~user and [file tildeexpand ~user]. Note this may not +# be the same as ~ even when "user" is current user. For example, on Unix +# platforms ~ will return HOME envvar, but ~user will lookup password file +# bypassing HOME. If home directory not found, returns *$user* so caller can +# succeed by using glob matching under the hope that the path contains +# the user name. +proc gethomedirglob {user} { + if {[testConstraint unix]} { + if {![catch { + exec {*}[auto_execok sh] -c "echo ~$user" + } home]} { + set home [string trim $home] + if {$home ne ""} { + # Expect exact match (except case), no glob * added + return [string tolower $home] + } + } + } elseif {[testConstraint reg]} { + # Windows with registry extension loaded + if {![catch { + set sid [exec {*}[auto_execok powershell] -Command "(Get-LocalUser -Name '$user')\[0\].sid.Value"] + set sid [string trim $sid] + # Get path from the Windows registry + set home [registry get "HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Windows NT\\CurrentVersion\\ProfileList\\$sid" ProfileImagePath] + set home [string trim $home] + } result]} { + if {$home ne ""} { + # file join for \ -> / + return [file join [string tolower $home]] + } + } + } + + # Caller will need to use glob matching and hope user + # name is in the home directory path + return *$user* +} + proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string @@ -2602,13 +2644,20 @@ test fCmd-31.6 {file home USER} -body { # env(HOME) even when user is current user. Assume result contains user # name, else not sure how to check string tolower [file home $::tcl_platform(user)] -} -match glob -result [string tolower "*$::tcl_platform(user)*"] +} -match glob -result [gethomedirglob $::tcl_platform(user)] test fCmd-31.7 {file home UNKNOWNUSER} -body { file home nosuchuser } -returnCodes error -result {user "nosuchuser" doesn't exist} test fCmd-31.8 {file home extra arg} -body { file home $::tcl_platform(user) arg } -returnCodes error -result {wrong # args: should be "file home ?user?"} +test fCmd-31.9 {file home USER does not follow env(HOME)} -setup { + set ::env(HOME) [file join $::env(HOME) foo] +} -cleanup { + set ::env(HOME) [file dirname $::env(HOME)] +} -body { + string tolower [file home $::tcl_platform(user)] +} -match glob -result [gethomedirglob $::tcl_platform(user)] test fCmd-32.1 {file tildeexpand ~} -body { file tildeexpand ~ @@ -2644,7 +2693,7 @@ test fCmd-32.5 {file tildeexpand ~USER} -body { # env(HOME) even when user is current user. Assume result contains user # name, else not sure how to check string tolower [file tildeexpand ~$::tcl_platform(user)] -} -match glob -result [string tolower "*$::tcl_platform(user)*"] +} -match glob -result [gethomedirglob $::tcl_platform(user)] test fCmd-32.6 {file tildeexpand ~UNKNOWNUSER} -body { file tildeexpand ~nosuchuser } -returnCodes error -result {user "nosuchuser" doesn't exist} @@ -2659,7 +2708,7 @@ test fCmd-32.9 {file tildeexpand ~USER/bar} -body { # env(HOME) even when user is current user. Assume result contains user # name, else not sure how to check string tolower [file tildeexpand ~$::tcl_platform(user)/bar] -} -match glob -result [string tolower "*$::tcl_platform(user)*/bar"] +} -match glob -result [file join [gethomedirglob $::tcl_platform(user)] bar] test fCmd-32.10 {file tildeexpand ~UNKNOWNUSER} -body { file tildeexpand ~nosuchuser/foo } -returnCodes error -result {user "nosuchuser" doesn't exist} @@ -2683,7 +2732,14 @@ test fCmd-32.16 {file tildeexpand ~USER\\bar} -body { # env(HOME) even when user is current user. Assume result contains user # name, else not sure how to check string tolower [file tildeexpand ~$::tcl_platform(user)\\bar] -} -constraints win -match glob -result [string tolower "*$::tcl_platform(user)*/bar"] +} -constraints win -match glob -result [file join [gethomedirglob $::tcl_platform(user)] bar] +test fCmd-32.17 {file tildeexpand ~USER does not mirror HOME} -setup { + set ::env(HOME) [file join $::env(HOME) foo] +} -cleanup { + set ::env(HOME) [file dirname $::env(HOME)] +} -body { + string tolower [file tildeexpand ~$::tcl_platform(user)] +} -match glob -result [gethomedirglob $::tcl_platform(user)] # cleanup |