# 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. # 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.1.1.2 2009/03/23 15:10:42 duncan Exp $ package require tcltest 2 namespace import -force ::tcltest::* # # 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) } {} 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. testConstraint exec [llength [info commands exec]] set printenvScript [makeFile { 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 LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING __CF_USER_TEXT_ENCODING SECURITYSESSIONID } { lrem names $name } foreach p $names { puts "$p=$env($p)" } exit } printenv] # [exec] is required here to see the actual environment received # by child processes. proc getenv {} { global printenvScript tcltest catch {exec [interpreter] $printenvScript} 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([string toupper $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 LIBPATH DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING SECURITYSESSIONID} { if {[info exists env2($name)]} { set env($name) $env2($name); } } test env-2.1 {adding environment variables} {exec} { getenv } {} set env(NAME1) "test string" test env-2.2 {adding environment variables} {exec} { getenv } {NAME1=test string} set env(NAME2) "more" test env-2.3 {adding environment variables} {exec} { getenv } {NAME1=test string NAME2=more} set env(XYZZY) "garbage" test env-2.4 {adding environment variables} {exec} { getenv } {NAME1=test string NAME2=more XYZZY=garbage} set env(NAME2) "new value" test env-3.1 {changing environment variables} {exec} { set result [getenv] unset env(NAME2) set result } {NAME1=test string NAME2=new value XYZZY=garbage} test env-4.1 {unsetting environment variables} {exec} { set result [getenv] unset env(NAME1) set result } {NAME1=test string XYZZY=garbage} test env-4.2 {unsetting environment variables} {exec} { set result [getenv] unset env(XYZZY) set result } {XYZZY=garbage} test env-4.3 {setting international environment variables} {exec} { set env(\ua7) \ub6 getenv } "\ua7=\ub6" test env-4.4 {changing international environment variables} {exec} { set env(\ua7) \ua7 getenv } "\ua7=\ua7" test env-4.5 {unsetting international environment variables} {exec} { 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 env(temp) a set result [set env(temp)] unset env(temp) 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 exists 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} {} { # The info exists 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} test env-6.1 {corner cases - add lots of env variables} {} { set size [array size env] for {set i 0} {$i < 100} {incr i} { set env(BOGUS$i) $i } expr {[array size env] - $size} } 100 # 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) } # cleanup removeFile $printenvScript ::tcltest::cleanupTests return