diff options
Diffstat (limited to 'tests/env.test')
| -rw-r--r-- | tests/env.test | 266 |
1 files changed, 156 insertions, 110 deletions
diff --git a/tests/env.test b/tests/env.test index 47ada47..9c417d9 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,43 +21,45 @@ 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} { +test env-1.1 {propagation of env values to child interpreters} -setup { catch {interp delete child} catch {unset env(test)} +} -body { interp create child set env(test) garbage - set return [child eval {set env(test)}] + child eval {set env(test)} +} -cleanup { interp delete child unset env(test) - set return -} {garbage} +} -result {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} { +test env-1.2 {lappend to env value} -setup { catch {unset env(test)} +} -body { set env(test) aaaaaaaaaaaaaaaa append env(test) bbbbbbbbbbbbbb unset env(test) -} {} -test env-1.3 {reflection of env by "array names"} { +} +test env-1.3 {reflection of env by "array names"} -setup { catch {interp delete child} catch {unset env(test)} +} -body { interp create child child eval {set env(test) garbage} - set names [array names env] + expr {"test" in [array names env]} +} -cleanup { interp delete child - set ix [lsearch $names test] catch {unset env(test)} - expr {$ix >= 0} -} {1} +} -result {1} set printenvScript [makeFile { + encoding system iso8859-1 proc lrem {listname name} { upvar $listname list set i [lsearch -nocase $list $name] @@ -66,14 +68,22 @@ 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"} { + if {$tcl_platform(platform) eq "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 @@ -83,17 +93,16 @@ set printenvScript [makeFile { 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. +# [exec] is required here to see the actual environment received by child +# processes. proc getenv {} { global printenvScript tcltest catch {exec [interpreter] $printenvScript} out - if {$out == "child process exited abnormally"} { + if {$out eq "child process exited abnormally"} { set out {} } return $out @@ -101,136 +110,171 @@ 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 }} { unset env($name) } } -test env-2.1 {adding environment variables} {exec} { - getenv -} {} +# Need to run 'getenv' in known encoding, so save the current one here... +set sysenc [encoding system] -set env(NAME1) "test string" -test env-2.2 {adding environment variables} {exec} { +test env-2.1 {adding environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { getenv -} {NAME1=test string} - -set env(NAME2) "more" -test env-2.3 {adding environment variables} {exec} { +} -cleanup { + encoding system $sysenc +} -result {} +test env-2.2 {adding environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { + set env(NAME1) "test string" getenv -} {NAME1=test string +} -cleanup { + encoding system $sysenc +} -result {NAME1=test string} +test env-2.3 {adding environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { + set env(NAME2) "more" + getenv +} -cleanup { + encoding system $sysenc +} -result {NAME1=test string NAME2=more} - -set env(XYZZY) "garbage" -test env-2.4 {adding environment variables} {exec} { +test env-2.4 {adding environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { + set env(XYZZY) "garbage" getenv -} {NAME1=test string +} -cleanup { + encoding system $sysenc +} -result {NAME1=test string NAME2=more XYZZY=garbage} set env(NAME2) "new value" -test env-3.1 {changing environment variables} {exec} { +test env-3.1 {changing environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { set result [getenv] unset env(NAME2) set result -} {NAME1=test string +} -cleanup { + encoding system $sysenc +} -result {NAME1=test string NAME2=new value XYZZY=garbage} -test env-4.1 {unsetting environment variables} {exec} { - set result [getenv] - unset env(NAME1) - set result -} {NAME1=test string +test env-4.1 {unsetting environment variables: default} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { + getenv +} -cleanup { + encoding system $sysenc +} -result {NAME1=test string XYZZY=garbage} - -test env-4.2 {unsetting environment variables} {exec} { - set result [getenv] +test env-4.2 {unsetting environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { + unset env(NAME1) + getenv +} -cleanup { unset env(XYZZY) - set result -} {XYZZY=garbage} - -test env-4.3 {setting international environment variables} {exec} { + encoding system $sysenc +} -result {XYZZY=garbage} +test env-4.3 {setting international environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { set env(\ua7) \ub6 getenv -} "\ua7=\ub6" -test env-4.4 {changing international environment variables} {exec} { +} -cleanup { + encoding system $sysenc +} -result {\u00a7=\u00b6} +test env-4.4 {changing international environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { set env(\ua7) \ua7 getenv -} "\ua7=\ua7" -test env-4.5 {unsetting international environment variables} {exec} { +} -cleanup { + encoding system $sysenc +} -result {\u00a7=\u00a7} +test env-4.5 {unsetting international environment variables} -setup { + encoding system iso8859-1 +} -body { set env(\ub6) \ua7 unset env(\ua7) - set result [getenv] + getenv +} -constraints {exec} -cleanup { + encoding system $sysenc unset env(\ub6) - set result -} "\ub6=\ua7" +} -result {\u00b6=\u00a7} -test env-5.0 {corner cases - set a value, it should exist} {} { +test env-5.0 {corner cases - set a value, it should exist} -body { set env(temp) a - set result [set env(temp)] + set env(temp) +} -cleanup { unset env(temp) - set result -} {a} -test env-5.1 {corner cases - remove one elem at a time} {} { - # When no environment variables exist, the env var will - # contain no entries. The "array names" call synchs up - # the C-level environ array with the Tcl level env array. - # Make sure an empty Tcl array is created. - +} -result {a} +test env-5.1 {corner cases - remove one elem at a time} -setup { set x [array get env] +} -body { + # When no environment variables exist, the env var will contain no + # entries. The "array names" call synchs up the C-level environ array with + # the Tcl level env array. Make sure an empty Tcl array is created. foreach e [array names env] { unset env($e) } - set result [catch {array names env}] + array size env +} -cleanup { array set env $x - set result -} {0} -test env-5.2 {corner cases - unset the env array} {} { - # Unsetting a variable in an interp detaches the C-level - # traces from the Tcl "env" variable. - - interp create i - i eval { unset env } - i eval { set env(THIS_SHOULDNT_EXIST) a} - set result [info exists env(THIS_SHOULDNT_EXIST)] +} -result {0} +test env-5.2 {corner cases - unset the env array} -setup { + interp create i +} -body { + # Unsetting a variable in an interp detaches the C-level traces from the + # Tcl "env" variable. + i eval { + unset env + set env(THIS_SHOULDNT_EXIST) a + } + info exists env(THIS_SHOULDNT_EXIST) +} -cleanup { interp delete i - set result -} {0} -test env-5.3 {corner cases - unset the env in master should unset child} {} { - # Variables deleted in a master interp should be deleted in - # child interp too. - - interp create i +} -result {0} +test env-5.3 {corner cases: unset the env in master should unset child} -setup { + interp create i +} -body { + # Variables deleted in a master interp should be deleted in child interp + # too. i eval { set env(THIS_SHOULD_EXIST) a} set result [set env(THIS_SHOULD_EXIST)] unset env(THIS_SHOULD_EXIST) lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}] +} -cleanup { interp delete i - set result -} {a 1} -test env-5.4 {corner cases - unset the env array} {} { +} -result {a 1} +test env-5.4 {corner cases - unset the env array} -setup { + interp create i +} -body { # The info exists command should be in synch with the env array. # Know Bug: 1737 - - interp create i i eval { set env(THIS_SHOULD_EXIST) a} set result [info exists env(THIS_SHOULD_EXIST)] lappend result [set env(THIS_SHOULD_EXIST)] lappend result [info exists env(THIS_SHOULD_EXIST)] +} -cleanup { interp delete i - set result -} {1 a 1} +} -result {1 a 1} test env-5.5 {corner cases - cannot have null entries on Windows} {win} { set env() a catch {set env()} @@ -249,11 +293,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: |