os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/env.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/env.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,263 @@
1.4 +# Commands covered: none (tests environment variable implementation)
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1991-1993 The Regents of the University of California.
1.11 +# Copyright (c) 1994 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: env.test,v 1.17.2.5 2007/01/19 01:05:50 das Exp $
1.18 +
1.19 +package require tcltest 2
1.20 +namespace import -force ::tcltest::*
1.21 +
1.22 +#
1.23 +# These tests will run on any platform (and indeed crashed
1.24 +# on the Mac). So put them before you test for the existance
1.25 +# of exec.
1.26 +#
1.27 +test env-1.1 {propagation of env values to child interpreters} {
1.28 + catch {interp delete child}
1.29 + catch {unset env(test)}
1.30 + interp create child
1.31 + set env(test) garbage
1.32 + set return [child eval {set env(test)}]
1.33 + interp delete child
1.34 + unset env(test)
1.35 + set return
1.36 +} {garbage}
1.37 +#
1.38 +# This one crashed on Solaris under Tcl8.0, so we only
1.39 +# want to make sure it runs.
1.40 +#
1.41 +test env-1.2 {lappend to env value} {
1.42 + catch {unset env(test)}
1.43 + set env(test) aaaaaaaaaaaaaaaa
1.44 + append env(test) bbbbbbbbbbbbbb
1.45 + unset env(test)
1.46 +} {}
1.47 +test env-1.3 {reflection of env by "array names"} {
1.48 + catch {interp delete child}
1.49 + catch {unset env(test)}
1.50 + interp create child
1.51 + child eval {set env(test) garbage}
1.52 + set names [array names env]
1.53 + interp delete child
1.54 + set ix [lsearch $names test]
1.55 + catch {unset env(test)}
1.56 + expr {$ix >= 0}
1.57 +} {1}
1.58 +
1.59 +
1.60 +# Some tests require the "exec" command.
1.61 +# Skip them if exec is not defined.
1.62 +testConstraint exec [llength [info commands exec]]
1.63 +
1.64 +set printenvScript [makeFile {
1.65 + proc lrem {listname name} {
1.66 + upvar $listname list
1.67 + set i [lsearch $list $name]
1.68 + if {$i >= 0} {
1.69 + set list [lreplace $list $i $i]
1.70 + }
1.71 + return $list
1.72 + }
1.73 +
1.74 + set names [lsort [array names env]]
1.75 + if {$tcl_platform(platform) == "windows"} {
1.76 + lrem names HOME
1.77 + lrem names COMSPEC
1.78 + lrem names ComSpec
1.79 + lrem names ""
1.80 + }
1.81 + foreach name {
1.82 + TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
1.83 + SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
1.84 + DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
1.85 + __CF_USER_TEXT_ENCODING SECURITYSESSIONID
1.86 + } {
1.87 + lrem names $name
1.88 + }
1.89 + foreach p $names {
1.90 + puts "$p=$env($p)"
1.91 + }
1.92 + exit
1.93 +} printenv]
1.94 +
1.95 +# [exec] is required here to see the actual environment received
1.96 +# by child processes.
1.97 +proc getenv {} {
1.98 + global printenvScript tcltest
1.99 + catch {exec [interpreter] $printenvScript} out
1.100 + if {$out == "child process exited abnormally"} {
1.101 + set out {}
1.102 + }
1.103 + return $out
1.104 +}
1.105 +
1.106 +# Save the current environment variables at the start of the test.
1.107 +
1.108 +foreach name [array names env] {
1.109 + set env2([string toupper $name]) $env($name)
1.110 + unset env($name)
1.111 +}
1.112 +
1.113 +# Added the following lines so that child tcltest can actually find its
1.114 +# library if the initial tcltest is run from a non-standard place.
1.115 +# ('saved' env vars)
1.116 +foreach name {
1.117 + TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
1.118 + SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
1.119 + DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
1.120 + SECURITYSESSIONID} {
1.121 + if {[info exists env2($name)]} {
1.122 + set env($name) $env2($name);
1.123 + }
1.124 +}
1.125 +
1.126 +test env-2.1 {adding environment variables} {exec} {
1.127 + getenv
1.128 +} {}
1.129 +
1.130 +set env(NAME1) "test string"
1.131 +test env-2.2 {adding environment variables} {exec} {
1.132 + getenv
1.133 +} {NAME1=test string}
1.134 +
1.135 +set env(NAME2) "more"
1.136 +test env-2.3 {adding environment variables} {exec} {
1.137 + getenv
1.138 +} {NAME1=test string
1.139 +NAME2=more}
1.140 +
1.141 +set env(XYZZY) "garbage"
1.142 +test env-2.4 {adding environment variables} {exec} {
1.143 + getenv
1.144 +} {NAME1=test string
1.145 +NAME2=more
1.146 +XYZZY=garbage}
1.147 +
1.148 +set env(NAME2) "new value"
1.149 +test env-3.1 {changing environment variables} {exec} {
1.150 + set result [getenv]
1.151 + unset env(NAME2)
1.152 + set result
1.153 +} {NAME1=test string
1.154 +NAME2=new value
1.155 +XYZZY=garbage}
1.156 +
1.157 +test env-4.1 {unsetting environment variables} {exec} {
1.158 + set result [getenv]
1.159 + unset env(NAME1)
1.160 + set result
1.161 +} {NAME1=test string
1.162 +XYZZY=garbage}
1.163 +
1.164 +test env-4.2 {unsetting environment variables} {exec} {
1.165 + set result [getenv]
1.166 + unset env(XYZZY)
1.167 + set result
1.168 +} {XYZZY=garbage}
1.169 +
1.170 +test env-4.3 {setting international environment variables} {exec} {
1.171 + set env(\ua7) \ub6
1.172 + getenv
1.173 +} "\ua7=\ub6"
1.174 +test env-4.4 {changing international environment variables} {exec} {
1.175 + set env(\ua7) \ua7
1.176 + getenv
1.177 +} "\ua7=\ua7"
1.178 +test env-4.5 {unsetting international environment variables} {exec} {
1.179 + set env(\ub6) \ua7
1.180 + unset env(\ua7)
1.181 + set result [getenv]
1.182 + unset env(\ub6)
1.183 + set result
1.184 +} "\ub6=\ua7"
1.185 +
1.186 +test env-5.0 {corner cases - set a value, it should exist} {} {
1.187 + set env(temp) a
1.188 + set result [set env(temp)]
1.189 + unset env(temp)
1.190 + set result
1.191 +} {a}
1.192 +test env-5.1 {corner cases - remove one elem at a time} {} {
1.193 + # When no environment variables exist, the env var will
1.194 + # contain no entries. The "array names" call synchs up
1.195 + # the C-level environ array with the Tcl level env array.
1.196 + # Make sure an empty Tcl array is created.
1.197 +
1.198 + set x [array get env]
1.199 + foreach e [array names env] {
1.200 + unset env($e)
1.201 + }
1.202 + set result [catch {array names env}]
1.203 + array set env $x
1.204 + set result
1.205 +} {0}
1.206 +test env-5.2 {corner cases - unset the env array} {} {
1.207 + # Unsetting a variable in an interp detaches the C-level
1.208 + # traces from the Tcl "env" variable.
1.209 +
1.210 + interp create i
1.211 + i eval { unset env }
1.212 + i eval { set env(THIS_SHOULDNT_EXIST) a}
1.213 + set result [info exists env(THIS_SHOULDNT_EXIST)]
1.214 + interp delete i
1.215 + set result
1.216 +} {0}
1.217 +test env-5.3 {corner cases - unset the env in master should unset child} {} {
1.218 + # Variables deleted in a master interp should be deleted in
1.219 + # child interp too.
1.220 +
1.221 + interp create i
1.222 + i eval { set env(THIS_SHOULD_EXIST) a}
1.223 + set result [set env(THIS_SHOULD_EXIST)]
1.224 + unset env(THIS_SHOULD_EXIST)
1.225 + lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}]
1.226 + interp delete i
1.227 + set result
1.228 +} {a 1}
1.229 +test env-5.4 {corner cases - unset the env array} {} {
1.230 + # The info exists command should be in synch with the env array.
1.231 + # Know Bug: 1737
1.232 +
1.233 + interp create i
1.234 + i eval { set env(THIS_SHOULD_EXIST) a}
1.235 + set result [info exists env(THIS_SHOULD_EXIST)]
1.236 + lappend result [set env(THIS_SHOULD_EXIST)]
1.237 + lappend result [info exists env(THIS_SHOULD_EXIST)]
1.238 + interp delete i
1.239 + set result
1.240 +} {1 a 1}
1.241 +test env-5.5 {corner cases - cannot have null entries on Windows} {pcOnly} {
1.242 + set env() a
1.243 + catch {set env()}
1.244 +} {1}
1.245 +
1.246 +test env-6.1 {corner cases - add lots of env variables} {} {
1.247 + set size [array size env]
1.248 + for {set i 0} {$i < 100} {incr i} {
1.249 + set env(BOGUS$i) $i
1.250 + }
1.251 + expr {[array size env] - $size}
1.252 +} 100
1.253 +
1.254 +# Restore the environment variables at the end of the test.
1.255 +
1.256 +foreach name [array names env] {
1.257 + unset env($name)
1.258 +}
1.259 +foreach name [array names env2] {
1.260 + set env($name) $env2($name)
1.261 +}
1.262 +
1.263 +# cleanup
1.264 +removeFile $printenvScript
1.265 +::tcltest::cleanupTests
1.266 +return