merged tcl 8.1 branch back into the main trunk

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
+
+
+
+
+
+
+
+
+
+
+
+