# 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. # # RCS: @(#) $Id: env.test,v 1.2 2001/09/14 01:43:36 zlaski Exp $ 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 SHLIB_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 SHLIB_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