1 files changed, 108 insertions, 0 deletions
diff --git a/contrib/tcl/tests/env.test b/contrib/tcl/tests/env.test
new file mode 100644
index 000000000000..22f128482142
--- /dev/null
+++ b/contrib/tcl/tests/env.test
@@ -0,0 +1,108 @@
+# 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.9 96/02/16 08:55:47
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# If there is no "printenv" program on this system, then it's just too
+# much trouble to run this test (can't necessarily run csh to get the
+# environment:  on some systems it barfs if there isn't a minimum set
+# predefined environment variables.  Also, printenv returns a non-zero
+# status on some systems, so read the environment using a procedure
+# that catches errors.
+
+set printenv {}
+if [info exists env(PATH)] {
+    set dirs [split $env(PATH) :]
+} else {
+    set dirs {/bin /usr/bin /usr/ucb /usr/local /usr/public /usr/etc}
+}
+foreach i $dirs {
+    if [file executable $i/printenv] {
+	# The following hack is needed because of weirdness with
+	# environment variables in symbolic lines on Apollos (?!#?).
+	if ![catch {exec sh -c "cd $i; pwd"} x] {
+	    set printenv $x/printenv
+	} else {
+	    set printenv $i/printenv
+	}
+	break
+    }
+}
+if {$printenv == ""} {
+    puts stdout "Skipping env tests:  need \"printenv\" to read environment."
+    return ""
+}
+proc getenv {} {
+    global printenv
+    catch {exec $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)
+}
+
+test env-1.1 {adding environment variables} {
+    getenv
+} {}
+
+set env(NAME1) "test string"
+test env-1.2 {adding environment variables} {
+    getenv
+} {NAME1=test string}
+
+set env(NAME2) "more"
+test env-1.3 {adding environment variables} {
+    getenv
+} {NAME1=test string
+NAME2=more}
+
+set env(XYZZY) "garbage"
+test env-1.4 {adding environment variables} {
+    getenv
+} {NAME1=test string
+NAME2=more
+XYZZY=garbage}
+
+set env(NAME2) "new value"
+test env-2.1 {changing environment variables} {
+    getenv
+} {NAME1=test string
+NAME2=new value
+XYZZY=garbage}
+
+unset env(NAME2)
+test env-3.1 {unsetting environment variables} {
+    getenv
+} {NAME1=test string
+XYZZY=garbage}
+unset env(NAME1)
+test env-3.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)
+}