Import TCL v8.0 PL2.vendor/tcl

31 files changed, 1220 insertions, 210 deletions

diff --git a/contrib/tcl/tests/append.test b/contrib/tcl/tests/append.test
index 6733454ee100..f89ade5bd4c9 100644
--- a/contrib/tcl/tests/append.test
+++ b/contrib/tcl/tests/append.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) append.test 1.16 97/04/09 11:29:33
+# SCCS: @(#) append.test 1.17 97/10/28 15:45:52
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -156,3 +156,19 @@ test append-6.2 {lappend errors} {
     set x ""
     list [catch {lappend x(0) 44} msg] $msg
 } {1 {can't set "x(0)": variable isn't array}}
+
+test append-7.1 {lappend-created var and error in trace on that var} {
+    catch {rename foo ""}
+    catch {unset x}
+    trace variable x w foo
+    proc foo {} {global x; unset x}
+    catch {lappend x 1}
+    proc foo {args} {global x; unset x}
+    info exists x
+    set x
+    lappend x 1
+    list [info exists x] [catch {set x} msg] $msg
+} {0 1 {can't read "x": no such variable}}
+
+catch {unset x}
+catch {rename foo ""}
diff --git a/contrib/tcl/tests/basic.test b/contrib/tcl/tests/basic.test
index a0b6ea0b2fef..502e3e5f4d55 100644
--- a/contrib/tcl/tests/basic.test
+++ b/contrib/tcl/tests/basic.test
@@ -14,7 +14,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) basic.test 1.18 97/08/07 10:36:59
+# SCCS: @(#) basic.test 1.19 97/10/31 16:02:26
 #
 
 if {[string compare test [info procs test]] == 1} then {source defs}
@@ -381,8 +381,11 @@ test basic-11.1 {TclObjInvoke, lookup of "unknown" command} {
 } {newAlias 0 {global unknown} {}}
 
 test basic-12.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
-    testcmdtrace {set stuff [info tclversion]}
+    testcmdtrace tracetest {set stuff [info tclversion]}
 } {{info tclversion} {info tclversion} {set stuff [info tclversion]} {set stuff 8.0}}
+test basic-12.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
+    testcmdtrace deletetest {set stuff [info tclversion]}
+} 8.0
 
 catch {eval namespace delete [namespace children :: test_ns_*]}
 catch {namespace delete george}
diff --git a/contrib/tcl/tests/binary.test b/contrib/tcl/tests/binary.test
index f64b2bbd75e4..dcc5cf640fc3 100644
--- a/contrib/tcl/tests/binary.test
+++ b/contrib/tcl/tests/binary.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) binary.test 1.10 97/08/06 08:56:11
+# SCCS: @(#) binary.test 1.13 97/09/11 18:50:30
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -443,18 +443,24 @@ test binary-13.12 {Tcl_BinaryObjCmd: float overflow} {nonPortable macOrUnix} {
 test binary-13.13 {Tcl_BinaryObjCmd: float overflow} {nonPortable pcOnly} {
     binary format f -3.402825e+38
 } \xff\xff\x7f\xff
-test binary-13.14 {Tcl_BinaryObjCmd: format} {
+test binary-13.14 {Tcl_BinaryObjCmd: float underflow} {nonPortable macOrUnix} {
+    binary format f -3.402825e-100
+} \x80\x00\x00\x00
+test binary-13.15 {Tcl_BinaryObjCmd: float underflow} {nonPortable pcOnly} {
+    binary format f -3.402825e-100
+} \x00\x00\x00\x80
+test binary-13.16 {Tcl_BinaryObjCmd: format} {
     list [catch {binary format f2 {1.6}} msg] $msg
 } {1 {number of elements in list does not match count}}
-test binary-13.15 {Tcl_BinaryObjCmd: format} {
+test binary-13.17 {Tcl_BinaryObjCmd: format} {
     set a {1.6 3.4}
     list [catch {binary format f $a} msg] $msg
 } [list 1 "expected floating-point number but got \"1.6 3.4\""]
-test binary-13.16 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
+test binary-13.18 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
     set a {1.6 3.4}
     binary format f1 $a
 } \x3f\xcc\xcc\xcd
-test binary-13.17 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-13.19 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
     set a {1.6 3.4}
     binary format f1 $a
 } \xcd\xcc\xcc\x3f
@@ -1312,7 +1318,7 @@ test binary-37.8 {GetFormatSpec: numbers} {
     set arg1 foo
     list [binary scan abcdef "a0x3" arg1] $arg1
 } {1 {}}
-test binary-37.8 {GetFormatSpec: numbers} {
+test binary-37.9 {GetFormatSpec: numbers} {
     # test format of neg numbers
     # bug report/fix provided by Harald Kirsch
     set x [binary format f* {1 -1 2 -2 0}]
@@ -1320,37 +1326,61 @@ test binary-37.8 {GetFormatSpec: numbers} {
     set bla
 } {1.0 -1.0 2.0 -2.0 0.0}
 
-# FormatNumber is thoroughly tested above, so we don't have any explicit tests
-test binary-38.1 {ScanNumber: sign extension} {
+test binary-38.1 {FormatNumber: word alignment} {
+    set x [binary format c1s1 1 1]
+} \x01\x01\x00
+test binary-38.2 {FormatNumber: word alignment} {
+    set x [binary format c1S1 1 1]
+} \x01\x00\x01
+test binary-38.3 {FormatNumber: word alignment} {
+    set x [binary format c1i1 1 1]
+} \x01\x01\x00\x00\x00
+test binary-38.4 {FormatNumber: word alignment} {
+    set x [binary format c1I1 1 1]
+} \x01\x00\x00\x00\x01
+test binary-38.5 {FormatNumber: word alignment} {nonPortable macOrUnix} {
+    set x [binary format c1d1 1 1.6]
+} \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a
+test binary-38.6 {FormatNumber: word alignment} {nonPortable pcOnly} {
+    set x [binary format c1d1 1 1.6]
+} \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f
+test binary-38.7 {FormatNumber: word alignment} {nonPortable macOrUnix} {
+    set x [binary format c1f1 1 1.6]
+} \x01\x3f\xcc\xcc\xcd
+test binary-38.8 {FormatNumber: word alignment} {nonPortable pcOnly} {
+    set x [binary format c1f1 1 1.6]
+} \x01\xcd\xcc\xcc\x3f
+
+test binary-39.1 {ScanNumber: sign extension} {
     catch {unset arg1}
     list [binary scan \x52\xa3 c2 arg1] $arg1
 } {1 {82 -93}}
-test binary-38.2 {ScanNumber: sign extension} {
+test binary-39.2 {ScanNumber: sign extension} {
     catch {unset arg1}
     list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1
 } {1 {513 -32511 386 -32127}}
-test binary-38.3 {ScanNumber: sign extension} {
+test binary-39.3 {ScanNumber: sign extension} {
     catch {unset arg1}
     list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1
 } {1 {258 385 -32255 -32382}}
-test binary-38.4 {ScanNumber: sign extension} {
+test binary-39.4 {ScanNumber: sign extension} {
     catch {unset arg1}
     list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1
 } {1 {33620225 16843137 16876033 25297153 -2130640639}}
-test binary-38.5 {ScanNumber: sign extension} {
+test binary-39.5 {ScanNumber: sign extension} {
     catch {unset arg1}
     list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
 } {1 {16843010 -2130640639 25297153 16876033 16843137}}
 
-test binary-39.1 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
+test binary-40.1 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
     catch {unset arg1}
     list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
 } {1 -NaN}
-test binary-39.2 {ScanNumber: floating point overflow} {nonPortable macOnly} {
+test binary-40.2 {ScanNumber: floating point overflow} {nonPortable macOnly} {
     catch {unset arg1}
     list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
 } {1 -NAN(255)}
-test binary-39.3 {ScanNumber: floating point overflow} {nonPortable pcOnly} {
+test binary-40.3 {ScanNumber: floating point overflow} {nonPortable pcOnly} {
     catch {unset arg1}
     set result [binary scan \xff\xff\xff\xff f1 arg1]
     if {([string compare $arg1 -1.\#QNAN] == 0)
@@ -1360,15 +1390,15 @@ test binary-39.3 {ScanNumber: floating point overflow} {nonPortable pcOnly} {
 	lappend result failure
     }
 } {1 success}
-test binary-39.4 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
+test binary-40.4 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
     catch {unset arg1}
     list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1] $arg1
 } {1 -NaN}
-test binary-39.5 {ScanNumber: floating point overflow} {nonPortable macOnly} {
+test binary-40.5 {ScanNumber: floating point overflow} {nonPortable macOnly} {
     catch {unset arg1}
     list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1] $arg1
 } {1 -NAN(255)}
-test binary-39.6 {ScanNumber: floating point overflow} {nonPortable pcOnly} {
+test binary-40.6 {ScanNumber: floating point overflow} {nonPortable pcOnly} {
     catch {unset arg1}
     set result [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1]
     if {([string compare $arg1 -1.\#QNAN] == 0)
@@ -1378,3 +1408,36 @@ test binary-39.6 {ScanNumber: floating point overflow} {nonPortable pcOnly} {
 	lappend result failure
     }
 } {1 success}
+
+test binary-41.1 {ScanNumber: word alignment} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+test binary-41.2 {ScanNumber: word alignment} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+test binary-41.3 {ScanNumber: word alignment} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+test binary-41.4 {ScanNumber: word alignment} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+test binary-41.5 {ScanNumber: word alignment} {nonPortable macOrUnix} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2
+} {2 1 1.60000002384}
+test binary-41.6 {ScanNumber: word alignment} {nonPortable pcOnly} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2
+} {2 1 1.60000002384}
+test binary-41.7 {ScanNumber: word alignment} {nonPortable macOrUnix} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2
+} {2 1 1.6}
+test binary-41.8 {ScanNumber: word alignment} {nonPortable pcOnly} {
+    catch {unset arg1; unset arg2}
+    list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
+} {2 1 1.6}
diff --git a/contrib/tcl/tests/clock.test b/contrib/tcl/tests/clock.test
index b75ee32f4b24..95f73ac3cbaa 100644
--- a/contrib/tcl/tests/clock.test
+++ b/contrib/tcl/tests/clock.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) clock.test 1.14 97/06/02 10:18:12
+# SCCS: @(#) clock.test 1.17 97/11/24 15:05:38
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -145,3 +145,31 @@ test clock-6.4 {clock roll over dates} {
     set time [clock scan "2/29/2000" -gmt true]
     clock format [expr $time + $day] -format {%b %d,%Y %H:%M GMT} -gmt true
 } {Mar 01,2000 00:00 GMT}
+test clock-6.5 {clock roll over dates} {
+    set time [clock scan "January 1, 2000" -gmt true]
+    clock format $time -format %A -gmt true
+} {Saturday}
+test clock-6.6 {clock roll over dates} {
+    set time [clock scan "January 1, 2000" -gmt true]
+    clock format $time -format %j -gmt true
+} {001}
+test clock-6.7 {clock roll over dates} {
+    set time [clock scan "February 29, 2000" -gmt true]
+    clock format $time -format %A -gmt true
+} {Tuesday}
+test clock-6.8 {clock roll over dates} {
+    set time [clock scan "February 29, 2000" -gmt true]
+    clock format $time -format %j -gmt true
+} {060}
+test clock-6.9 {clock roll over dates} {
+    set time [clock scan "March 1, 2000" -gmt true]
+    clock format $time -format %A -gmt true
+} {Wednesday}
+test clock-6.10 {clock roll over dates} {
+    set time [clock scan "March 1, 2000" -gmt true]
+    clock format $time -format %j -gmt true
+} {061}
+test clock-6.11 {clock roll over dates} {
+    set time [clock scan "March 1, 2001" -gmt true]
+    clock format $time -format %j -gmt true
+} {060}
diff --git a/contrib/tcl/tests/cmdIL.test b/contrib/tcl/tests/cmdIL.test
index ceeb86b0dc81..5b561054addc 100644
--- a/contrib/tcl/tests/cmdIL.test
+++ b/contrib/tcl/tests/cmdIL.test
@@ -7,7 +7,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) cmdIL.test 1.17 97/07/11 15:33:16
+# SCCS: @(#) cmdIL.test 1.18 97/09/18 11:42:12
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -194,57 +194,60 @@ test cmdIL-4.3 {DictionaryCompare procedure, numerics, leading zeros} {
 test cmdIL-4.4 {DictionaryCompare procedure, numerics, leading zeros} {
     lsort -dictionary {a3b a03B}
 } {a3b a03B}
-test cmdIL-4.5 {DictionaryCompare procedure, numerics, different lengths} {
+test cmdIL-4.5 {DictionaryCompare procedure, numerics, leading zeros} {
+    lsort -dictionary {00000 000}
+} {000 00000}
+test cmdIL-4.6 {DictionaryCompare procedure, numerics, different lengths} {
     lsort -dictionary {a321b a03210b}
 } {a321b a03210b}
-test cmdIL-4.6 {DictionaryCompare procedure, numerics, different lengths} {
+test cmdIL-4.7 {DictionaryCompare procedure, numerics, different lengths} {
     lsort -dictionary {a03210b a321b}
 } {a321b a03210b}
-test cmdIL-4.7 {DictionaryCompare procedure, numerics} {
+test cmdIL-4.8 {DictionaryCompare procedure, numerics} {
     lsort -dictionary {48 6a 18b 22a 21aa 35 36}
 } {6a 18b 21aa 22a 35 36 48}
-test cmdIL-4.8 {DictionaryCompare procedure, numerics} {
+test cmdIL-4.9 {DictionaryCompare procedure, numerics} {
     lsort -dictionary {a123x a123b}
 } {a123b a123x}
-test cmdIL-4.9 {DictionaryCompare procedure, numerics} {
+test cmdIL-4.10 {DictionaryCompare procedure, numerics} {
     lsort -dictionary {a123b a123x}
 } {a123b a123x}
-test cmdIL-4.10 {DictionaryCompare procedure, numerics} {
+test cmdIL-4.11 {DictionaryCompare procedure, numerics} {
     lsort -dictionary {a1b aab}
 } {a1b aab}
-test cmdIL-4.11 {DictionaryCompare procedure, numerics} {
+test cmdIL-4.12 {DictionaryCompare procedure, numerics} {
     lsort -dictionary {a1b a!b}
 } {a!b a1b}
-test cmdIL-4.12 {DictionaryCompare procedure, numerics} {
+test cmdIL-4.13 {DictionaryCompare procedure, numerics} {
     lsort -dictionary {a1b2c a1b1c}
 } {a1b1c a1b2c}
-test cmdIL-4.13 {DictionaryCompare procedure, numerics} {
+test cmdIL-4.14 {DictionaryCompare procedure, numerics} {
     lsort -dictionary {a1b2c a1b3c}
 } {a1b2c a1b3c}
-test cmdIL-4.14 {DictionaryCompare procedure, long numbers} {
+test cmdIL-4.15 {DictionaryCompare procedure, long numbers} {
     lsort -dictionary {a7654884321988762b a7654884321988761b}
 } {a7654884321988761b a7654884321988762b}
-test cmdIL-4.15 {DictionaryCompare procedure, long numbers} {
+test cmdIL-4.16 {DictionaryCompare procedure, long numbers} {
     lsort -dictionary {a8765488432198876b a7654884321988761b}
 } {a7654884321988761b a8765488432198876b}
-test cmdIL-4.16 {DictionaryCompare procedure, case} {
+test cmdIL-4.17 {DictionaryCompare procedure, case} {
     lsort -dictionary {aBCd abcc}
 } {abcc aBCd}
-test cmdIL-4.17 {DictionaryCompare procedure, case} {
+test cmdIL-4.18 {DictionaryCompare procedure, case} {
     lsort -dictionary {aBCd abce}
 } {aBCd abce}
-test cmdIL-4.18 {DictionaryCompare procedure, case} {
+test cmdIL-4.19 {DictionaryCompare procedure, case} {
     lsort -dictionary {abcd ABcc}
 } {ABcc abcd}
-test cmdIL-4.19 {DictionaryCompare procedure, case} {
+test cmdIL-4.20 {DictionaryCompare procedure, case} {
     lsort -dictionary {abcd ABce}
 } {abcd ABce}
-test cmdIL-4.20 {DictionaryCompare procedure, case} {
+test cmdIL-4.21 {DictionaryCompare procedure, case} {
     lsort -dictionary {abCD ABcd}
 } {ABcd abCD}
-test cmdIL-4.21 {DictionaryCompare procedure, case} {
+test cmdIL-4.22 {DictionaryCompare procedure, case} {
     lsort -dictionary {ABcd aBCd}
 } {ABcd aBCd}
-test cmdIL-4.22 {DictionaryCompare procedure, case} {
+test cmdIL-4.23 {DictionaryCompare procedure, case} {
     lsort -dictionary {ABcd AbCd}
 } {ABcd AbCd}
diff --git a/contrib/tcl/tests/env.test b/contrib/tcl/tests/env.test
index e76ad7d58720..1bfc8ddaf1f3 100644
--- a/contrib/tcl/tests/env.test
+++ b/contrib/tcl/tests/env.test
@@ -10,10 +10,35 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) env.test 1.13 97/08/05 11:40:30
+# SCCS: @(#) env.test 1.14 97/10/31 17:00:03
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
+#
+# 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)
+} {}    
 if {[info commands exec] == ""} {
     puts "exec not implemented for this machine"
     return
@@ -76,42 +101,42 @@ foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH} {
   }
 }
 
-test env-1.1 {adding environment variables} {
+test env-2.1 {adding environment variables} {
     getenv
 } {}
 
 set env(NAME1) "test string"
-test env-1.2 {adding environment variables} {
+test env-2.2 {adding environment variables} {
     getenv
 } {NAME1=test string}
 
 set env(NAME2) "more"
-test env-1.3 {adding environment variables} {
+test env-2.3 {adding environment variables} {
     getenv
 } {NAME1=test string
 NAME2=more}
 
 set env(XYZZY) "garbage"
-test env-1.4 {adding environment variables} {
+test env-2.4 {adding environment variables} {
     getenv
 } {NAME1=test string
 NAME2=more
 XYZZY=garbage}
 
 set env(NAME2) "new value"
-test env-2.1 {changing environment variables} {
+test env-3.1 {changing environment variables} {
     getenv
 } {NAME1=test string
 NAME2=new value
 XYZZY=garbage}
 
 unset env(NAME2)
-test env-3.1 {unsetting environment variables} {
+test env-4.1 {unsetting environment variables} {
     getenv
 } {NAME1=test string
 XYZZY=garbage}
 unset env(NAME1)
-test env-3.2 {unsetting environment variables} {
+test env-4.2 {unsetting environment variables} {
     getenv
 } {XYZZY=garbage}
 
diff --git a/contrib/tcl/tests/expr-old.test b/contrib/tcl/tests/expr-old.test
index b2f577e6af4a..8fb8ad9f996c 100644
--- a/contrib/tcl/tests/expr-old.test
+++ b/contrib/tcl/tests/expr-old.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) expr-old.test 1.61 97/08/13 10:26:38
+# SCCS: @(#) expr-old.test 1.63 97/10/31 17:23:24
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -78,6 +78,12 @@ test expr-old-1.49 {integer operators} {expr -36%-5} -1
 test expr-old-1.50 {integer operators} {expr +36} 36
 test expr-old-1.51 {integer operators} {expr +--++36} 36
 test expr-old-1.52 {integer operators} {expr +36%+5} 1
+test expr-old-1.53 {integer operators} {
+    catch {unset x}
+    set x yes
+    list [expr {1 && $x}] [expr {$x && 1}] \
+         [expr {0 || $x}] [expr {$x || 0}]
+} {1 1 1 1}
 
 # Check the floating-point operators individually, along with
 # automatic conversion to integers where needed.
@@ -694,9 +700,19 @@ test expr-old-32.23 {math functions in expressions} {
 test expr-old-32.24 {math functions in expressions} {
     format %.6g [expr abs(66)]
 } {66}
-test expr-old-32.25 {math functions in expressions} {nonPortable} {
-    list [catch {expr abs(0x80000000)} msg] $msg
-} {1 {integer value too large to represent}}
+
+# The following test is different for 32-bit versus 64-bit architectures.
+
+if {0x80000000 > 0} {
+    test expr-old-32.25 {math functions in expressions} {nonPortable} {
+	list [catch {expr abs(0x8000000000000000)} msg] $msg
+    } {1 {integer value too large to represent}}
+} else {
+    test expr-old-32.25 {math functions in expressions} {nonPortable} {
+	list [catch {expr abs(0x80000000)} msg] $msg
+    } {1 {integer value too large to represent}}
+}
+
 test expr-old-32.26 {math functions in expressions} {
     expr double(1)
 } {1.0}
diff --git a/contrib/tcl/tests/expr.test b/contrib/tcl/tests/expr.test
index e0825f971fa2..3c4779fc9b76 100644
--- a/contrib/tcl/tests/expr.test
+++ b/contrib/tcl/tests/expr.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) expr.test 1.33 97/08/07 10:45:57
+# SCCS: @(#) expr.test 1.39 97/11/03 16:04:47
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -292,9 +292,19 @@ test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
 test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
 test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
 test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
-test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
-    expr {1<<31}
-} -2147483648
+
+# The following test is different for 32-bit versus 64-bit
+# architectures because LONG_MIN is different
+
+if {0x80000000 > 0} {
+    test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
+	expr {1<<63}
+    } -9223372036854775808
+} else {
+    test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
+	expr {1<<31}
+    } -2147483648
+}
 test expr-9.6 {CompileRelationalExpr: error in shift expr} {
     catch {expr x>>3} msg
     set msg
@@ -540,7 +550,11 @@ test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} {
 } {syntax error in expression "2+(3*(4+5)"
     while executing
 "expr 2+(3*(4+5)"}
-test expr-14.31 {CompilePrimaryExpr: unexpected token} {
+test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
+    set i "5+10"
+    list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15"
+} {{15 == 15} {15 == 15} {15 == 15}}
+test expr-14.32 {CompilePrimaryExpr: unexpected token} {
     catch {expr @} msg
     set errorInfo
 } {syntax error in expression "@"
@@ -602,9 +616,22 @@ if $gotT1 {
     } -17.5
 }
 
+test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
+    catch {unset a}
+    set a(VALUE) ff15
+    set i 123
+    if {[expr 0x$a(VALUE)] & 16} {
+        set i {}
+    }
+    set i
+} {}
+test expr-16.2 {GetToken: check for string literal in braces} {
+    expr {{1}}
+} {1}
+
 # Check "expr" and computed command names.
 
-test expr-16.1 {expr and computed command names} {
+test expr-17.1 {expr and computed command names} {
     set i 0
     set z expr
     $z 1+2
@@ -614,7 +641,7 @@ test expr-16.1 {expr and computed command names} {
 # an integer, convert to integer. Otherwise, if the string looks like a
 # double, convert to double.
 
-test expr-17.1 {expr and conversion of operands to numbers} {
+test expr-18.1 {expr and conversion of operands to numbers} {
     set x [lindex 11 0]
     catch {expr int($x)}
     expr {$x}
@@ -623,7 +650,7 @@ test expr-17.1 {expr and conversion of operands to numbers} {
 # Check "expr" and interpreter result object resetting before appending
 # an error msg during evaluation of exprs not in {}s
 
-test expr-18.1 {expr and interpreter result object resetting} {
+test expr-19.1 {expr and interpreter result object resetting} {
     proc p {} {
         set t  10.0
         set x  2.0
@@ -639,3 +666,5 @@ test expr-18.1 {expr and interpreter result object resetting} {
     }
     p
 } 3
+
+unset a
diff --git a/contrib/tcl/tests/fCmd.test b/contrib/tcl/tests/fCmd.test
index e7d2279ef194..ae2b8b08cf9a 100644
--- a/contrib/tcl/tests/fCmd.test
+++ b/contrib/tcl/tests/fCmd.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) fCmd.test 1.31 97/08/05 11:42:09
+# SCCS: @(#) fCmd.test 1.33 97/11/03 15:58:08
 #
 
 if {[string compare test [info procs test]] == 1} then {source defs}
@@ -304,10 +304,15 @@ test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {
     file mkdir td1
     list $x [file exist td1]
 } {0 1}
-test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {unixOnly nonPortable} {
+test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {unixOnly} {
     cleanup
-    list [catch {file mkdir /tf1} msg] $msg
-} {1 {can't create directory "/tf1": permission denied}}
+    file delete -force foo
+    file mkdir foo
+    file attr foo -perm 040000
+    set result [list [catch {file mkdir foo/tf1} msg] $msg]
+    file delete -force foo
+    set result
+} {1 {can't create directory "foo/tf1": permission denied}}
 test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} {
     list [catch {file mkdir ${root}:} msg] $msg
 } [subst {1 {can't create directory "${root}:": no such file or directory}}]
@@ -568,15 +573,17 @@ test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} {unixOnly xdev} {
     file rename td1 /tmp
     glob td* /tmp/td1/t*
 } {/tmp/td1/td2}
-test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} {unixOnly nonPortable} {
+test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} {unixOnly} {
     cleanup
-    if [file exists /kernel] {
-        set msg [list [catch {file rename /kernel td1} msg] $msg]
-	set a1 {1 {can't unlink "/kernel": permission denied}}
-	expr {$msg == $a1}
-    } else {
-        list 1
-    }
+    file mkdir foo/bar
+    file attr foo -perm 040555
+    set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
+    set a1 {1 {can't unlink "foo/bar": permission denied}}
+    set result [expr {$msg == $a1}]
+    catch {file delete /tmp/bar}
+    catch {file attr foo -perm 040777}
+    catch {file delete -force foo}
+    set result
 } {1}
 test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} {unixOnly xdev} {
     catch {cleanup /tmp}
@@ -618,15 +625,24 @@ test fCmd-7.5 {FileForceOption: multiple times through loop} {
     list [catch {glob -- -- -force} msg] $msg
 } {1 {no files matched glob patterns "-- -force"}}
 
-test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} {unixOnly nonPortable} {
-    list [catch {file rename ~$user /} msg] $msg
-} "1 {error renaming \"~$user\" to \"/[file tail ~$user]\": permission denied}"
+test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} {unixOnly} {
+    file mkdir td1
+    file attr td1 -perm 040000
+    set result [list [catch {file rename ~$user td1} msg] $msg]
+    file delete -force td1
+    set result
+} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"
 
 test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly} {
     cleanup
     file mkdir td1
-    list [catch {file rename td1 /} msg] $msg
-} {1 {error renaming "td1" to "/td1": permission denied}}
+    file mkdir td2
+    file attr td2 -perm 040000
+    set result [list [catch {file rename td1 td2/} msg] $msg]
+    file delete -force td2
+    file delete -force td1
+    set result
+} {1 {error renaming "td1" to "td2/td1": permission denied}}
 test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {
     cleanup
     list [catch {file rename tf1 tf2} msg] $msg
diff --git a/contrib/tcl/tests/fileName.test b/contrib/tcl/tests/fileName.test
index f6be5acc3550..e0f7260f2cee 100644
--- a/contrib/tcl/tests/fileName.test
+++ b/contrib/tcl/tests/fileName.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) fileName.test 1.30 97/08/01 11:13:27
+# SCCS: @(#) fileName.test 1.31 97/08/19 18:45:07
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -1313,16 +1313,30 @@ if {$tcl_platform(platform) == "unix"} {
     # On some systems, like AFS, "000" protection doesn't prevent
     # access by owner, so the following test is not portable.
 
-    exec chmod 000 globTest
+    exec chmod 000 globTest/a1
     test filename-15.1 {unix specific globbing} {nonPortable} {
-	string tolower [list [catch {glob globTest/*} msg]  $msg $errorCode]
-    } {1 {couldn't read directory "globtest": permission denied} {posix eacces {permission denied}}}
-    exec chmod 755 globTest
-    test filename-15.2 {unix specific globbing} {nonPortable} {
+	string tolower [list [catch {glob globTest/a1/*} msg]  $msg $errorCode]
+    } {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
+    test filename-15.2 {unix specific no complain: no errors} {nonPortable} {
+	glob -nocomplain globTest/a1/*
+    } {}
+    test filename-15.3 {unix specific no complain: no errors, good result} {nonPortable knownBug} {
+	# test fails because if an error occur , the interp's result
+	# is reset...
+	glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
+    } {globTest/a2 globTest/a3}
+    exec chmod 755 globTest/a1
+    test filename-15.4 {unix specific no complain: no errors, good result} {nonPortable knownBug} {
+	# test fails because if an error occur , the interp's result
+	# is reset... (or you don't run at sunscript where the
+	# outser and demailly's users exists
+	glob -nocomplain ~ouster ~foo ~demailly
+    } {/home/ouster /home/demailly}
+    test filename-15.5 {unix specific globbing} {nonPortable} {
 	glob ~ouster/.csh*
     } "/home/ouster/.cshrc"
     close [open globTest/odd\\\[\]*?\{\}name w]
-    test filename-15.3 {unix specific globbing} {
+    test filename-15.6 {unix specific globbing} {
 	global env
 	set temp $env(HOME)
 	set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
diff --git a/contrib/tcl/tests/format.test b/contrib/tcl/tests/format.test
index 680b626af0b0..758825ba293c 100644
--- a/contrib/tcl/tests/format.test
+++ b/contrib/tcl/tests/format.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) format.test 1.28 97/08/11 14:45:15
+# SCCS: @(#) format.test 1.29 97/09/03 15:51:02
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -411,6 +411,26 @@ test format-12.5 {tcl_precision fuzzy comparison} {
     set c [expr $a + $b]
     format {%0.10f %0.12f %0.15f} $c $c $c
 } {1.4444444444 1.444444444444 1.444444444443990}
+test format-13.1 {testing MAX_FLOAT_SIZE for 0 and 1} {
+    format {%s} ""
+} {}
+test format-13.2 {testing MAX_FLOAT_SIZE for 0 and 1} {
+    format {%s} "a"
+} {a}
+
+set a "0123456789"
+set b ""
+for {set i 0} {$i < 290} {incr i} {
+    append b $a
+}
+for {set i 290} {$i < 400} {incr i} {
+    test format-14.[expr $i -290] {testing MAX_FLOAT_SIZE} {
+        format {%s} $b    
+    } $b
+    append b "x"
+}
+
+
 catch {unset a}
 catch {unset b}
 catch {unset c}
diff --git a/contrib/tcl/tests/get.test b/contrib/tcl/tests/get.test
index 50e68bb03112..5155b95e2d3d 100644
--- a/contrib/tcl/tests/get.test
+++ b/contrib/tcl/tests/get.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) get.test 1.6 96/10/08 17:39:21
+# SCCS: @(#) get.test 1.7 97/10/31 17:23:00
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -39,24 +39,43 @@ test get-1.6 {Tcl_GetInt procedure} {
 } {1 {expected integer but got "16	 x"}}
 
 # The following tests are non-portable because they depend on
-# word size.  
+# word size.  18446744073709551614
 
-test get-1.7 {Tcl_GetInt procedure} {nonPortable unixOnly} {
-    set x 44
-    list [catch {incr x 4294967296} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
-test get-1.8 {Tcl_GetInt procedure} {nonPortable} {
-    set x 0
-    list [catch {incr x 4294967294} msg] $msg
-} {0 -2}
-test get-1.9 {Tcl_GetInt procedure} {nonPortable} {
-    set x 0
-    list [catch {incr x +4294967294} msg] $msg
-} {0 -2}
-test get-1.10 {Tcl_GetInt procedure} {nonPortable} {
-    set x 0
-    list [catch {incr x -4294967294} msg] $msg
-} {0 2}
+if {0x80000000 > 0} {
+    test get-1.7 {Tcl_GetInt procedure} {nonPortable unixOnly} {
+	set x 44
+	list [catch {incr x 18446744073709551616} msg] $msg $errorCode
+    } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+    test get-1.8 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x 18446744073709551614} msg] $msg
+    } {0 -2}
+    test get-1.9 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x +18446744073709551614} msg] $msg
+    } {0 -2}
+    test get-1.10 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x -18446744073709551614} msg] $msg
+    } {0 2}
+} else {
+    test get-1.7 {Tcl_GetInt procedure} {nonPortable unixOnly} {
+	set x 44
+	list [catch {incr x 4294967296} msg] $msg $errorCode
+    } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+    test get-1.8 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x 4294967294} msg] $msg
+    } {0 -2}
+    test get-1.9 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x +4294967294} msg] $msg
+    } {0 -2}
+    test get-1.10 {Tcl_GetInt procedure} {nonPortable} {
+	set x 0
+	list [catch {incr x -4294967294} msg] $msg
+    } {0 2}
+}
 
 test get-2.1 {Tcl_GetInt procedure} {
     format %g 1.23
diff --git a/contrib/tcl/tests/init.test b/contrib/tcl/tests/init.test
new file mode 100644
index 000000000000..2d6e068412b6
--- /dev/null
+++ b/contrib/tcl/tests/init.test
@@ -0,0 +1,149 @@
+# Functionality covered: this file contains a collection of tests for the
+# auto loading and namespaces.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) init.test 1.5 97/11/19 18:08:20
+
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# Clear out any namespaces called test_ns_*
+catch {eval namespace delete [namespace children :: test_ns_*]}
+
+# Six cases - white box testing
+
+test init-1.1 {auto_qualify - absolute cmd - namespace} {
+    auto_qualify ::foo::bar ::blue
+} ::foo::bar
+
+test init-1.2 {auto_qualify - absolute cmd - global} {
+    auto_qualify ::global ::sub
+} global
+
+test init-1.3 {auto_qualify - no colons cmd - global} {
+    auto_qualify nocolons ::
+} nocolons 
+
+test init-1.4 {auto_qualify - no colons cmd - namespace} {
+    auto_qualify nocolons ::sub
+} {::sub::nocolons nocolons}
+
+test init-1.5 {auto_qualify - colons in cmd - global} {
+    auto_qualify foo::bar ::
+} ::foo::bar
+
+test init-1.6 {auto_qualify - colons in cmd - namespace} {
+    auto_qualify foo::bar ::sub
+} {::sub::foo::bar ::foo::bar}
+
+# Some additional tests
+
+test init-1.7 {auto_qualify - multiples colons 1} {
+    auto_qualify :::foo::::bar ::blue
+} ::foo::bar
+
+test init-1.8 {auto_qualify - multiple colons 2} {
+    auto_qualify :::foo ::bar
+} foo
+
+
+# we use a sub interp and auto_reset and double the tests because there is 2
+# places where auto_loading occur (before loading the indexes files and after)
+
+set testInterp [interp create]
+interp eval $testInterp [list set VERBOSE $VERBOSE]
+interp eval $testInterp [list set TESTS $TESTS]
+
+interp eval $testInterp {
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+auto_reset
+catch {rename parray {}}
+
+test init-2.0 {load parray - stage 1} {
+    set ret [catch {namespace eval ::test {parray}} error]
+    rename parray {} ; # remove it, for the next test - that should not fail.
+    list $ret $error
+} {1 {no value given for parameter "a" to "parray"}}
+
+
+test init-2.1 {load parray - stage 2} {
+    set ret [catch {namespace eval ::test {parray}} error]
+    list $ret $error
+} {1 {no value given for parameter "a" to "parray"}}
+
+
+auto_reset
+catch {rename ::safe::setLogCmd {}}
+#unset auto_index(::safe::setLogCmd)
+#unset auto_oldpath
+
+test init-2.2 {load ::safe::setLogCmd - stage 1} {
+    ::safe::setLogCmd
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+test init-2.3 {load ::safe::setLogCmd - stage 2} {
+    ::safe::setLogCmd
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+auto_reset
+catch {rename ::safe::setLogCmd {}}
+
+test init-2.4 {load safe:::setLogCmd - stage 1} {
+    safe:::setLogCmd ; # intentionally 3 :
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+test init-2.5 {load safe:::setLogCmd - stage 2} {
+    safe:::setLogCmd ; # intentionally 3 :
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+auto_reset
+catch {rename ::safe::setLogCmd {}}
+
+test init-2.6 {load setLogCmd from safe:: - stage 1} {
+    namespace eval safe setLogCmd 
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+test init-2.7 {oad setLogCmd from safe::  - stage 2} {
+    namespace eval safe setLogCmd 
+    rename ::safe::setLogCmd {} ; # should not fail
+} {}
+
+
+auto_reset
+package require http 2.0
+catch {rename ::http::geturl {}}
+
+test init-2.8 {load http::geturl (package)} {
+    # 3 ':' on purpose
+    set ret [catch {namespace eval ::test {http:::geturl}} error]
+    # removing it, for the next test. should not fail.
+    rename ::http::geturl {} ; 
+    list $ret $error
+} {1 {no value given for parameter "url" to "http:::geturl"}}
+
+
+test init-3.0 {random stuff in the auto_index, should still work} {
+    set auto_index(foo:::bar::blah) {
+	namespace eval foo {namespace eval bar {proc blah {} {return 1}}}
+    }
+    foo:::bar::blah
+} 1
+
+}
+
+interp delete $testInterp
+
diff --git a/contrib/tcl/tests/interp.test b/contrib/tcl/tests/interp.test
index 9127bcb54bcf..919774f7bb32 100644
--- a/contrib/tcl/tests/interp.test
+++ b/contrib/tcl/tests/interp.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) interp.test 1.61 97/08/04 19:59:52
+# SCCS: @(#) interp.test 1.64 97/09/04 16:02:23
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -1974,6 +1974,43 @@ test interp-26.2 {result code transmission 2} {knownBug} {
     list $res
 } {-1 0 1 2 3 4 5}
 
+test interp-26.3 {errorInfo transmission : regular interps} {
+    set interp [interp create];
+    proc MyError {secret} {
+	return -code error "msg"
+    }
+    proc MyTestAlias {interp args} {
+	MyError "some secret"
+    }
+    interp alias $interp test {} MyTestAlias $interp;
+    set res [interp eval $interp {catch test;set errorInfo}]
+    interp delete $interp;
+    set res
+} {msg
+    while executing
+"MyError "some secret""
+    (procedure "test" line 2)
+    invoked from within
+"catch test"}
+
+test interp-26.4 {errorInfo transmission : safe interps} {knownBug} {
+    # this test fails because the errorInfo is fully transmitted
+    # whether the interp is safe or not. this is maybe a feature
+    # and not a bug.
+    set interp [interp create -safe];
+    proc MyError {secret} {
+	return -code error "msg"
+    }
+    proc MyTestAlias {interp args} {
+	MyError "some secret"
+    }
+    interp alias $interp test {} MyTestAlias $interp;
+    set res [interp eval $interp {catch test;set errorInfo}]
+    interp delete $interp;
+    set res
+} {msg
+    while executing
+"catch test"}
 
 # Interps & Namespaces
 test interp-27.1 {interp aliases & namespaces} {
@@ -2153,12 +2190,68 @@ test interp-28.1 {getting fooled by slave's namespace ?} {
     set r
 } {}
 
+# Tests of recursionlimit
+# We need testsetrecursionlimit so we need Tcltest package
+if {[catch {package require Tcltest} msg]} {
+    puts "This application hasn't been compiled with Tcltest"
+    puts "skipping remining interp tests that relies on it."
+} else {
+    # 
+test interp-29.1 {recursion limit} {
+    set i [interp create]
+    load {} Tcltest $i
+    set r [interp eval $i {
+	testsetrecursionlimit 50
+	proc p {} {incr ::i; p}
+	set i 0
+	catch p
+	set i
+    }]
+   interp delete $i
+   set r
+} 49
+
+test interp-29.2 {recursion limit inheritance} {
+    set i [interp create]
+    load {} Tcltest $i
+    set ii [interp eval $i {
+	testsetrecursionlimit 50
+	interp create
+    }]
+    set r [interp eval [list $i $ii] {
+	proc p {} {incr ::i; p}
+	set i 0
+	catch p
+	set i
+    }]
+   interp delete $i
+   set r
+} 49
+
+#    # Deep recursion (into interps when the regular one fails):
+#    # still crashes...
+#    proc p {} {
+#	if {[catch p ret]} {
+#	    catch {
+#		set i [interp create]
+#		interp eval $i [list proc p {} [info body p]]
+#		interp eval $i p
+#	    }
+#	    interp delete $i
+#	    return ok
+#	}
+#	return $ret
+#    }
+#    p
+
 # more tests needed...
 
 # Interp & stack
 #test interp-29.1 {interp and stack (info level)} {
 #} {}
 
+}
+
 
 foreach i [interp slaves] {
   interp delete $i
diff --git a/contrib/tcl/tests/io.test b/contrib/tcl/tests/io.test
index 739248281a6d..2b6670fb9e20 100644
--- a/contrib/tcl/tests/io.test
+++ b/contrib/tcl/tests/io.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) io.test 1.128 97/08/13 10:24:56
+# SCCS: @(#) io.test 1.131 97/09/22 11:15:05
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -3439,6 +3439,58 @@ test io-16.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
     close $f
     set x
 } 40000
+test io-16.14 {Tcl_SetChannelOption, setting read mode independently} \
+	{socket} {
+    proc accept {s a p} {close $s}
+    set s1 [socket -server accept 0]
+    set port [lindex [fconfigure $s1 -sockname] 2]
+    set s2 [socket localhost $port]
+    update
+    fconfigure $s2 -translation {auto lf}
+    set modes [fconfigure $s2 -translation]
+    close $s1
+    close $s2
+    set modes
+} {auto lf}
+test io-16.15 {Tcl_SetChannelOption, setting read mode independently} \
+	{socket} {
+    proc accept {s a p} {close $s}
+    set s1 [socket -server accept 0]
+    set port [lindex [fconfigure $s1 -sockname] 2]
+    set s2 [socket localhost $port]
+    update
+    fconfigure $s2 -translation {auto crlf}
+    set modes [fconfigure $s2 -translation]
+    close $s1
+    close $s2
+    set modes
+} {auto crlf}
+test io-16.16 {Tcl_SetChannelOption, setting read mode independently} \
+	{socket} {
+    proc accept {s a p} {close $s}
+    set s1 [socket -server accept 0]
+    set port [lindex [fconfigure $s1 -sockname] 2]
+    set s2 [socket localhost $port]
+    update
+    fconfigure $s2 -translation {auto cr}
+    set modes [fconfigure $s2 -translation]
+    close $s1
+    close $s2
+    set modes
+} {auto cr}
+test io-16.17 {Tcl_SetChannelOption, setting read mode independently} \
+	{socket} {
+    proc accept {s a p} {close $s}
+    set s1 [socket -server accept 0]
+    set port [lindex [fconfigure $s1 -sockname] 2]
+    set s2 [socket localhost $port]
+    update
+    fconfigure $s2 -translation {auto auto}
+    set modes [fconfigure $s2 -translation]
+    close $s1
+    close $s2
+    set modes
+} {auto crlf}
 
 test io-17.1 {POSIX open access modes: RDWR} {
     removeFile test3
@@ -5054,6 +5106,25 @@ test io-32.1 {ChannelEventScriptInvoker: deletion} {
     set x
 } {got_error}
 
+test io-33.1 {ChannelTimerProc} {
+    set f [open fooBar w]
+    puts $f "this is a test"
+    close $f
+    set f [open fooBar r]
+    testchannelevent $f add readable {
+	read $f 1
+	incr x
+    }
+    set x 0
+    vwait x
+    vwait x
+    set result $x
+    testchannelevent $f set 0 none
+    after idle {set y done}
+    vwait y
+    lappend result $y
+} {2 done}
+
 removeFile fooBar
 removeFile longfile
 removeFile script
diff --git a/contrib/tcl/tests/ioCmd.test b/contrib/tcl/tests/ioCmd.test
index 95a5975594e4..fd39263a0ed4 100644
--- a/contrib/tcl/tests/ioCmd.test
+++ b/contrib/tcl/tests/ioCmd.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# "@(#) ioCmd.test 1.48 97/08/01 11:11:23"
+# "@(#) ioCmd.test 1.49 97/10/31 17:23:22"
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -281,11 +281,11 @@ test iocmd-8.17 {fconfigure command / tcp channel} {nonPortable} {
 	update;
 	puts $cli "blah"; flush $cli; # that flush could/should fail too
 	update;
-	set r [list [catch {fconfigure $cli -peername} msg] $msg];
+	set r [catch {fconfigure $cli -peername} msg]
 	iocmdSSHTDWN
 	regsub -all {can([^:])+: } $r {} r;
 	set r
-} {1 {connection reset by peer}}
+} 1
 test iocmd-8.18 {fconfigure command / unix tty channel} {nonPortable unixOnly} {
 	# might fail if /dev/ttya is unavailable
 	set tty [open /dev/ttya]
diff --git a/contrib/tcl/tests/join.test b/contrib/tcl/tests/join.test
index 4023de2cab6a..62af644fa088 100644
--- a/contrib/tcl/tests/join.test
+++ b/contrib/tcl/tests/join.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) join.test 1.6 96/02/16 08:56:02
+# SCCS: @(#) join.test 1.7 97/10/06 13:04:59
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -36,3 +36,13 @@ test join-2.2 {join errors} {
 test join-2.3 {join errors} {
     list [catch {join "a \{ c" 111} msg] $msg $errorCode
 } {1 {unmatched open brace in list} NONE}
+
+test join-3.1 {joinString is binary ok} {
+  string length [join {a b c} a\0b]
+} 9
+
+test join-3.2 {join is binary ok} {
+  string length [join "a\0b a\0b a\0b"]
+} 11
+
+
diff --git a/contrib/tcl/tests/linsert.test b/contrib/tcl/tests/linsert.test
index 6611394a6182..86a47f5290df 100644
--- a/contrib/tcl/tests/linsert.test
+++ b/contrib/tcl/tests/linsert.test
@@ -10,10 +10,13 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) linsert.test 1.13 97/02/27 16:53:19
+# SCCS: @(#) linsert.test 1.14 97/11/18 13:54:18
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
+catch {unset lis}
+catch {rename p ""}
+
 test linsert-1.1 {linsert command} {
     linsert {1 2 3 4 5} 0 a
 } {a 1 2 3 4 5}
@@ -92,3 +95,11 @@ test linsert-3.1 {linsert won't modify shared argument objects} {
     }
     p
 } "a b c"
+test linsert-3.2 {linsert won't modify shared argument objects} {
+    catch {unset lis}
+    set lis [format "a \"%s\" c" "b"]
+    linsert $lis 0 [string length $lis]
+} "7 a b c"
+
+catch {unset lis}
+catch {rename p ""}
diff --git a/contrib/tcl/tests/lreplace.test b/contrib/tcl/tests/lreplace.test
index 197084e7bd21..44e8ee17525f 100644
--- a/contrib/tcl/tests/lreplace.test
+++ b/contrib/tcl/tests/lreplace.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) lreplace.test 1.15 96/12/16 21:43:57
+# SCCS: @(#) lreplace.test 1.16 97/10/29 16:32:39
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -89,6 +89,13 @@ test lreplace-1.24 {lreplace command} {
 test lreplace-1.25 {lreplace command} {
     concat \"[lreplace {\}\     hello} end end]\"
 } {"\}\ "}
+test lreplace-1.26 {lreplace command} {
+    catch {unset foo}
+    set foo {a b}
+    list [set foo [lreplace $foo end end]] \
+        [set foo [lreplace $foo end end]] \
+        [set foo [lreplace $foo end end]]
+} {a {} {}}
 
 
 test lreplace-2.1 {lreplace errors} {
@@ -120,3 +127,5 @@ test lreplace-3.1 {lreplace won't modify shared argument objects} {
     }
     p
 } "a b c"
+
+catch {unset foo}
diff --git a/contrib/tcl/tests/obj.test b/contrib/tcl/tests/obj.test
index e8ee3b32f94f..08f230b542be 100644
--- a/contrib/tcl/tests/obj.test
+++ b/contrib/tcl/tests/obj.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# @(#) obj.test 1.11 97/08/06 08:56:09
+# @(#) obj.test 1.12 97/10/31 17:23:23
 
 if {[info commands testobj] == {}} {
     puts "This application hasn't been compiled with the \"testobj\""
@@ -411,10 +411,10 @@ test obj-24.5 {SetIntFromAny, error parsing string} {
 } {x17 1 {expected integer but got "x17"}}
 test obj-24.6 {SetIntFromAny, integer too large} {nonPortable} {
     set result ""
-    lappend result [teststringobj set 1 12345678901234567890]
+    lappend result [teststringobj set 1 123456789012345678901]
     lappend result [catch {testintobj mult10 1} msg]
     lappend result $msg
-} {12345678901234567890 1 {integer value too large to represent}}
+} {123456789012345678901 1 {integer value too large to represent}}
 test obj-24.7 {SetIntFromAny, error converting from "empty string"} {
     set result ""
     lappend result [testobj newobj 1]
diff --git a/contrib/tcl/tests/opt.test b/contrib/tcl/tests/opt.test
index 2f23bc6890dc..0b35b764a451 100644
--- a/contrib/tcl/tests/opt.test
+++ b/contrib/tcl/tests/opt.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) opt.test 1.1 97/08/14 00:53:59
+# SCCS: @(#) opt.test 1.2 97/08/20 15:57:18
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -149,6 +149,7 @@ test opt-8.10 {List utilities} {
 } {{b c 7 e} f}
 
 test opt-8.11 {List utilities} {
+    catch {unset x}
     set l {a {b c 7 e} f}
     list [::tcl::Lassign $l u v w x] \
 	    $u $v $w [info exists x]
@@ -173,11 +174,11 @@ test opt-9.2 {Misc utilities} {
 #### behaviour tests #####
 
 test opt-10.1 {ambigous flags} {
-    ::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} {}
+    ::tcl::OptProc optTest {{-fla} {-other} {-flag2xyz} {-flag3xyz}} {}
     catch {optTest -fL} msg
     set msg
 } {ambigous option "-fL", choose from:
-    -flag1xyz boolflag (false) 
+    -fla      boolflag (false) 
     -flag2xyz boolflag (false) 
     -flag3xyz boolflag (false) }
 
@@ -188,6 +189,24 @@ test opt-10.2 {non ambigous flags} {
     optTest -fLaG2
 } 1
 
+test opt-10.3 {non ambigous flags because of exact match} {
+    ::tcl::OptProc optTest {{-flag1x} {-other} {-flag1} {-flag1xy}} {
+	return $flag1
+    }
+    optTest -flAg1
+} 1
+
+test opt-10.4 {ambigous flags, not exact match} {
+    ::tcl::OptProc optTest {{-flag1xy} {-other} {-flag1} {-flag1xyz}} {
+	return $flag1
+    }
+    catch {optTest -fLag1X} msg
+    set msg
+} {ambigous option "-fLag1X", choose from:
+    -flag1xy  boolflag (false) 
+    -flag1xyz boolflag (false) }
+
+
 
 # medium size overall test example: (defined once)
 ::tcl::OptProc optTest {
@@ -200,13 +219,13 @@ test opt-10.2 {non ambigous flags} {
     list $cmd $allowBoing $arg2 $arg3 $moreflags
 }
 
-test opt-10.3 {medium size overall test} {
+test opt-10.5 {medium size overall test} {
     list [catch {optTest} msg] $msg
 } {1 {no value given for parameter "cmd" (use -help for full usage) :
     cmd choice (print save delete) sub command to choose}}
 
 
-test opt-10.4 {medium size overall test} {
+test opt-10.6 {medium size overall test} {
     list [catch {optTest -help} msg] $msg
 } {1 {Usage information:
     Var/FlagName Type     Value   Help
@@ -218,19 +237,19 @@ test opt-10.4 {medium size overall test} {
     ?arg3?       int      (7)     optional number
     -moreflags   boolflag (false) }}
 
-test opt-10.5 {medium size overall test} {
+test opt-10.7 {medium size overall test} {
     optTest save tst
 } {save 1 tst 7 0}
 
-test opt-10.6 {medium size overall test} {
+test opt-10.8 {medium size overall test} {
     optTest save -allowBoing false -- 8
 } {save 0 8 7 0}
 
-test opt-10.7 {medium size overall test} {
+test opt-10.9 {medium size overall test} {
     optTest save tst -m --
 } {save 1 tst 7 1}
 
-test opt-10.8 {medium size overall test} {
+test opt-10.10 {medium size overall test} {
     list [catch {optTest save tst foo} msg] [lindex [split $msg "\n"] 0]
 } {1 {too many arguments (unexpected argument(s): foo), usage:}}
 
diff --git a/contrib/tcl/tests/resource.test b/contrib/tcl/tests/resource.test
index efb3c8270a77..e815ef8c494d 100644
--- a/contrib/tcl/tests/resource.test
+++ b/contrib/tcl/tests/resource.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) resource.test 1.6 97/07/23 17:41:51
+# SCCS: @(#) resource.test 1.8 97/11/06 12:36:32
 
 # Only run this test on Macintosh systems
 if {$tcl_platform(platform) != "macintosh"} {
@@ -22,7 +22,7 @@ test resource-1.1 {resource tests} {
 } {1 {wrong # args: should be "resource option ?arg ...?"}}
 test resource-1.2 {resource tests} {
     list [catch {resource _bad_} msg] $msg
-} {1 {bad option "_bad_": must be close, list, open, read, types, or write}}
+} {1 {bad option "_bad_": must be close, delete, files, list, open, read, types, or write}}
 
 # resource open & close tests
 test resource-2.1 {resource open & close tests} {
@@ -41,16 +41,34 @@ test resource-2.5 {resource open & close tests} {
     testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {error "don't source me"}
     set id [resource open rsrc.file]
     resource close $id
+    file delete rsrc.file
 } {}
 test resource-2.6 {resource open & close tests} {
+    catch {file delete rsrc.file}
+    testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {error "don't source me"}
+    set id [resource open rsrc.file]
+    set result [string compare [resource open rsrc.file] $id]
+    resource close $id
+    file delete rsrc.file
+    set result
+} {0}
+test resource-2.7 {resource open & close tests} {
     list [catch {resource close} msg] $msg
 } {1 {wrong # args: should be "resource close resourceRef"}}
-test resource-2.7 {resource open & close tests} {
+test resource-2.8 {resource open & close tests} {
     list [catch {resource close foo bar} msg] $msg
 } {1 {wrong # args: should be "resource close resourceRef"}}
-test resource-2.8 {resource open & close tests} {
+test resource-2.9 {resource open & close tests} {
     list [catch {resource close _bad_resource_} msg] $msg
 } {1 {invalid resource file reference "_bad_resource_"}}
+test resource-2.10 {resource open & close tests} {
+    set result [catch {resource close System} mssg]
+    lappend result $mssg
+} {1 {can't close "System" resource file}}
+test resource-2.11 {resource open & close tests} {
+    set result [catch {resource close application} mssg]
+    lappend result $mssg
+} {1 {can't close "application" resource file}}
 
 # Tests for listing resources
 test resource-3.1 {resource list tests} {
@@ -74,7 +92,7 @@ test resource-3.5 {resource list tests} {
     set result
 } {fileRsrcName}
 test resource-3.6 {resource list tests} {
-    # There should be any resource of this type
+    # There should not be any resource of this type
     resource list XXXX
 } {}
 test resource-3.7 {resource list tests} {
@@ -86,7 +104,7 @@ test resource-3.7 {resource list tests} {
     }
 } {ok}
 
-# Tests for listing resources
+# Tests for reading resources
 test resource-4.1 {resource read tests} {
     list [catch {resource read} msg] $msg
 } {1 {wrong # args: should be "resource read resourceType resourceId ?resourceRef?"}}
@@ -123,43 +141,197 @@ test resource-5.4 {resource types tests} {
 # resource write tests
 test resource-6.1 {resource write tests} {
     list [catch {resource write} msg] $msg
-} {1 {wrong # args: should be "resource write ?-id resourceId? ?-name resourceName? ?-file resourceRef? resourceType data"}}
+} {1 {wrong # args: should be "resource write ?-id resourceId? ?-name resourceName? ?-file resourceRef? ?-force? resourceType data"}}
 test resource-6.2 {resource write tests} {
     list [catch {resource write _bad_type_ data} msg] $msg
 } {1 {expected Macintosh OS type but got "_bad_type_"}}
 test resource-6.3 {resource write tests} {
     catch {file delete rsrc2.file}
     set id [resource open rsrc2.file w]
+    resource close $id
+    set id [resource open rsrc2.file r]
+    set result [catch {resource write -file $id -name Hello TEXT foo} errMsg]
+    lappend result [string compare $errMsg "cannot write to resource file \"$id\", it was opened read only"]
+    lappend result [lsearch [resource list TEXT $id] Hello]
+    resource close $id
+    file delete rsrc2.file
+    set result   
+} {1 0 -1}
+test resource-6.4 {resource write tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
     resource write -file $id -name Hello TEXT {set x "our test data"}
     source -rsrc Hello rsrc2.file
     resource close $id
     file delete rsrc2.file
     set x
 } {our test data}
+test resource-6.5 {resource write tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    resource write -file $id -id 256 TEXT {HAHAHAHAHAHAHA}
+    set result [catch {resource write -file $id -id 256 TEXT {HOHOHOHOHOHO}} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {the resource 256 already exists, use "-force" to overwrite it.}}
+test resource-6.6 {resource write tests} {
+    catch {file delete rsrc2.file}
+    testWriteTextResource -rsrc fileRsrcName -rsrcid 256  -file rsrc2.file  -protected {error "don't tread on me"}
+    set id [resource open rsrc2.file w]
+    set result [catch {resource write -id 256 -force -file $id TEXT {NAHNAHNANAHNAH}} mssg] 
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {could not write resource id 256 of type TEXT, it was protected.}}
+test resource-6.7 {resource write tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    resource write -file $id -id 256 -name FOO TEXT {set x [list "our first test data"]}
+    resource write -file $id -id 256 -name BAR -force TEXT {set x [list "our second test data"]}
+    source -rsrcid 256 rsrc2.file
+    lappend x [resource list TEXT $id]
+    resource close $id
+    file delete rsrc2.file
+    set x
+} {{our second test data} BAR}
 
+#Tests for listing open resource files
+test resource-7.1 {resource file tests} {
+    catch {resource files foo bar} mssg
+    set mssg
+} {wrong # args: should be "resource files ?resourceId?"}
+test resource-7.2 {resource file tests} {
+    catch {file delete rsrc2.file}
+    set rsrcFiles [resource files]
+    set id [resource open rsrc2.file w]
+    set result [string compare $rsrcFiles [lrange [resource files] 1 end]]
+    lappend result [string compare $id [lrange [resource files] 0 0]]
+    resource close $id
+    file delete rsrc2.file
+    set result
+} {0 0}
+test resource-7.3 {resource file tests} {
+    set result 0
+    foreach file [resource files] {
+        if {[catch {resource types $file}] != 0} {
+            set result 1
+        }
+    }
+    set result
+} {0}
+test resource-7.4 {resource file tests} {
+    catch {resource files __NO_SUCH_RESOURCE__} mssg
+    set mssg
+} {invalid resource file reference "__NO_SUCH_RESOURCE__"}
+test resource-7.5 {resource file tests} {
+    set sys [resource files System]
+    string compare $sys [file join $env(SYS_FOLDER) System]
+} {0}
+test resource-7.6 {resource file tests} {
+    set app [resource files application]
+    string compare $app [info nameofexecutable]
+} {0}
+
+#Tests for the resource delete command
+test resource-8.1 {resource delete tests} {
+    list [catch {resource delete} msg] $msg
+} {1 {wrong # args: should be "resource delete ?-id resourceId? ?-name resourceName? ?-file resourceRef? resourceType"}}
+test resource-8.2 {resource delete tests} {
+    list [catch {resource delete TEXT} msg] $msg
+} {1 {you must specify either "-id" or "-name" or both to "resource delete"}}
+test resource-8.3 {resource delete tests} {
+    set result [catch {resource delete -file ffffff -id 128 TEXT} mssg]
+    lappend result $mssg    
+} {1 {invalid resource file reference "ffffff"}}    
+test resource-8.4 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
+    set id [resource open rsrc2.file r]
+    set result [catch {resource delete -id 128 -file $id TEXT} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result [string compare $mssg "cannot delete from resource file \"$id\", it was opened read only"]   
+} {1 0}
+test resource-8.5 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
+    set id [resource open rsrc2.file w]
+    set result [catch {resource delete -id 128 -file $id _bad_type_} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {expected Macintosh OS type but got "_bad_type_"}}
+test resource-8.5 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    set result [catch {resource delete -id 128 -file $id TEXT} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {resource not found}}
+test resource-8.6 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    set result [catch {resource delete -name foo -file $id TEXT} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {resource not found}}
+test resource-8.7 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    set id [resource open rsrc2.file w]
+    resource write -file $id -name foo -id 128 TEXT {some stuff}
+    resource write -file $id -name bar -id 129 TEXT {some stuff}
+    set result [catch {resource delete -name foo -id 129 -file $id TEXT} mssg]
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {"-id" and "-name" values do not point to the same resource}}
+test resource-8.8 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    testWriteTextResource -rsrc fileRsrcName -rsrcid 256  -file rsrc2.file  -protected {error "don't tread on me"}
+    set id [resource open rsrc2.file w]
+    set result [catch {resource delete -id 256 -file $id TEXT } mssg] 
+    resource close $id
+    file delete rsrc2.file
+    lappend result $mssg
+} {1 {resource cannot be deleted: it is protected.}}
+test resource-8.9 {resource delete tests} {
+    catch {file delete rsrc2.file}
+    testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
+    set id [resource open rsrc2.file w]
+    set result [resource list TEXT $id]
+    resource delete -id 128 -file $id TEXT
+    lappend result [resource list TEXT $id]
+    resource close $id
+    file delete rsrc2.file
+    set result
+} {fileRsrcName {}}
+    
 # Tests for the Mac version of the source command
 catch {file delete rsrc.file}
 testWriteTextResource -rsrc fileRsrcName -rsrcid 128 \
     -file rsrc.file  {set rsrc_foo 1}
-test resource-7.1 {source command} {
+test resource-9.1 {source command} {
     catch {unset rsrc_foo}
     source -rsrc fileRsrcName rsrc.file
     list [catch {set rsrc_foo} msg] $msg
 } {0 1}
-test resource-7.2 {source command} {
+test resource-9.2 {source command} {
     catch {unset rsrc_foo}
     list [catch {source -rsrc no_resource rsrc.file} msg] $msg
 } {1 {The resource "no_resource" could not be loaded from rsrc.file.}}
-test resource-7.3 {source command} {
+test resource-9.3 {source command} {
     catch {unset rsrc_foo}
     source -rsrcid 128 rsrc.file
     list [catch {set rsrc_foo} msg] $msg
 } {0 1}
-test resource-7.4 {source command} {
+test resource-9.4 {source command} {
     catch {unset rsrc_foo}
     list [catch {source -rsrcid bad_int rsrc.file} msg] $msg
 } {1 {expected integer but got "bad_int"}}
-test resource-7.5 {source command} {
+test resource-9.5 {source command} {
     catch {unset rsrc_foo}
     list [catch {source -rsrcid 100 rsrc.file} msg] $msg
 } {1 {The resource "ID=100" could not be loaded from rsrc.file.}}
diff --git a/contrib/tcl/tests/safe.test b/contrib/tcl/tests/safe.test
index d68424bdf404..c23f06aa18c8 100644
--- a/contrib/tcl/tests/safe.test
+++ b/contrib/tcl/tests/safe.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) safe.test 1.31 97/08/14 00:55:56
+# SCCS: @(#) safe.test 1.34 97/11/19 14:59:13
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -38,7 +38,9 @@ test safe-1.2 {safe::interpCreate syntax} {
     ?slave?       name     ()      name of the slave (optional)
     -accessPath   list     ()      access path for the slave
     -noStatics    boolflag (false) prevent loading of statically linked pkgs
+    -statics      boolean  (true)  loading of statically linked pkgs
     -nestedLoadOk boolflag (false) allow nested loading
+    -nested       boolean  (false) nested loading
     -deleteHook   script   ()      delete hook}}
 
 test safe-1.3 {safe::interpInit syntax} {
@@ -186,7 +188,7 @@ test safe-7.1 {tests that everything works at high level} {
 } 1.0
 
 test safe-7.2 {tests specific path and interpFind/AddToAccessPath} {
-    set i [safe::interpCreate -nostat -nested -accessPath [list [info library]]];
+    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]];
     # should not add anything (p0)
     set token1 [safe::interpAddToAccessPath $i [info library]]
     # should add as p1
@@ -197,7 +199,7 @@ test safe-7.2 {tests specific path and interpFind/AddToAccessPath} {
 	    [catch {interp eval $i {package require http 1}} msg] $msg \
 	    [safe::interpConfigure $i]\
 	    [safe::interpDelete $i]
-} "{\$p(:0:)} {\$p(:1:)} 1 {can't find package http 1} {-accessPath {$tcl_library /dummy/unixlike/test/path} -noStatics -nestedLoadOk -deleteHook {}} {}"
+} "{\$p(:0:)} {\$p(:1:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library /dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}"
 
 
 # test source control on file name
@@ -349,13 +351,41 @@ test safe-9.2 {safe interps' error in deleteHook} {
 } {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}} {}}
 
 
+test safe-9.3 {dual specification of statics} {
+    list [catch {safe::interpCreate -stat true -nostat} msg] $msg
+} {1 {conflicting values given for -statics and -noStatics}}
 
-# features which still need test cases:
-# -nostatics and -nestedloadok which
-# are not easily tested from tclsh, can be
-# tested in wish though (safetk.test)
-# (we'd need a static package)
-# we have Tcltest !
+test safe-9.4 {dual specification of statics} {
+    # no error shall occur
+    safe::interpDelete [safe::interpCreate -stat false -nostat]
+} {}
+
+test safe-9.5 {dual specification of nested} {
+    list [catch {safe::interpCreate -nested 0 -nestedload} msg] $msg
+} {1 {conflicting values given for -nested and -nestedLoadOk}}
+
+test safe-9.6 {interpConfigure widget like behaviour} {
+   # this test shall work, don't try to "fix it" unless
+   # you *really* know what you are doing (ie you are me :p) -- dl
+   list [set i [safe::interpCreate \
+	                           -noStatics \
+                                   -nestedLoadOk \
+	                           -deleteHook {foo bar}];
+         safe::interpConfigure $i -accessPath /foo/bar ;
+         safe::interpConfigure $i]\
+	[safe::interpConfigure $i -aCCess]\
+	[safe::interpConfigure $i -nested]\
+	[safe::interpConfigure $i -statics]\
+	[safe::interpConfigure $i -DEL]\
+	[safe::interpConfigure $i -accessPath /blah -statics 1;
+	 safe::interpConfigure $i]\
+	[safe::interpConfigure $i -deleteHook toto -nosta -nested 0;
+	 safe::interpConfigure $i]
+} {{-accessPath /foo/bar -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath /foo/bar} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath /blah -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath /blah -statics 0 -nested 0 -deleteHook toto}}
+
+
+# testing that nested and statics do what is advertised
+# (we use a static package : Tcltest)
 
 if {[catch {package require Tcltest} msg]} {
     puts "This application hasn't been compiled with Tcltest"
@@ -392,7 +422,7 @@ test safe-10.3 {testing nested statics loading / no nested by default} {
 
 
 test safe-10.4 {testing nested statics loading / -nestedloadok} {
-    set i [safe::interpCreate -nested]
+    set i [safe::interpCreate -nestedloadok]
     list \
 	    [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
 	    $msg \
diff --git a/contrib/tcl/tests/set-old.test b/contrib/tcl/tests/set-old.test
index 2b4cd620f1fe..a101e7bb4290 100644
--- a/contrib/tcl/tests/set-old.test
+++ b/contrib/tcl/tests/set-old.test
@@ -7,12 +7,12 @@
 # No output means no errors were found.
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) set-old.test 1.20 97/07/25 17:45:55
+# SCCS: @(#) set-old.test 1.22 97/10/29 14:05:07
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -297,45 +297,72 @@ test set-old-8.7 {array command, anymore option} {
     catch {unset a}
     list [catch {array anymore a x} msg] $msg
 } {1 {"a" isn't an array}}
-test set-old-8.8 {array command, donesearch option} {
+test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array anymore a x]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.9 {array command, donesearch option} {
     catch {unset a}
     list [catch {array donesearch a x} msg] $msg
 } {1 {"a" isn't an array}}
-test set-old-8.9 {array command, exists option} {
+test set-old-8.10 {array command, donesearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array donesearch a x]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.11 {array command, exists option} {
     list [catch {array exists a b} msg] $msg
 } {1 {wrong # args: should be "array exists arrayName"}}
-test set-old-8.10 {array command, exists option} {
+test set-old-8.12 {array command, exists option} {
     catch {unset a}
     array exists a
 } {0}
-test set-old-8.11 {array command, exists option} {
+test set-old-8.13 {array command, exists option} {
     catch {unset a}
     set a(0) 1
     array exists a
 } {1}
-test set-old-8.12 {array command, get option} {
+test set-old-8.14 {array command, exists option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array exists a]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {0 0}
+test set-old-8.15 {array command, get option} {
     list [catch {array get} msg] $msg
 } {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
-test set-old-8.13 {array command, get option} {
+test set-old-8.16 {array command, get option} {
     list [catch {array get a b c} msg] $msg
 } {1 {wrong # args: should be "array get arrayName ?pattern?"}}
-test set-old-8.14 {array command, get option} {
+test set-old-8.17 {array command, get option} {
     catch {unset a}
     array get a
 } {}
-test set-old-8.15 {array command, get option} {
+test set-old-8.18 {array command, get option} {
     catch {unset a}
     set a(22) 3
     set {a(long name)} {}
     array get a
 } {22 3 {long name} {}}
-test set-old-8.16 {array command, get option (unset variable)} {
+test set-old-8.19 {array command, get option (unset variable)} {
     catch {unset a}
     set a(x) 3
     trace var a(y) w ignore
     array get a
 } {x 3}
-test set-old-8.17 {array command, get option, with pattern} {
+test set-old-8.20 {array command, get option, with pattern} {
     catch {unset a}
     set a(x1) 3
     set a(x2) 4
@@ -344,7 +371,16 @@ test set-old-8.17 {array command, get option, with pattern} {
     set a(b2) 25
     array get a x*
 } {x1 3 x2 4 x3 5}
-test set-old-8.18 {array command, names option} {
+test set-old-8.21 {array command, get option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array get a]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {0 {}}
+test set-old-8.22 {array command, names option} {
     catch {unset a}
     set a(22) 3
     list [catch {array names a 4 5} msg] $msg
@@ -353,25 +389,25 @@ test set-old-8.19 {array command, names option} {
     catch {unset a}
     array names a
 } {}
-test set-old-8.20 {array command, names option} {
+test set-old-8.23 {array command, names option} {
     catch {unset a}
     set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
     list [catch {lsort [array names a]} msg] $msg
 } {0 {22 Textual_name {name with spaces}}}
-test set-old-8.21 {array command, names option} {
+test set-old-8.24 {array command, names option} {
     catch {unset a}
     set a(22) 3; set a(33) 44;
     trace var a(xxx) w ignore
     list [catch {lsort [array names a]} msg] $msg
 } {0 {22 33}}
-test set-old-8.22 {array command, names option} {
+test set-old-8.25 {array command, names option} {
     catch {unset a}
     set a(22) 3; set a(33) 44;
     trace var a(xxx) w ignore
     set a(xxx) value
     list [catch {lsort [array names a]} msg] $msg
 } {0 {22 33 xxx}}
-test set-old-8.23 {array command, names option} {
+test set-old-8.26 {array command, names option} {
     catch {unset a}
     set a(axy) 3
     set a(bxy) 44
@@ -379,64 +415,119 @@ test set-old-8.23 {array command, names option} {
     set a(xxx) value
     list [lsort [array names a *xy]] [lsort [array names a]]
 } {{axy bxy} {axy bxy no xxx}}
-test set-old-8.24 {array command, nextelement option} {
+test set-old-8.27 {array command, names option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array names a]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {0 {}}
+test set-old-8.28 {array command, nextelement option} {
     list [catch {array nextelement a} msg] $msg
 } {1 {wrong # args: should be "array nextelement arrayName searchId"}}
-test set-old-8.25 {array command, nextelement option} {
+test set-old-8.29 {array command, nextelement option} {
     catch {unset a}
     list [catch {array nextelement a b} msg] $msg
 } {1 {"a" isn't an array}}
-test set-old-8.26 {array command, set option} {
+test set-old-8.30 {array command, nextelement option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array nextelement a b]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {1 {"a" isn't an array}}
+test set-old-8.31 {array command, set option} {
     list [catch {array set a} msg] $msg
 } {1 {wrong # args: should be "array set arrayName list"}}
-test set-old-8.27 {array command, set option} {
+test set-old-8.32 {array command, set option} {
     list [catch {array set a 1 2} msg] $msg
 } {1 {wrong # args: should be "array set arrayName list"}}
-test set-old-8.28 {array command, set option} {
+test set-old-8.33 {array command, set option} {
     list [catch {array set a "a \{ c"} msg] $msg
 } {1 {unmatched open brace in list}}
-test set-old-8.29 {array command, set option} {
+test set-old-8.34 {array command, set option} {
     catch {unset a}
     set a 44
     list [catch {array set a {a b c d}} msg] $msg
 } {1 {can't set "a(a)": variable isn't array}}
-test set-old-8.30 {array command, set option} {
+test set-old-8.35 {array command, set option} {
     catch {unset a}
     set a(xx) yy
     array set a {b c d e}
     array get a
 } {d e xx yy b c}
-test set-old-8.31 {array command, size option} {
+test set-old-8.36 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array set a {x 0}]
+        }
+        set a(x)
+    }
+    list [catch {foo 1} msg] $msg
+} {0 {}}
+test set-old-8.37 {array command, set option} {
+    catch {unset aVaRnAmE}
+    array set aVaRnAmE {}
+    list [info exists aVaRnAmE] [catch {set aVaRnAmE} msg] $msg
+} {1 1 {can't read "aVaRnAmE": variable is array}}
+test set-old-8.38 {array command, size option} {
+    catch {unset a}
+    array size a
+} {0}
+test set-old-8.39 {array command, size option} {
     list [catch {array size a 4} msg] $msg
 } {1 {wrong # args: should be "array size arrayName"}}
-test set-old-8.32 {array command, size option} {
+test set-old-8.40 {array command, size option} {
     catch {unset a}
     array size a
 } {0}
-test set-old-8.33 {array command, size option} {
+test set-old-8.41 {array command, size option} {
     catch {unset a}
     set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
     list [catch {array size a} msg] $msg
 } {0 3}
-test set-old-8.34 {array command, size option} {
+test set-old-8.42 {array command, size option} {
     catch {unset a}
     set a(22) 3; set a(xx) 44; set a(y) xxx
     unset a(22) a(y) a(xx)
     list [catch {array size a} msg] $msg
 } {0 0}
-test set-old-8.35 {array command, size option} {
+test set-old-8.43 {array command, size option} {
     catch {unset a}
     set a(22) 3;
     trace var a(33) rwu ignore
     list [catch {array size a} msg] $msg
 } {0 1}
-test set-old-8.36 {array command, startsearch option} {
+test set-old-8.44 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    proc foo {x} {
+        if {$x==1} {
+            return [array size a]
+        }
+        set a(x) 123
+    }
+    list [catch {foo 1} msg] $msg
+} {0 0}
+test set-old-8.45 {array command, startsearch option} {
     list [catch {array startsearch a b} msg] $msg
 } {1 {wrong # args: should be "array startsearch arrayName"}}
-test set-old-8.37 {array command, startsearch option} {
+test set-old-8.46 {array command, startsearch option} {
     catch {unset a}
     list [catch {array startsearch a} msg] $msg
 } {1 {"a" isn't an array}}
+test set-old-8.47 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
+    catch {rename p ""}
+    proc p {x} {
+        if {$x==1} {
+            return [array startsearch a]
+        }
+        set a(x) 123
+    }
+    list [catch {p 1} msg] $msg
+} {1 {"a" isn't an array}}
 
 test set-old-9.1 {ids for array enumeration} {
     catch {unset a}
@@ -676,4 +767,5 @@ test set-old-12.2 {cleanup on procedure return} {
 catch {unset a}
 catch {unset b}
 catch {unset c}
+catch {unset aVaRnAmE}
 return ""
diff --git a/contrib/tcl/tests/socket.test b/contrib/tcl/tests/socket.test
index 280db1ba5549..b2719de67b73 100644
--- a/contrib/tcl/tests/socket.test
+++ b/contrib/tcl/tests/socket.test
@@ -59,7 +59,7 @@
 # listening at port 2048. If all fails, a message is printed and the tests
 # using the remote server are not performed.
 #
-# SCCS: @(#) socket.test 1.82 97/08/05 13:30:55
+# SCCS: @(#) socket.test 1.83 97/09/15 16:29:47
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -402,7 +402,7 @@ test socket-2.5 {tcp connection with redundant server port} {stdio} {
     close $f
     set x
 } {ready hello}
-test socket-2.6 {tcp connection} {unixOrPc} {
+test socket-2.6 {tcp connection} {} {
     set status ok
     if {![catch {set sock [socket localhost 2828]}]} {
 	if {![catch {gets $sock}]} {
@@ -891,7 +891,7 @@ test socket-9.1 {testing spurious events} {
     close $s
     list $spurious $len
 } {0 50}
-test socket-9.2 {testing async write, fileevents, flush on close} {tempNotMac} {
+test socket-9.2 {testing async write, fileevents, flush on close} {} {
     set firstblock ""
     for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
     set secondblock ""
diff --git a/contrib/tcl/tests/source.test b/contrib/tcl/tests/source.test
index 1e0ff696c211..9a7e2305e9a1 100644
--- a/contrib/tcl/tests/source.test
+++ b/contrib/tcl/tests/source.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) source.test 1.25 97/07/02 16:41:34
+# SCCS: @(#) source.test 1.26 97/09/24 16:33:37
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -31,7 +31,7 @@ test source-1.2 {source command} {
     source source.file
 } result
 
-# The mac version of source returns a differnt result for
+# The mac version of source returns a different result for
 # the next two tests.
 
 if {$tcl_platform(platform) == "macintosh"} {
@@ -173,6 +173,13 @@ test source-5.6 {source resource files} {macOnly} {
     list $msg2 $result $msg
 } [list hello 1 bad]
 
+test source-6.1 {source is binary ok} {
+    set x {}
+    makeFile [list set x "a b\0c"] source.file
+    source source.file
+    string length $x
+} 5
+
 catch {removeFile source.file}
 
 # Generate null final value
diff --git a/contrib/tcl/tests/unixFCmd.test b/contrib/tcl/tests/unixFCmd.test
index 6b57e7565f87..037b5b472fe0 100644
--- a/contrib/tcl/tests/unixFCmd.test
+++ b/contrib/tcl/tests/unixFCmd.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) unixFCmd.test 1.14 97/08/15 10:22:11
+# SCCS: @(#) unixFCmd.test 1.15 97/11/03 15:58:22
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -79,16 +79,17 @@ test unixFCmd-1.5 {TclpRenameFile: ENOENT} {
 test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {
     # can't make it happen
 } {}
-test unixFCmd-1.7 {TclpRenameFile: EXDEV} {nonPortable} {
+test unixFCmd-1.7 {TclpRenameFile: EXDEV} {
     cleanup
-    file mkdir td1
-    if [file exists /kernel] {
-	set msg [list [catch {file rename /kernel td1} msg] $msg]
-	set a1 {1 {can't unlink "/kernel": permission denied}}
-	expr {$msg == $a1}
-    } else {
-        list 1
-    }
+    file mkdir foo/bar
+    file attr foo -perm 040555
+    set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
+    set a1 {1 {can't unlink "foo/bar": permission denied}}
+    set result [expr {$msg == $a1}]
+    catch {file delete /tmp/bar}
+    catch {file attr foo -perm 040777}
+    catch {file delete -force foo}
+    set result
 } {1}
 
 test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} {
@@ -232,7 +233,7 @@ test unixFCmd-17.3 {SetPermissionsAttribute} {
     close [open foo.test w]
     list [catch {file attributes foo.test -permissions foo} msg] $msg [file delete -force -- foo.test]
 } {1 {expected integer but got "foo"} {}}
-test unixFCmd-18.1 { nix pwd} {nonPortable} {
+test unixFCmd-18.1 {Unix pwd} {nonPortable} {
     # This test is nonportable because SunOS generates a weird error
     # message when the current directory isn't readable.
     set cd [pwd]
diff --git a/contrib/tcl/tests/unixNotfy.test b/contrib/tcl/tests/unixNotfy.test
index ba99db103eaa..5ed5f12adede 100644
--- a/contrib/tcl/tests/unixNotfy.test
+++ b/contrib/tcl/tests/unixNotfy.test
@@ -9,13 +9,22 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) unixNotfy.test 1.2 97/06/16 17:26:28
+# SCCS: @(#) unixNotfy.test 1.3 97/09/15 15:39:53
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
 if {$tcl_platform(platform) != "unix"} {
     return
 }
+
+# The tests should not be run if you have a notifier which is unable to
+# detect infinite vwaits, as the tests below will hang. The presence of
+# the "testeventloop" command indicates that this is the case.
+
+if {"[info commands testeventloop]" == "testeventloop"} {
+    return
+}
+
 test unixNotfy-1.1 {Tcl_DeleteFileHandler} {
     catch {vwait x}
     set f [open foo w]
diff --git a/contrib/tcl/tests/upvar.test b/contrib/tcl/tests/upvar.test
index 23419debd664..d9548b068bac 100644
--- a/contrib/tcl/tests/upvar.test
+++ b/contrib/tcl/tests/upvar.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) upvar.test 1.14 96/10/22 11:34:39
+# SCCS: @(#) upvar.test 1.15 97/10/29 18:25:56
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -315,6 +315,18 @@ test upvar-8.8 {create nested array with upvar} {
     catch {unset x}
     list [catch p1 msg] $msg
 } {1 {can't set "b(2)": variable isn't array}}
+test upvar-8.9 {upvar won't create namespace variable that refers to procedure variable} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    catch {rename MakeLink ""}
+    namespace eval ::test_ns_1 {}
+    proc MakeLink {a} {
+        namespace eval ::test_ns_1 {
+	    upvar a a
+        }
+        unset ::test_ns_1::a
+    }
+    list [catch {MakeLink 1} msg] $msg
+} {1 {bad variable name "a": upvar won't create namespace variable that refers to procedure variable}}
 
 if {[info commands testupvar] != {}} {
     test upvar-9.1 {Tcl_UpVar2 procedure} {
diff --git a/contrib/tcl/tests/winFCmd.test b/contrib/tcl/tests/winFCmd.test
index bca8c4bbc736..a38d72f62e02 100644
--- a/contrib/tcl/tests/winFCmd.test
+++ b/contrib/tcl/tests/winFCmd.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) winFCmd.test 1.10 97/08/05 11:44:57
+# SCCS: @(#) winFCmd.test 1.11 97/10/10 11:50:05
 #
 
 if {[string compare test [info procs test]] == 1} then {source defs}
@@ -853,32 +853,35 @@ test winFCmd-12.4 {ConvertFileNameFormat} {
     close [open td1 w]
     list [catch {string tolower [file attributes ./td1 -longname]} msg] $msg [cleanup]
 } {0 ./td1 {}}
-test winFCmd-12.5 {ConvertFileNameFormat} {
+test winFCmd-12.5 {ConvertFileNameFormat: absolute path} {
+    list [file attributes / -longname] [file attributes \\ -longname]
+} {/ /}
+test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} {
     catch {file delete -force -- c:/td1}
     close [open c:/td1 w]
     list [catch {string tolower [file attributes c:/td1 -longname]} msg] $msg [file delete -force -- c:/td1]
 } {0 c:/td1 {}}
-test winFCmd-12.6 {ConvertFileNameFormat} {UNCPath} {
+test winFCmd-12.7 {ConvertFileNameFormat} {UNCPath} {
     catch {file delete -force -- //bisque/icepick/test/td1}
     close [open //bisque/icepick/test/td1 w]
     list [catch {string tolower [file attributes //bisque/icepick/test/td1 -longname]} msg] $msg [file delete -force -- //bisque/icepick/test/td1]
 } {0 //bisque/icepick/test/td1 {}}
-test winFCmd-12.7 {ConvertFileNameFormat} {longFileNames} {
+test winFCmd-12.8 {ConvertFileNameFormat} {longFileNames} {
     cleanup
     close [open td1 w]
     list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
 } {0 td1 {}}
-test winFCmd-12.8 {ConvertFileNameFormat} {win32s} {
+test winFCmd-12.9 {ConvertFileNameFormat} {win32s} {
     cleanup
     close [open td1 w]
     list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
 } {0 td1 {}}
-test winFCmd-12.9 {ConvertFileNameFormat} {longFileNames} {
+test winFCmd-12.10 {ConvertFileNameFormat} {longFileNames} {
     cleanup
     close [open td1td1td1 w]
     list [catch {file attributes td1td1td1 -shortname}] [cleanup]
 } {0 {}}
-test winFCmd-12.10 {ConvertFileNameFormat} {longFileNames} {
+test winFCmd-12.11 {ConvertFileNameFormat} {longFileNames} {
     cleanup
     close [open td1 w]
     list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup]
diff --git a/contrib/tcl/tests/winPipe.test b/contrib/tcl/tests/winPipe.test
index 483dfec9cc12..404251fd342a 100644
--- a/contrib/tcl/tests/winPipe.test
+++ b/contrib/tcl/tests/winPipe.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) winPipe.test 1.9 97/08/05 11:44:28
+# SCCS: @(#) winPipe.test 1.11 97/10/09 17:06:16
 
 if {$tcl_platform(platform) != "windows"} {
     return
@@ -161,9 +161,6 @@ test winpipe-1.24 {32 bit comprehensive tests: read/write application} {
     catch {close $f}
     set r
 } "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-test winpipe-1.25 {32 bit comprehensive tests: to socket} {
-    # doesn't work
-} {}
 }
 
 set stderr16 "stderr16"
@@ -280,10 +277,83 @@ test winpipe-2.24 {16 bit comprehensive tests: read/write application} {nt} {
     catch {close $f}
     set r
 } "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-test winpipe-2.25 {16 bit comprehensive tests: to socket} {
-    # doesn't work
-} {}
 }
 
-file delete big little
+test winpipe-3.1 {Tcl_WaitPid} {nt} {
+    proc readResults {f} {
+	global x result
+	if { [eof $f] } {
+	    close $f
+	    set x 1
+	} else {
+	    set line [read $f ]
+	    set result "$result$line"
+	}
+    }
+
+    set f [open "|$cat32 < big 2> stderr" r]
+    fconfigure $f  -buffering none -blocking 0
+    fileevent $f readable "readResults $f"
+    set x 0
+    set result ""
+    vwait x
+    list $result $x [contents stderr]
+} "{$big} 1 stderr32"
+
+close [open nothing w]
+
+catch {set env_tmp $env(TMP)}
+catch {set env_temp $env(TEMP)}
+
+set env(TMP) c:/
+set env(TEMP) c:/
+
+test winpipe-3.1 {TclpCreateTempFile: cleanup temp files} {
+    set x {}
+    set existing [glob -nocomplain c:/tcl*.tmp]
+    exec $tcltest < nothing 
+    foreach p [glob -nocomplain c:/tcl*.tmp] {
+	if {[lsearch $existing $p] != -1} {
+	    lappend x $p
+	}
+    }
+    set x
+} {}
+test winpipe-3.2 {TclpCreateTempFile: TMP and TEMP not defined} {
+    set tmp $env(TMP)
+    set temp $env(TEMP)
+    unset env(TMP)
+    unset env(TEMP)
+    exec $tcltest < nothing
+    set env(TMP) $tmp
+    set env(TEMP) $temp
+    set x {}
+} {}
+test winpipe-3.3 {TclpCreateTempFile: TMP specifies non-existent directory} {
+    set tmp $env(TMP)
+    set env(TMP) snarky
+    exec $tcltest < nothing
+    set env(TMP) $tmp
+    set x {}
+} {}
+test winpipe-3.3 {TclpCreateTempFile: TEMP specifies non-existent directory} {
+    set tmp $env(TMP)
+    set temp $env(TEMP)
+    unset env(TMP)
+    set env(TEMP) snarky
+    exec $tcltest < nothing
+    set env(TMP) $tmp
+    set env(TEMP) $temp
+    set x {}
+} {}
+
+# restore old values fro env(TMP) and env(TEMP)
+
+if {[catch {set env(TMP) $env_tmp}]} {
+    unset $env(TMP)
+}
+if {[catch {set env(TEMP) $env_temp}]} {
+    unset $env(TEMP)
+}
 
+file delete big little stdout stderr nothing