summaryrefslogtreecommitdiffstats
path: root/tests/env.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/env.test')
-rw-r--r--tests/env.test152
1 files changed, 152 insertions, 0 deletions
diff --git a/tests/env.test b/tests/env.test
new file mode 100644
index 0000000..1bfc8dd
--- /dev/null
+++ b/tests/env.test
@@ -0,0 +1,152 @@
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) env.test 1.14 97/10/31 17:00:03
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+#
+# 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} {
+ catch {interp delete child}
+ catch {unset env(test)}
+ interp create child
+ set env(test) garbage
+ set return [child eval {set env(test)}]
+ interp delete child
+ unset env(test)
+ 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} {
+ catch {unset env(test)}
+ set env(test) aaaaaaaaaaaaaaaa
+ append env(test) bbbbbbbbbbbbbb
+ unset env(test)
+} {}
+if {[info commands exec] == ""} {
+ puts "exec not implemented for this machine"
+ return
+}
+
+if {$tcl_platform(os) == "Win32s"} {
+ puts "Cannot run multiple copies of tcl at the same time under Win32s"
+ return
+}
+
+set f [open printenv w]
+puts $f {
+ proc lrem {listname name} {
+ upvar $listname list
+ set i [lsearch $list $name]
+ if {$i >= 0} {
+ set list [lreplace $list $i $i]
+ }
+ return $list
+ }
+
+ set names [lsort [array names env]]
+ if {$tcl_platform(platform) == "windows"} {
+ lrem names HOME
+ lrem names COMSPEC
+ lrem names ComSpec
+ lrem names ""
+ }
+ foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH} {
+ lrem names $name
+ }
+ foreach p $names {
+ puts "$p=$env($p)"
+ }
+}
+close $f
+
+proc getenv {} {
+ global printenv tcltest
+ catch {exec $tcltest printenv} out
+ if {$out == "child process exited abnormally"} {
+ set out {}
+ }
+ return $out
+}
+
+# Save the current environment variables at the start of the test.
+
+foreach name [array names env] {
+ set env2($name) $env($name)
+ unset env($name)
+}
+
+# Added the following lines so that child tcltest can actually find its
+# library if the initial tcltest is run from a non-standard place.
+# ('saved' env vars)
+foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH} {
+ if {[info exists env2($name)]} {
+ set env($name) $env2($name);
+ }
+}
+
+test env-2.1 {adding environment variables} {
+ getenv
+} {}
+
+set env(NAME1) "test string"
+test env-2.2 {adding environment variables} {
+ getenv
+} {NAME1=test string}
+
+set env(NAME2) "more"
+test env-2.3 {adding environment variables} {
+ getenv
+} {NAME1=test string
+NAME2=more}
+
+set env(XYZZY) "garbage"
+test env-2.4 {adding environment variables} {
+ getenv
+} {NAME1=test string
+NAME2=more
+XYZZY=garbage}
+
+set env(NAME2) "new value"
+test env-3.1 {changing environment variables} {
+ getenv
+} {NAME1=test string
+NAME2=new value
+XYZZY=garbage}
+
+unset env(NAME2)
+test env-4.1 {unsetting environment variables} {
+ getenv
+} {NAME1=test string
+XYZZY=garbage}
+unset env(NAME1)
+test env-4.2 {unsetting environment variables} {
+ getenv
+} {XYZZY=garbage}
+
+# Restore the environment variables at the end of the test.
+
+foreach name [array names env] {
+ unset env($name)
+}
+foreach name [array names env2] {
+ set env($name) $env2($name)
+}
+
+file delete printenv