diff options
Diffstat (limited to 'tests/env.test')
-rw-r--r-- | tests/env.test | 272 |
1 files changed, 169 insertions, 103 deletions
diff --git a/tests/env.test b/tests/env.test index a7aa162..0dd4f98 100644 --- a/tests/env.test +++ b/tests/env.test @@ -19,44 +19,47 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # 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} { +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. # -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] @@ -67,7 +70,7 @@ set printenvScript [makeFile { } proc mangle s { regsub -all {\[|\\|\]} $s {\\&} s - regsub -all {[\u0000-\u001f\u007f-\uffff]} $s {[manglechar &]} s + regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s return [subst -novariables $s] } proc manglechar c { @@ -75,7 +78,7 @@ set printenvScript [makeFile { } 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 @@ -96,12 +99,12 @@ set printenvScript [makeFile { 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 @@ -124,148 +127,211 @@ foreach name [array names env] { } } -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 + set env(NAME1) "test string" +} -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 + set env(NAME1) "test string" + set env(NAME2) "more" +} -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(NAME1) "test string" set env(NAME2) "new value" -test env-3.1 {changing environment variables} {exec} { +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 -} {NAME1=test string +} -cleanup { + encoding system $sysenc +} -result {NAME1=test string NAME2=new value XYZZY=garbage} +unset -nocomplain env(NAME2) -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} +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 -} {\u00a7=\u00b6} -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 -} {\u00a7=\u00a7} -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 + set env(\ua7) \ua7 +} -body { set env(\ub6) \ua7 unset env(\ua7) - set result [getenv] + getenv +} -constraints {exec} -cleanup { unset env(\ub6) - set result -} {\u00b6=\u00a7} + encoding system $sysenc +} -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} -test env-5.5 {corner cases - cannot have null entries on Windows} {win} { +} -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()} -} {1} +} -result 1 -test env-6.1 {corner cases - add lots of env variables} {} { +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} -} 100 +} -result 100 -test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body { - catch {unset ::env(test7_3)} - proc foo args { - set ::env(test7_3) ok +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 } - trace add variable ::env(not_yet_existent) write foo - info exists ::env(not_yet_existent) - set ::env(not_yet_existent) "Now I'm here"; - info exists ::env(test7_3) -} -cleanup { - unset ::env(not_yet_existent) - unset ::env(test7_3) -} -result 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] { |