summaryrefslogtreecommitdiffstats
path: root/tests/env.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/env.test')
-rw-r--r--tests/env.test261
1 files changed, 0 insertions, 261 deletions
diff --git a/tests/env.test b/tests/env.test
deleted file mode 100644
index 27656e4..0000000
--- a/tests/env.test
+++ /dev/null
@@ -1,261 +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.
-#
-# RCS: @(#) $Id: env.test,v 1.4 1999/04/16 00:47:26 stanton Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
-
-#
-# 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.
-set ::tcltest::testConfig(execCommandExists) [expr {[info commands exec] != ""}]
-
-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]
- }
- 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 PURE_PROG_NAME DISPLAY SHLIB_PATH } {
- lrem names $name
- }
- foreach p $names {
- puts "$p=$env($p)"
- }
-}
-close $f
-
-proc getenv {} {
- global printenv tcltest
- catch {exec $tcltest 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)
-}
-
-# 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 DISPLAY SHLIB_PATH} {
- if {[info exists env2($name)]} {
- set env($name) $env2($name);
- }
-}
-
-test env-2.1 {adding environment variables} {execCommandExists} {
- getenv
-} {}
-
-set env(NAME1) "test string"
-test env-2.2 {adding environment variables} {execCommandExists} {
- getenv
-} {NAME1=test string}
-
-set env(NAME2) "more"
-test env-2.3 {adding environment variables} {execCommandExists} {
- getenv
-} {NAME1=test string
-NAME2=more}
-
-set env(XYZZY) "garbage"
-test env-2.4 {adding environment variables} {execCommandExists} {
- getenv
-} {NAME1=test string
-NAME2=more
-XYZZY=garbage}
-
-set env(NAME2) "new value"
-test env-3.1 {changing environment variables} {execCommandExists} {
- set result [getenv]
- unset env(NAME2)
- set result
-} {NAME1=test string
-NAME2=new value
-XYZZY=garbage}
-
-test env-4.1 {unsetting environment variables} {execCommandExists} {
- set result [getenv]
- unset env(NAME1)
- set result
-} {NAME1=test string
-XYZZY=garbage}
-
-test env-4.2 {unsetting environment variables} {execCommandExists} {
- set result [getenv]
- unset env(XYZZY)
- set result
-} {XYZZY=garbage}
-
-test env-4.3 {setting international environment variables} {execCommandExists} {
- set env(\ua7) \ub6
- getenv
-} "\ua7=\ub6"
-test env-4.4 {changing international environment variables} {execCommandExists} {
- set env(\ua7) \ua7
- getenv
-} "\ua7=\ua7"
-test env-4.5 {unsetting international environment variables} {execCommandExists} {
- 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 temp [lindex [array names env] end]
- set x env($temp)
- set env($temp) a
- set result [set env($temp)]
- set env($temp) $x
- 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 exist 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} {knownBug} {
- # The info exist 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}
-
-
-# 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
-file delete printenv
-::tcltest::cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
generated by cgit v0.12 at 2024-10-28 08:34:51 (GMT)