diff options
Diffstat (limited to 'tcl8.6/tests/env.test')
| -rw-r--r-- | tcl8.6/tests/env.test | 349 |
1 files changed, 349 insertions, 0 deletions
diff --git a/tcl8.6/tests/env.test b/tcl8.6/tests/env.test new file mode 100644 index 0000000..0dd4f98 --- /dev/null +++ b/tcl8.6/tests/env.test @@ -0,0 +1,349 @@ +# 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. +# +# 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. + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 + namespace import -force ::tcltest::* +} + +# Some tests require the "exec" command. +# Skip them if exec is not defined. +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. +# +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 + child eval {set env(test)} +} -cleanup { + interp delete child + unset env(test) +} -result {garbage} +# +# 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} -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"} -setup { + catch {interp delete child} + catch {unset env(test)} +} -body { + interp create child + child eval {set env(test) garbage} + expr {"test" in [array names env]} +} -cleanup { + interp delete child + catch {unset env(test)} +} -result {1} + +set printenvScript [makeFile { + encoding system iso8859-1 + proc lrem {listname name} { + upvar $listname list + set i [lsearch -nocase $list $name] + if {$i >= 0} { + set list [lreplace $list $i $i] + } + 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) 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 + DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING + __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM + CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432 + } { + lrem names $name + } + foreach p $names { + puts "[mangle $p]=[mangle $env($p)]" + } + exit +} printenv] + +# [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 eq "child process exited abnormally"} { + set out {} + } + return $out +} + +# Save the current environment variables at the start of the test. + +set env2 [array get env] +foreach name [array names env] { + # 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 + CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432 + }} { + unset env($name) + } +} + +# Need to run 'getenv' in known encoding, so save the current one here... +set sysenc [encoding system] + +test env-2.1 {adding environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { + getenv +} -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 +} -cleanup { + encoding system $sysenc +} -result {NAME1=test string} +test env-2.3 {adding environment variables} -setup { + encoding system iso8859-1 + set env(NAME1) "test string" +} -constraints {exec} -body { + set env(NAME2) "more" + getenv +} -cleanup { + encoding system $sysenc +} -result {NAME1=test string +NAME2=more} +test env-2.4 {adding environment variables} -setup { + encoding system iso8859-1 + set env(NAME1) "test string" + set env(NAME2) "more" +} -constraints {exec} -body { + set env(XYZZY) "garbage" + getenv +} -cleanup { + encoding system $sysenc +} -result {NAME1=test string +NAME2=more +XYZZY=garbage} + +set env(NAME1) "test string" +set env(NAME2) "new value" +set env(XYZZY) "garbage" +test env-3.1 {changing environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { + set result [getenv] + unset env(NAME2) + set result +} -cleanup { + encoding system $sysenc +} -result {NAME1=test string +NAME2=new value +XYZZY=garbage} +unset -nocomplain env(NAME2) + +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} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { + unset env(NAME1) + getenv +} -cleanup { + unset env(XYZZY) + encoding system $sysenc +} -result {XYZZY=garbage} +unset -nocomplain env(NAME1) env(XYZZY) +test env-4.3 {setting international environment variables} -setup { + encoding system iso8859-1 +} -constraints {exec} -body { + set env(\ua7) \ub6 + getenv +} -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 +} -cleanup { + encoding system $sysenc +} -result {\u00a7=\u00a7} +test env-4.5 {unsetting international environment variables} -setup { + encoding system iso8859-1 + set env(\ua7) \ua7 +} -body { + set env(\ub6) \ua7 + unset env(\ua7) + getenv +} -constraints {exec} -cleanup { + unset env(\ub6) + encoding system $sysenc +} -result {\u00b6=\u00a7} + +test env-5.0 {corner cases - set a value, it should exist} -body { + set env(temp) a + set env(temp) +} -cleanup { + unset env(temp) +} -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) + } + array size env +} -cleanup { + array set env $x +} -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 +} -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 +} -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 + 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 +} -result {1 a 1} +test env-5.5 {corner cases - cannot have null entries on Windows} -constraints win -body { + set env() a + catch {set env()} +} -result 1 + +test env-6.1 {corner cases - add lots of env variables} -body { + set size [array size env] + for {set i 0} {$i < 100} {incr i} { + set env(BOGUS$i) $i + } + expr {[array size env] - $size} +} -result 100 + +test env-7.1 {[219226]: whole env array should not be unset by read} -body { + set n [array size env] + set s [array startsearch env] + while {[array anymore env $s]} { + array nextelement env $s + incr n -1 + } + array donesearch env $s + return $n +} -result 0 + +test env-7.2 {[219226]: links to env elements should not be removed by read} -body { + apply {{} { + set ::env(test7_2) ok + upvar env(test7_2) elem + set ::env(PATH) + return $elem + }} +} -result ok + +test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body { + apply {{} { + catch {unset ::env(test7_3)} + proc foo args { + set ::env(test7_3) ok + } + trace add variable ::env(not_yet_existent) write foo + info exists ::env(not_yet_existent) + set ::env(not_yet_existent) "Now I'm here"; + return [info exists ::env(test7_3)] + }} +} -result 1 + +# Restore the environment variables at the end of the test. + +foreach name [array names env] { + unset env($name) +} +array set env $env2 + +# cleanup +removeFile $printenvScript +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: |