update tcl/tk

1 files changed, 0 insertions, 414 deletions

diff --git a/tcl8.6/tests/env.test b/tcl8.6/tests/env.test
deleted file mode 100644
index e6ce44d..0000000
--- a/tcl8.6/tests/env.test
+++ /dev/null
@@ -1,414 +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::*
-}
-
-package require tcltests
-
-# [exec] is required here to see the actual environment received by child
-# processes.
-proc getenv {} {
-    global printenvScript
-    catch {exec [interpreter] $printenvScript} out
-    if {$out eq "child process exited abnormally"} {
-	set out {}
-    }
-    return $out
-}
-
-
-proc envrestore {} {
-    # Restore the environment variables at the end of the test.
-    global env
-    variable env2
-
-    foreach name [array names env] {
-	unset env($name)
-    }
-    array set env $env2
-    return
-}
-
-
-proc envprep {} {
-    # Save the current environment variables at the start of the test.
-    global env
-    variable keep
-    variable env2
-
-    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 [string toupper $keep]} {
-	    unset env($name)
-	}
-    }
-    return
-}
-
-
-proc encodingrestore {} {
-    variable sysenc
-    encoding system $sysenc
-    return
-}
-
-
-proc encodingswitch encoding {
-    variable sysenc
-    # Need to run [getenv] in known encoding, so save the current one here...
-    set sysenc [encoding system]
-    encoding system $encoding
-    return
-}
-
-
-proc setup1 {} {
-    global env
-    envprep
-    encodingswitch iso8859-1
-}
-
-proc setup2 {} {
-    global env
-    setup1
-    set env(NAME1) {test string}
-    set env(NAME2) {new value}
-    set env(XYZZY) {garbage}
-}
-
-
-proc cleanup1 {} {
-    encodingrestore
-    envrestore
-}
-
-variable keep {
-    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
-}
-
-variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
-    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 @keep@ {
-	lrem names $name
-    }
-    foreach p $names {
-	puts [mangle $p]=[mangle $env($p)]
-    }
-    exit
-}] printenv]
-
-
-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
-
-
-test env-2.1 {
-    adding environment variables
-} -constraints exec -setup setup1 -body {
-    getenv
-} -cleanup cleanup1 -result {}
-
-
-test env-2.2 {
-    adding environment variables
-} -constraints exec -setup setup1 -body {
-    set env(NAME1) "test string"
-    getenv
-} -cleanup cleanup1 -result {NAME1=test string}
-
-
-test env-2.3 {adding environment variables} -constraints exec -setup {
-    setup1
-    set env(NAME1) "test string"
-} -body {
-    set env(NAME2) "more"
-    getenv
-} -cleanup cleanup1 -result {NAME1=test string
-NAME2=more}
-
-
-test env-2.4 {
-    adding environment variables
-} -constraints exec -setup {
-    setup1
-    set env(NAME1) "test string"
-    set env(NAME2) "more"
-} -body {
-    set env(XYZZY) "garbage"
-    getenv
-} -cleanup { cleanup1
-} -result {NAME1=test string
-NAME2=more
-XYZZY=garbage}
-
-
-test env-3.1 {
-    changing environment variables
-} -constraints exec -setup setup2 -body {
-    set result [getenv]
-    unset env(NAME2)
-    set result
-} -cleanup {
-    cleanup1
-} -result {NAME1=test string
-NAME2=new value
-XYZZY=garbage}
-
-
-test env-4.1 {
-    unsetting environment variables
-} -constraints exec -setup setup2 -body {
-    unset -nocomplain env(NAME2)
-    getenv
-} -cleanup cleanup1 -result {NAME1=test string
-XYZZY=garbage}
-
-# env-4.2 is deleted
-
-test env-4.3 {
-    setting international environment variables
-} -constraints exec -setup setup1 -body {
-    set env(\ua7) \ub6
-    getenv
-} -cleanup cleanup1 -result {\u00a7=\u00b6}
-
-
-test env-4.4 {
-    changing international environment variables
-} -constraints exec -setup setup1 -body {
-    set env(\ua7) \ua7
-    getenv
-} -cleanup cleanup1 -result {\u00a7=\u00a7}
-
-
-test env-4.5 {
-    unsetting international environment variables
-} -constraints exec -setup {
-    setup1
-    set env(\ua7) \ua7
-} -body {
-    set env(\ub6) \ua7
-    unset env(\ua7)
-    getenv
-} -cleanup cleanup1 -result {\u00b6=\u00a7}
-
-test env-5.0 {
-    corner cases - set a value, it should exist
-} -setup setup1 -body {
-    set env(temp) a
-    set env(temp)
-} -cleanup cleanup1 -result a
-
-
-test env-5.1 {
-    corner cases - remove one elem at a time
-} -setup setup1 -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 cleanup1 -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 {
-    setup1
-    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 {
-    cleanup1
-    interp delete i
-} -result {a 1}
-
-
-test env-5.4 {corner cases - unset the env array} -setup {
-    setup1
-    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 {
-    cleanup1
-    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()}
-} -cleanup cleanup1 -result 1
-
-test env-6.1 {corner cases - add lots of env variables} -setup setup1 -body {
-    set size [array size env]
-    for {set i 0} {$i < 100} {incr i} {
-	set env(BOGUS$i) $i
-    }
-    expr {[array size env] - $size}
-} -cleanup cleanup1 -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
-} -setup setup1 -body {
-    apply {{} {
-	set ::env(test7_2) ok
-	upvar env(test7_2) elem
-	set ::env(PATH)
-	return $elem
-    }}
-} -cleanup cleanup1 -result ok
-
-test env-7.3 {
-    [9b4702]: testing existence of env(some_thing) should not destroy trace
-} -setup setup1 -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)]
-    }}
-} -cleanup cleanup1 -result 1
-
-test env-8.0 {
-    memory usage - valgrind does not report reachable memory
-} -body {
-    set res [set env(__DUMMY__) {i'm with dummy}]
-    unset env(__DUMMY__)
-    return $res
-} -result {i'm with dummy}
-
-
-
-# cleanup
-rename getenv {} 
-rename envrestore {} 
-rename envprep {}
-rename encodingrestore {}
-rename encodingswitch {}
-
-removeFile $printenvScript
-::tcltest::cleanupTests
-return
-
-# Local Variables:
-# mode: tcl
-# End: