diff options
Diffstat (limited to 'tcl8.6/tests/env.test')
| -rw-r--r-- | tcl8.6/tests/env.test | 349 |
1 files changed, 0 insertions, 349 deletions
diff --git a/tcl8.6/tests/env.test b/tcl8.6/tests/env.test deleted file mode 100644 index 0dd4f98..0000000 --- a/tcl8.6/tests/env.test +++ /dev/null @@ -1,349 +0,0 @@ -# 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. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} - -# Some tests require the "exec" command. -# Skip them if exec is not defined. -testConstraint exec [llength [info commands exec]] - -# -# 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} -setup { - catch {interp delete child} - catch {unset env(test)} -} -body { - interp create child - set env(test) garbage - child eval {set env(test)} -} -cleanup { - interp delete child - unset env(test) -} -result {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} -setup { - catch {unset env(test)} -} -body { - set env(test) aaaaaaaaaaaaaaaa - append env(test) bbbbbbbbbbbbbb - unset env(test) -} -test env-1.3 {reflection of env by "array names"} -setup { - catch {interp delete child} - catch {unset env(test)} -} -body { - interp create child - child eval {set env(test) garbage} - expr {"test" in [array names env]} -} -cleanup { - interp delete child - catch {unset env(test)} -} -result {1} - -set printenvScript [makeFile { - encoding system iso8859-1 - proc lrem {listname name} { - upvar $listname list - set i [lsearch -nocase $list $name] - if {$i >= 0} { - set list [lreplace $list $i $i] - } - return $list - } - proc mangle s { - regsub -all {\[|\\|\]} $s {\\&} s - regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s - return [subst -novariables $s] - } - proc manglechar c { - return [format {\u%04x} [scan $c %c]] - } - - set names [lsort [array names env]] - if {$tcl_platform(platform) eq "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 LANG WINDIR TERM - CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432 - } { - lrem names $name - } - foreach p $names { - puts "[mangle $p]=[mangle $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 eq "child process exited abnormally"} { - set out {} - } - return $out -} - -# Save the current environment variables at the start of the test. - -set env2 [array get env] -foreach name [array names env] { - # Keep some environment variables that support operation of the tcltest - # package. - if {[string toupper $name] ni { - 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 LANG WINDIR TERM - CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432 - }} { - unset env($name) - } -} - -# Need to run 'getenv' in known encoding, so save the current one here... -set sysenc [encoding system] - -test env-2.1 {adding environment variables} -setup { - encoding system iso8859-1 -} -constraints {exec} -body { - getenv -} -cleanup { - encoding system $sysenc -} -result {} -test env-2.2 {adding environment variables} -setup { - encoding system iso8859-1 -} -constraints {exec} -body { - set env(NAME1) "test string" - getenv -} -cleanup { - encoding system $sysenc -} -result {NAME1=test string} -test env-2.3 {adding environment variables} -setup { - encoding system iso8859-1 - set env(NAME1) "test string" -} -constraints {exec} -body { - set env(NAME2) "more" - getenv -} -cleanup { - encoding system $sysenc -} -result {NAME1=test string -NAME2=more} -test env-2.4 {adding environment variables} -setup { - encoding system iso8859-1 - set env(NAME1) "test string" - set env(NAME2) "more" -} -constraints {exec} -body { - set env(XYZZY) "garbage" - getenv -} -cleanup { - encoding system $sysenc -} -result {NAME1=test string -NAME2=more -XYZZY=garbage} - -set env(NAME1) "test string" -set env(NAME2) "new value" -set env(XYZZY) "garbage" -test env-3.1 {changing environment variables} -setup { - encoding system iso8859-1 -} -constraints {exec} -body { - set result [getenv] - unset env(NAME2) - set result -} -cleanup { - encoding system $sysenc -} -result {NAME1=test string -NAME2=new value -XYZZY=garbage} -unset -nocomplain env(NAME2) - -test env-4.1 {unsetting environment variables: default} -setup { - encoding system iso8859-1 -} -constraints {exec} -body { - getenv -} -cleanup { - encoding system $sysenc -} -result {NAME1=test string -XYZZY=garbage} -test env-4.2 {unsetting environment variables} -setup { - encoding system iso8859-1 -} -constraints {exec} -body { - unset env(NAME1) - getenv -} -cleanup { - unset env(XYZZY) - encoding system $sysenc -} -result {XYZZY=garbage} -unset -nocomplain env(NAME1) env(XYZZY) -test env-4.3 {setting international environment variables} -setup { - encoding system iso8859-1 -} -constraints {exec} -body { - set env(\ua7) \ub6 - getenv -} -cleanup { - encoding system $sysenc -} -result {\u00a7=\u00b6} -test env-4.4 {changing international environment variables} -setup { - encoding system iso8859-1 -} -constraints {exec} -body { - set env(\ua7) \ua7 - getenv -} -cleanup { - encoding system $sysenc -} -result {\u00a7=\u00a7} -test env-4.5 {unsetting international environment variables} -setup { - encoding system iso8859-1 - set env(\ua7) \ua7 -} -body { - set env(\ub6) \ua7 - unset env(\ua7) - getenv -} -constraints {exec} -cleanup { - unset env(\ub6) - encoding system $sysenc -} -result {\u00b6=\u00a7} - -test env-5.0 {corner cases - set a value, it should exist} -body { - set env(temp) a - set env(temp) -} -cleanup { - unset env(temp) -} -result {a} -test env-5.1 {corner cases - remove one elem at a time} -setup { - set x [array get env] -} -body { - # 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. - foreach e [array names env] { - unset env($e) - } - array size env -} -cleanup { - array set env $x -} -result {0} -test env-5.2 {corner cases - unset the env array} -setup { - interp create i -} -body { - # Unsetting a variable in an interp detaches the C-level traces from the - # Tcl "env" variable. - i eval { - unset env - set env(THIS_SHOULDNT_EXIST) a - } - info exists env(THIS_SHOULDNT_EXIST) -} -cleanup { - interp delete i -} -result {0} -test env-5.3 {corner cases: unset the env in master should unset child} -setup { - interp create i -} -body { - # Variables deleted in a master interp should be deleted in child interp - # too. - 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)}}] -} -cleanup { - interp delete i -} -result {a 1} -test env-5.4 {corner cases - unset the env array} -setup { - interp create i -} -body { - # The info exists command should be in synch with the env array. - # Know Bug: 1737 - 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)] -} -cleanup { - interp delete i -} -result {1 a 1} -test env-5.5 {corner cases - cannot have null entries on Windows} -constraints win -body { - set env() a - catch {set env()} -} -result 1 - -test env-6.1 {corner cases - add lots of env variables} -body { - set size [array size env] - for {set i 0} {$i < 100} {incr i} { - set env(BOGUS$i) $i - } - expr {[array size env] - $size} -} -result 100 - -test env-7.1 {[219226]: whole env array should not be unset by read} -body { - set n [array size env] - set s [array startsearch env] - while {[array anymore env $s]} { - array nextelement env $s - incr n -1 - } - array donesearch env $s - return $n -} -result 0 - -test env-7.2 {[219226]: links to env elements should not be removed by read} -body { - apply {{} { - set ::env(test7_2) ok - upvar env(test7_2) elem - set ::env(PATH) - return $elem - }} -} -result ok - -test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body { - apply {{} { - catch {unset ::env(test7_3)} - proc foo args { - set ::env(test7_3) ok - } - trace add variable ::env(not_yet_existent) write foo - info exists ::env(not_yet_existent) - set ::env(not_yet_existent) "Now I'm here"; - return [info exists ::env(test7_3)] - }} -} -result 1 - -# Restore the environment variables at the end of the test. - -foreach name [array names env] { - unset env($name) -} -array set env $env2 - -# cleanup -removeFile $printenvScript -::tcltest::cleanupTests -return - -# Local Variables: -# mode: tcl -# End: |