summaryrefslogtreecommitdiffstats
path: root/tests/env.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/env.test')
-rw-r--r--tests/env.test161
1 files changed, 135 insertions, 26 deletions
diff --git a/tests/env.test b/tests/env.test
index c66812b..27656e4 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -6,13 +6,16 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: env.test,v 1.3 1998/09/30 20:52:00 escoffon Exp $
+# RCS: @(#) $Id: env.test,v 1.4 1999/04/16 00:47:26 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
#
# These tests will run on any platform (and indeed crashed
@@ -38,17 +41,24 @@ test env-1.2 {lappend to env value} {
set env(test) aaaaaaaaaaaaaaaa
append env(test) bbbbbbbbbbbbbb
unset env(test)
-} {}
-if {[info commands exec] == ""} {
- puts "exec not implemented for this machine"
- return
-}
+} {}
+test env-1.3 {reflection of env by "array names"} {
+ catch {interp delete child}
+ catch {unset env(test)}
+ interp create child
+ child eval {set env(test) garbage}
+ set names [array names env]
+ interp delete child
+ set ix [lsearch $names test]
+ catch {unset env(test)}
+ expr {$ix >= 0}
+} {1}
+
+
+# Some tests require the "exec" command.
+# Skip them if exec is not defined.
+set ::tcltest::testConfig(execCommandExists) [expr {[info commands exec] != ""}]
-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} {
@@ -67,7 +77,7 @@ puts $f {
lrem names ComSpec
lrem names ""
}
- foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH SHLIB_PATH} {
+ foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH PURE_PROG_NAME DISPLAY SHLIB_PATH } {
lrem names $name
}
foreach p $names {
@@ -95,51 +105,135 @@ foreach name [array names env] {
# 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 SHLIB_PATH} {
+foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH DISPLAY SHLIB_PATH} {
if {[info exists env2($name)]} {
set env($name) $env2($name);
}
}
-test env-2.1 {adding environment variables} {
+test env-2.1 {adding environment variables} {execCommandExists} {
getenv
} {}
set env(NAME1) "test string"
-test env-2.2 {adding environment variables} {
+test env-2.2 {adding environment variables} {execCommandExists} {
getenv
} {NAME1=test string}
set env(NAME2) "more"
-test env-2.3 {adding environment variables} {
+test env-2.3 {adding environment variables} {execCommandExists} {
getenv
} {NAME1=test string
NAME2=more}
set env(XYZZY) "garbage"
-test env-2.4 {adding environment variables} {
+test env-2.4 {adding environment variables} {execCommandExists} {
getenv
} {NAME1=test string
NAME2=more
XYZZY=garbage}
set env(NAME2) "new value"
-test env-3.1 {changing environment variables} {
- getenv
+test env-3.1 {changing environment variables} {execCommandExists} {
+ set result [getenv]
+ unset env(NAME2)
+ set result
} {NAME1=test string
NAME2=new value
XYZZY=garbage}
-unset env(NAME2)
-test env-4.1 {unsetting environment variables} {
- getenv
+test env-4.1 {unsetting environment variables} {execCommandExists} {
+ set result [getenv]
+ unset env(NAME1)
+ set result
} {NAME1=test string
XYZZY=garbage}
-unset env(NAME1)
-test env-4.2 {unsetting environment variables} {
- getenv
+
+test env-4.2 {unsetting environment variables} {execCommandExists} {
+ set result [getenv]
+ unset env(XYZZY)
+ set result
} {XYZZY=garbage}
+test env-4.3 {setting international environment variables} {execCommandExists} {
+ set env(\ua7) \ub6
+ getenv
+} "\ua7=\ub6"
+test env-4.4 {changing international environment variables} {execCommandExists} {
+ set env(\ua7) \ua7
+ getenv
+} "\ua7=\ua7"
+test env-4.5 {unsetting international environment variables} {execCommandExists} {
+ set env(\ub6) \ua7
+ unset env(\ua7)
+ set result [getenv]
+ unset env(\ub6)
+ set result
+} "\ub6=\ua7"
+
+test env-5.0 {corner cases - set a value, it should exist} {} {
+ set temp [lindex [array names env] end]
+ set x env($temp)
+ set env($temp) a
+ set result [set env($temp)]
+ set env($temp) $x
+ 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]
+ foreach e [array names env] {
+ unset env($e)
+ }
+ set result [catch {array names env}]
+ array set env $x
+ 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 exist env(THIS_SHOULDNT_EXIST)]
+ interp delete i
+ 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)}}]
+ interp delete i
+ set result
+} {a 1}
+test env-5.4 {corner cases - unset the env array} {knownBug} {
+ # The info exist 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)]
+ interp delete i
+ set result
+} {1 a 1}
+test env-5.5 {corner cases - cannot have null entries on Windows} {pcOnly} {
+ set env() a
+ catch {set env()}
+} {1}
+
+
# Restore the environment variables at the end of the test.
foreach name [array names env] {
@@ -149,4 +243,19 @@ foreach name [array names env2] {
set env($name) $env2($name)
}
+# cleanup
file delete printenv
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
generated by cgit v0.12 at 2024-07-03 01:22:22 (GMT)