# 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. # All rights reserved. # # Permission is hereby granted, without written agreement and without # license or royalty fees, to use, copy, modify, and distribute this # software and its documentation for any purpose, provided that the # above copyright notice and the following two paragraphs appear in # all copies of this software. # # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY # AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. # # $Header: /user6/ouster/tcl/tests/RCS/env.test,v 1.7 93/10/14 14:59:14 ouster Exp $ (Berkeley) 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. 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} } 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 } break } } if {$printenv == ""} { puts stdout "Skipping env tests: need \"printenv\" to read environment." return "" } proc getenv {} { global printenv catch {exec $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) } test env-1.1 {adding environment variables} { getenv } {} set env(NAME1) "test string" test env-1.2 {adding environment variables} { getenv } {NAME1=test string} set env(NAME2) "more" test env-1.3 {adding environment variables} { getenv } {NAME1=test string NAME2=more} set env(XYZZY) "garbage" test env-1.4 {adding environment variables} { getenv } {NAME1=test string NAME2=more XYZZY=garbage} set env(NAME2) "new value" test env-2.1 {changing environment variables} { getenv } {NAME1=test string NAME2=new value XYZZY=garbage} unset env(NAME2) test env-3.1 {unsetting environment variables} { getenv } {NAME1=test string XYZZY=garbage} unset env(NAME1) test env-3.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) }