summaryrefslogtreecommitdiffstats
path: root/tests/env.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/env.test')
-rw-r--r--tests/env.test262
1 files changed, 91 insertions, 171 deletions
diff --git a/tests/env.test b/tests/env.test
index 0dd4f98..ee13b7f 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -19,47 +19,44 @@ 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} -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,211 +124,134 @@ 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
- set env(NAME1) "test string"
-} -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
- set env(NAME1) "test string"
- set env(NAME2) "more"
-} -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(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 {
+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}
-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 {
+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}
-unset -nocomplain env(NAME1) env(XYZZY)
-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
- set env(\ua7) \ua7
-} -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}
-test env-5.5 {corner cases - cannot have null entries on Windows} -constraints win -body {
+ set result
+} {1 a 1}
+test env-5.5 {corner cases - cannot have null entries on Windows} {win} {
set env() a
catch {set env()}
-} -result 1
+} {1}
-test env-6.1 {corner cases - add lots of env variables} -body {
+test env-6.1 {corner cases - add lots of env variables} {} {
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
+} 100
-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] {
generated by cgit v0.12 at 2025-12-25 04:12:53 (GMT)