Initial revision

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