summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2011-10-07 21:16:34 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2011-10-07 21:16:34 (GMT)
commit60a0f32055ec6d3f76e3261646cfe1b63c688a4a (patch)
tree4f37d3dbd261ee5e9597217422ce34844c180d75
parentdcc0c4435072feac4c32f8947c650f9123d1f184 (diff)
parent391054f69af9bba47e19c096295d0711b49b3321 (diff)
downloadtcl-60a0f32055ec6d3f76e3261646cfe1b63c688a4a.zip
tcl-60a0f32055ec6d3f76e3261646cfe1b63c688a4a.tar.gz
tcl-60a0f32055ec6d3f76e3261646cfe1b63c688a4a.tar.bz2
Fix env.test, when running under wine 1.3 (partly backported from Tcl 8.6)
-rw-r--r--ChangeLog2
-rw-r--r--tests/env.test66
2 files changed, 40 insertions, 28 deletions
diff --git a/ChangeLog b/ChangeLog
index 6286484..e430f32 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,8 @@
* generic/tclIORChan.c: Fix gcc warning
(discovered with latest mingw, based on gcc 4.6.1)
+ * tests/env.test: Fix env.test, when running
+ under wine 1.3 (partly backported from Tcl 8.6)
2011-10-03 Venkat Iyer <venkat@comit.com>
diff --git a/tests/env.test b/tests/env.test
index 47ada47..c42e49d 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -1,15 +1,15 @@
# 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.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -21,9 +21,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
testConstraint exec [llength [info commands 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.
+# 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}
@@ -36,8 +35,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)}
@@ -66,28 +65,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 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 {} {
@@ -101,16 +109,16 @@ proc getenv {} {
# Save the current environment variables at the start of the test.
+set env2 [array get env]
foreach name [array names env] {
- set env2($name) $env($name)
-
- # Keep some environment variables that support operation of the
- # tcltest package.
+ # Keep some environment variables that support operation of the tcltest
+ # package.
if {[string toupper $name] ni {
- 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 LANG WINDIR TERM
+ 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 LANG WINDIR TERM
+ CommonProgramFiles ProgramFiles
}} {
unset env($name)
}
@@ -163,18 +171,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
@@ -249,11 +257,13 @@ test env-6.1 {corner cases - add lots of env variables} {} {
foreach name [array names env] {
unset env($name)
}
-foreach name [array names env2] {
- set env($name) $env2($name)
-}
+array set env $env2
# cleanup
removeFile $printenvScript
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: