diff options
Diffstat (limited to 'contrib/tcl/tests/env.test')
| -rw-r--r-- | contrib/tcl/tests/env.test | 73 |
1 files changed, 46 insertions, 27 deletions
diff --git a/contrib/tcl/tests/env.test b/contrib/tcl/tests/env.test index 22f1284..e76ad7d 100644 --- a/contrib/tcl/tests/env.test +++ b/contrib/tcl/tests/env.test @@ -10,42 +10,50 @@ # 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 +# SCCS: @(#) env.test 1.13 97/08/05 11:40:30 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. +if {[info commands exec] == ""} { + puts "exec not implemented for this machine" + return +} -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} +if {$tcl_platform(os) == "Win32s"} { + puts "Cannot run multiple copies of tcl at the same time under Win32s" + return } -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 + +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] } - break + 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} { + lrem names $name + } + foreach p $names { + puts "$p=$env($p)" } } -if {$printenv == ""} { - puts stdout "Skipping env tests: need \"printenv\" to read environment." - return "" -} +close $f + proc getenv {} { - global printenv - catch {exec $printenv} out + global printenv tcltest + catch {exec $tcltest printenv} out if {$out == "child process exited abnormally"} { set out {} } @@ -59,6 +67,15 @@ foreach name [array names env] { 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} { + if {[info exists env2($name)]} { + set env($name) $env2($name); + } +} + test env-1.1 {adding environment variables} { getenv } {} @@ -106,3 +123,5 @@ foreach name [array names env] { foreach name [array names env2] { set env($name) $env2($name) } + +file delete printenv |
