diff options
| -rw-r--r-- | tests/env.test | 40 | ||||
| -rw-r--r-- | win/tclWinInit.c | 9 |
2 files changed, 47 insertions, 2 deletions
diff --git a/tests/env.test b/tests/env.test index 905cdab..ea58b26 100644 --- a/tests/env.test +++ b/tests/env.test @@ -105,6 +105,7 @@ variable keep { CommonProgramFiles CommonProgramFiles(x86) ProgramFiles ProgramFiles(x86) CommonProgramW6432 ProgramW6432 WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR PROCESSOR_ARCHITECTURE + USERPROFILE } variable printenvScript [makeFile [string map [list @keep@ [list $keep]] { @@ -409,7 +410,7 @@ test env-7.3 { return [info exists ::env(test7_3)] }} } -cleanup cleanup1 -result 1 - + test env-8.0 { memory usage - valgrind does not report reachable memory } -body { @@ -419,6 +420,43 @@ test env-8.0 { } -result {i'm with dummy} +test env-9.0 { + Initialization of HOME from HOMEDRIVE and HOMEPATH +} -constraints win -setup { + setup1 + unset -nocomplain ::env(HOME) + set ::env(HOMEDRIVE) X: + set ::env(HOMEPATH) \\home\\path +} -cleanup { + cleanup1 +} -body { + set pipe [open |[list [interpreter]] r+] + puts $pipe {puts $::env(HOME); flush stdout; exit} + flush $pipe + set result [gets $pipe] + close $pipe + set result +} -result {X:\home\path} + +test env-9.1 { + Initialization of HOME from USERPROFILE +} -constraints win -setup { + setup1 + unset -nocomplain ::env(HOME) + unset -nocomplain ::env(HOMEDRIVE) + unset -nocomplain ::env(HOMEPATH) +} -cleanup { + cleanup1 +} -body { + set pipe [open |[list [interpreter]] r+] + puts $pipe {puts $::env(HOME); flush stdout; exit} + flush $pipe + set result [gets $pipe] + close $pipe + set result +} -result $::env(USERPROFILE) + + # cleanup rename getenv {} diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 4f59c1a..eae4404 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -593,7 +593,14 @@ TclpSetVariables( Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); } else { - Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); + /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ + ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); + if (ptr != NULL && ptr[0]) { + Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); + } else { + /* Last resort */ + Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); + } } } |