diff options
Diffstat (limited to 'tests/env.test')
-rw-r--r-- | tests/env.test | 234 |
1 files changed, 86 insertions, 148 deletions
diff --git a/tests/env.test b/tests/env.test index 83d99e0..ee13b7f 100644 --- a/tests/env.test +++ b/tests/env.test @@ -24,42 +24,39 @@ 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 { +test env-1.1 {propagation of env values to child interpreters} { catch {interp delete child} catch {unset env(test)} -} -body { interp create child set env(test) garbage - child eval {set env(test)} -} -cleanup { + set return [child eval {set env(test)}] interp delete child unset env(test) -} -result {garbage} + set return +} {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 { +test env-1.2 {lappend to env value} { 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 { +} {} +test env-1.3 {reflection of env by "array names"} { 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 { + set names [array names env] interp delete child + set ix [lsearch $names test] catch {unset env(test)} -} -result {1} + expr {$ix >= 0} +} {1} set printenvScript [makeFile { - encoding system iso8859-1 proc lrem {listname name} { upvar $listname list set i [lsearch -nocase $list $name] @@ -70,7 +67,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 { @@ -78,7 +75,7 @@ set printenvScript [makeFile { } set names [lsort [array names env]] - if {$tcl_platform(platform) eq "windows"} { + if {$tcl_platform(platform) == "windows"} { lrem names HOME lrem names COMSPEC lrem names ComSpec @@ -99,12 +96,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 eq "child process exited abnormally"} { + if {$out == "child process exited abnormally"} { set out {} } return $out @@ -127,157 +124,121 @@ foreach name [array names env] { } } -# 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 { +test env-2.1 {adding environment variables} {exec} { 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" +} {} + +set env(NAME1) "test string" +test env-2.2 {adding environment variables} {exec} { getenv -} -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" +} {NAME1=test string} + +set env(NAME2) "more" +test env-2.3 {adding environment variables} {exec} { getenv -} -cleanup { - encoding system $sysenc -} -result {NAME1=test string +} {NAME1=test string NAME2=more} -test env-2.4 {adding environment variables} -setup { - encoding system iso8859-1 -} -constraints {exec} -body { - set env(XYZZY) "garbage" + +set env(XYZZY) "garbage" +test env-2.4 {adding environment variables} {exec} { getenv -} -cleanup { - encoding system $sysenc -} -result {NAME1=test string +} {NAME1=test string NAME2=more XYZZY=garbage} set env(NAME2) "new value" -test env-3.1 {changing environment variables} -setup { - encoding system iso8859-1 -} -constraints {exec} -body { +test env-3.1 {changing environment variables} {exec} { set result [getenv] unset env(NAME2) set result -} -cleanup { - encoding system $sysenc -} -result {NAME1=test string +} {NAME1=test string NAME2=new value XYZZY=garbage} -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 { +test env-4.1 {unsetting environment variables} {exec} { + set result [getenv] unset env(NAME1) - getenv -} -cleanup { + set result +} {NAME1=test string +XYZZY=garbage} + +test env-4.2 {unsetting environment variables} {exec} { + set result [getenv] unset env(XYZZY) - encoding system $sysenc -} -result {XYZZY=garbage} -test env-4.3 {setting international environment variables} -setup { - encoding system iso8859-1 -} -constraints {exec} -body { + set result +} {XYZZY=garbage} + +test env-4.3 {setting international environment variables} {exec} { 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 { +} {\u00a7=\u00b6} +test env-4.4 {changing international environment variables} {exec} { 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 -} -body { +} {\u00a7=\u00a7} +test env-4.5 {unsetting international environment variables} {exec} { set env(\ub6) \ua7 unset env(\ua7) - getenv -} -constraints {exec} -cleanup { + set result [getenv] unset env(\ub6) - encoding system $sysenc -} -result {\u00b6=\u00a7} + set result +} {\u00b6=\u00a7} -test env-5.0 {corner cases - set a value, it should exist} -body { +test env-5.0 {corner cases - set a value, it should exist} {} { set env(temp) a - set env(temp) -} -cleanup { + set result [set env(temp)] unset env(temp) -} -result {a} -test env-5.1 {corner cases - remove one elem at a time} -setup { + 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. + 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 { + set result [catch {array names env}] 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 { + 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)] 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. + 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 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 { + set result +} {a 1} +test env-5.4 {corner cases - unset the env array} {} { # 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 -} -result {1 a 1} + set result +} {1 a 1} test env-5.5 {corner cases - cannot have null entries on Windows} {win} { set env() a catch {set env()} @@ -291,29 +252,6 @@ test env-6.1 {corner cases - add lots of env variables} {} { expr {[array size env] - $size} } 100 -test env-7.1 {[219226]: whole env array should not be unset by read} { - 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 -} 0 -test env-7.2 {[219226]: links to env elements should not be removed by read} { - apply {{} { - set ::env(test7_2) ok - upvar env(test7_2) elem - set ::env(PATH) - try { - return $elem - } finally { - unset ::env(test7_2) - } - }} -} ok - # Restore the environment variables at the end of the test. foreach name [array names env] { |