Fix env.test, when running under wine 1.3 (partly backported from Tcl 8.6)

1 files changed, 33 insertions, 19 deletions

diff --git a/tests/env.test b/tests/env.test
index a4669d2..6c3c137 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -1,23 +1,22 @@
 # Commands covered:  none (tests environment variable implementation)
 #
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 package require tcltest 2
 namespace import -force ::tcltest::*
 
 #
-# These tests will run on any platform (and indeed crashed
-# on the Mac).  So put them before you test for the existance
-# of exec.
+# These tests will run on any platform (and indeed crashed on the Mac). So put
+# them before you test for the existance of exec.
 #
 test env-1.1 {propagation of env values to child interpreters} {
     catch {interp delete child}
@@ -30,8 +29,8 @@ test env-1.1 {propagation of env values to child interpreters} {
     set return
 } {garbage}
 #
-# This one crashed on Solaris under Tcl8.0, so we only
-# want to make sure it runs.
+# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
+# runs.
 #
 test env-1.2 {lappend to env value} {
     catch {unset env(test)}
@@ -65,28 +64,37 @@ set printenvScript [makeFile {
 	}
 	return $list
     }
-	
+    proc mangle s {
+	regsub -all {\[|\\|\]} $s {\\&} s
+	regsub -all {[\u0000-\u001f\u007f-\uffff]} $s {[manglechar &]} s
+	return [subst -novariables $s]
+    }
+    proc manglechar c {
+	return [format {\u%04x} [scan $c %c]]
+    }
+
     set names [lsort [array names env]]
     if {$tcl_platform(platform) == "windows"} {
 	lrem names HOME
         lrem names COMSPEC
 	lrem names ComSpec
 	lrem names ""
-    }	
+    }
     foreach name {
 	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
 	SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
 	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
-	__CF_USER_TEXT_ENCODING SECURITYSESSIONID
+	__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
+	CommonProgramFiles ProgramFiles
     } {
 	lrem names $name
     }
     foreach p $names {
-	puts "$p=$env($p)"
+	puts "[mangle $p]=[mangle $env($p)]"
     }
     exit
 } printenv]
-	
+
 # [exec] is required here to see the actual environment received
 # by child processes.
 proc getenv {} {
@@ -112,7 +120,9 @@ foreach name {
 	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
 	SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
 	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
-	SECURITYSESSIONID} {
+	SECURITYSESSIONID LANG WINDIR TERM
+	CommonProgramFiles ProgramFiles
+    } {
     if {[info exists env2($name)]} {
 	set env($name) $env2($name);
     }
@@ -165,18 +175,18 @@ test env-4.2 {unsetting environment variables} {exec} {
 test env-4.3 {setting international environment variables} {exec} {
     set env(\ua7) \ub6
     getenv
-} "\ua7=\ub6"
+} {\u00a7=\u00b6}
 test env-4.4 {changing international environment variables} {exec} {
     set env(\ua7) \ua7
     getenv
-} "\ua7=\ua7"
+} {\u00a7=\u00a7}
 test env-4.5 {unsetting international environment variables} {exec} {
     set env(\ub6) \ua7
     unset env(\ua7)
     set result [getenv]
     unset env(\ub6)
     set result
-} "\ub6=\ua7"
+} {\u00b6=\u00a7}
 
 test env-5.0 {corner cases - set a value, it should exist} {} {
     set env(temp) a
@@ -259,3 +269,7 @@ foreach name [array names env2] {
 removeFile $printenvScript
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End: