# 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.17.2.5 2007/01/19 01:05:50 das 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