Import tcl7.5p1

10 files changed, 343 insertions, 92 deletions

diff --git a/contrib/tcl/tests/clock.test b/contrib/tcl/tests/clock.test
index a14f13a01012..cf8d94bfae6d 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.5 96/04/05 15:30:36
+# SCCS: @(#) clock.test 1.6 96/07/23 16:16:43
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -46,10 +46,17 @@ test clock-3.2 {clock format tests} {
 test clock-3.3 {clock format tests} {
     list [catch {clock format foo} msg] $msg
 } {1 {expected unsigned time but got "foo"}}
-test clock-3.4 {clock format tests} {unixOnly} {
+test clock-3.4 {clock format tests} {unixOrPc} {
     set clockval 657687766
     clock format $clockval -format "%a %b %d %I:%M:%S %p %Y" -gmt true
 } "Sun Nov 04 03:02:46 AM 1990"
+test clock-3.5 {clock format tests} {
+    list [catch {clock format a b c d e g} msg] $msg
+} {1 {wrong # args: clock format clockval ?-format string? ?-gmt boolean?}}
+test clock-3.6 {clock format tests} {unixOrPc} {
+    set clockval -1
+    clock format $clockval -format "%a %b %d %I:%M:%S %p %Y" -gmt true
+} "Wed Dec 31 11:59:59 PM 1969"
 
 # clock scan
 test clock-4.1 {clock scan tests} {
diff --git a/contrib/tcl/tests/cmdAH.test b/contrib/tcl/tests/cmdAH.test
index 058ee73f6b0d..97c5bddf7c1b 100644
--- a/contrib/tcl/tests/cmdAH.test
+++ b/contrib/tcl/tests/cmdAH.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: @(#) cmdah.test 1.7 96/04/12 10:49:01
+# SCCS: @(#) cmdAH.test 1.9 96/07/01 14:38:19
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -404,7 +404,7 @@ test cmdah-3.42 {Tcl_FileCmd: tail} {
     set result [file tail ~]
     set env(HOME) $temp
     set result
-} {}
+} test
 test cmdah-3.43 {Tcl_FileCmd: tail} {
     global env
     set temp $env(HOME)
@@ -422,7 +422,7 @@ test cmdah-3.44 {Tcl_FileCmd: tail} {
     set result [file tail ~]
     set env(HOME) $temp
     set result
-} {}
+} test
 test cmdah-3.45 {Tcl_FileCmd: tail} {
     global env
     set temp $env(HOME)
@@ -431,7 +431,7 @@ test cmdah-3.45 {Tcl_FileCmd: tail} {
     set result [file tail ~]
     set env(HOME) $temp
     set result
-} {}
+} test
 test cmdah-3.46 {Tcl_FileCmd: tail} {
     testsetplatform unix
     file tail {f.oo\bar/baz.bat}
@@ -1016,7 +1016,11 @@ test cmdah-19.3 {Tcl_FileCmd: readlink errors} {unixOnly nonPortable} {
     list [catch {file readlink _bogus_} msg] [string tolower $msg] \
 	    [string tolower $errorCode]
 } {1 {couldn't readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdah-19.4 {Tcl_FileCmd: readlink errors} {macOrPc nonPortable} {
+test cmdah-19.4 {Tcl_FileCmd: readlink errors} {macOnly nonPortable} {
+    list [catch {file readlink _bogus_} msg] [string tolower $msg] \
+	    [string tolower $errorCode]
+} {1 {couldn't readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdah-19.5 {Tcl_FileCmd: readlink errors} {pcOnly nonPortable} {
     list [catch {file readlink _bogus_} msg] [string tolower $msg] \
 	    [string tolower $errorCode]
 } {1 {couldn't readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}
diff --git a/contrib/tcl/tests/defs b/contrib/tcl/tests/defs
index aaf6cfc72cf4..62f1e4c6c646 100644
--- a/contrib/tcl/tests/defs
+++ b/contrib/tcl/tests/defs
@@ -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: @(#) defs 1.37 96/04/12 13:45:04
+# SCCS: @(#) defs 1.38 96/07/24 17:18:20
 
 if ![info exists VERBOSE] {
     set VERBOSE 0
@@ -55,6 +55,7 @@ if {[info commands memory] == ""} {
 #			run tests that only work on PCs.
 #	unixOrPc -	1 means this is a UNIX or PC platform.
 #	macOrPc -	1 means this is a Mac or PC platform.
+#	macOrUnix -	1 means this is a Mac or UNIX platform.
 #	nonPortable -	1 means this the tests are being running in
 #			the master Tcl/Tk development environment;
 #			Some tests are inherently non-portable because
@@ -93,6 +94,7 @@ if {$tcl_platform(platform) == "windows"} {
 }
 set testConfig(unixOrPc) [expr $testConfig(unixOnly) || $testConfig(pcOnly)]
 set testConfig(macOrPc) [expr $testConfig(macOnly) || $testConfig(pcOnly)]
+set testConfig(macOrUnix) [expr $testConfig(macOnly) || $testConfig(unixOnly)]
 set testConfig(nonPortable) [file exists doAllTests]
 
 set f [open defs r]
diff --git a/contrib/tcl/tests/fileName.test b/contrib/tcl/tests/fileName.test
index 26e84d9ba013..abb3eb857d20 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.20 96/04/19 12:36:13
+# SCCS: @(#) fileName.test 1.23 96/07/31 11:46:11
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -1086,8 +1086,8 @@ test filename-11.12 {Tcl_GlobCmd} {
 testsetplatform $platform
 
 test filename-11.13 {Tcl_GlobCmd} {
-    list [catch {glob ~} msg] $msg
-} [list 0 [list $env(HOME)]]
+    list [catch {file join [lindex [glob ~] 0]} msg] $msg
+} [list 0 [file join $env(HOME)]]
 
 # The following tests will work on Windows platforms only if MKS
 # toolkit is installed.
diff --git a/contrib/tcl/tests/format.test b/contrib/tcl/tests/format.test
index 3fe4eb5a957b..e6764f3df4ac 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.22 96/02/16 08:55:56
+# SCCS: @(#) format.test 1.23 96/07/31 16:54:50
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -355,12 +355,6 @@ test format-10.12 {XPG3 %$n specifiers} {
     list [catch {format {%2$*d} 4 5 6} msg] $msg
 } {0 {    6}}
 
-test format-11.1 {enormous width specifiers} {
-    format "%077777777d" 77777777
-} {0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000077777777}
-test format-11.2 {enormous width specifiers} {
-    format "%*d" 123456789 77777777
-} {                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                77777777}
-test format-11.3 {negative width specifiers} {
+test format-11.1 {negative width specifiers} {
     format "%*d" -47 25
 } {25}
diff --git a/contrib/tcl/tests/io.test b/contrib/tcl/tests/io.test
index 60b75cd42c1d..2c856246c089 100644
--- a/contrib/tcl/tests/io.test
+++ b/contrib/tcl/tests/io.test
@@ -11,13 +11,24 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# "@(#) io.test 1.75 96/04/18 09:58:51"
+# "@(#) io.test 1.87 96/07/30 11:59:00"
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
 removeFile test1
 removeFile pipe
 
+# set up a long data file for some of the following tests
+
+set f [open longfile w]
+fconfigure $f -eofchar {} -translation lf
+for { set i 0 } { $i < 100 } { incr i} {
+    puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
+\#123456789abcdef01
+\#"
+    }
+close $f
+
 # These tests are disabled until we decide what to do with "unsupported0".
 #
 #test io-1.7 {unsupported0 command} {
@@ -339,14 +350,18 @@ test io-4.2 {Tcl_GetChannelType} {
     string compare $t file
 } 0
 test io-4.3 {Tcl_GetChannelFile, input} {
-    set f [open io.test r]
+    set f [open test1 w]
+    fconfigure $f -translation lf -eofchar {}
+    puts $f "1234567890\n098765432"
+    close $f
+    set f [open test1 r]
     gets $f
     set l ""
     lappend l [testchannel inputbuffered $f]
     lappend l [tell $f]
     close $f
     set l
-} {4022 74}
+} {10 11}
 test io-4.4 {Tcl_GetChannelFile, output} {
     removeFile test1
     set f [open test1 w]
@@ -678,39 +693,39 @@ test io-7.10 {Tcl_Write, looping and buffering} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -translation lf -eofchar {}
-    set f2 [open io.test r]
+    set f2 [open longfile r]
     for {set x 0} {$x < 10} {incr x} {
         puts $f1 [gets $f2]
     }
     close $f2
     close $f1
     file size test1
-} 439
+} 387
 test io-7.11 {Tcl_Write, no newline, implicit flush} {
     removeFile test1
     set f1 [open test1 w]
     fconfigure $f1 -eofchar {}
-    set f2 [open io.test r]
+    set f2 [open longfile r]
     for {set x 0} {$x < 10} {incr x} {
         puts -nonewline $f1 [gets $f2]
     }
     close $f1
     close $f2
     file size test1
-} 429
+} 377
 test io-7.12 {Tcl_Write on a pipe} {unixOrPc} {
     removeFile test1
     removeFile pipe
     set f1 [open pipe w]
     puts $f1 {
-	set f1 [open io.test r]
+	set f1 [open longfile r]
 	for {set x 0} {$x < 10} {incr x} {
 	    puts [gets $f1]
 	}
     }
     close $f1
     set f1 [open "|$tcltest pipe" r]
-    set f2 [open io.test r]
+    set f2 [open longfile r]
     set y ok
     for {set x 0} {$x < 10} {incr x} {
         set l1 [gets $f1]
@@ -735,7 +750,7 @@ test io-7.13 {Tcl_Write to a pipe, line buffered} {unixOrPc} {
     set y ok
     set f1 [open "|$tcltest pipe" r+]
     fconfigure $f1 -buffering line
-    set f2 [open io.test r]
+    set f2 [open longfile r]
     set line [gets $f2]
     puts $f1 $line
     set backline [gets $f1]
@@ -775,7 +790,7 @@ test io-7.15 {Tcl_Flush, channel not open for writing} {
 	[list 1 "channel \"$fd\" wasn't opened for writing"]
 } 0
 test io-7.16 {Tcl_Flush on pipe opened only for reading} {unixOrPc unixExecs} {
-    set fd [open "|cat io.test" r]
+    set fd [open "|cat longfile" r]
     set x [list [catch {flush $fd} msg] $msg]
     catch {close $fd}
     string compare $x \
@@ -1070,6 +1085,99 @@ test io-7.32 {Tcl_Write, background flush to slow reader} {unixOrPc asyncPipeClo
         set result ok
     }
 } ok
+test io-7.33 {Tcl_Flush, implicit flush on exit} {unixOrPc} {
+    set f [open script w]
+    puts $f {
+	set f [open test1 w]
+	fconfigure $f -translation lf
+	puts $f hello
+	puts $f bye
+	puts $f strange
+    }
+    close $f
+    eval exec $tcltest script
+    set f [open test1 r]
+    set r [read $f]
+    close $f
+    set r
+} {hello
+bye
+strange
+}
+test io-7.34 {Tcl_Close, async flush on close, using sockets} {
+    set c 0
+    set x running
+    set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
+    proc writelots {s l} {
+	for {set i 0} {$i < 2000} {incr i} {
+	    puts $s $l
+	}
+    }
+    proc accept {s a p} {
+	global x
+	fileevent $s readable [list readit $s]
+	fconfigure $s -blocking off
+	set x accepted
+    }
+    proc readit {s} {
+	global c x
+	set l [gets $s]
+	
+	if {[eof $s]} {
+	    close $s
+	    set x done
+	} elseif {([string length $l] > 0) || ![fblocked $s]} {
+	    incr c
+	}
+    }
+    set ss [socket -server accept 2828]
+    set cs [socket [info hostname] 2828]
+    vwait x
+    fconfigure $cs -blocking off
+    writelots $cs $l
+    close $cs
+    close $ss
+    vwait x
+    set c
+} 2000
+test io-7.35 {Tcl_Close vs fileevent vs multiple interpreters} {
+    catch {interp delete x}
+    catch {interp delete y}
+    interp create x
+    interp create y
+    set s [socket -server accept 2828]
+    proc accept {s a p} {
+	puts $s hello
+	close $s
+    }
+    set c [socket [info hostname] 2828]
+    interp share {} $c x
+    interp share {} $c y
+    close $c
+    x eval {
+	proc readit {s} {
+	    gets $s
+	    if {[eof $s]} {
+		close $s
+	    }
+	}
+    }
+    y eval {
+	proc readit {s} {
+	    gets $s
+	    if {[eof $s]} {
+		close $s
+	    }
+	}
+    }
+    x eval "fileevent $c readable \{readit $c\}"
+    y eval "fileevent $c readable \{readit $c\}"
+    y eval [list close $c]
+    update
+    close $s
+    interp delete x
+    interp delete y
+} ""
 
 # Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read.
 
@@ -2112,13 +2220,13 @@ test io-10.2 {Tcl_Read, zero byte count} {
     read stdin 0
 } ""
 test io-10.3 {Tcl_Read, negative byte count} {
-    set f [open io.test r]
+    set f [open longfile r]
     set l [list [catch {read $f -1} msg] $msg]
     close $f
     set l
 } {1 {bad argument "-1": should be "nonewline"}}
 test io-10.4 {Tcl_Read, positive byte count} {
-    set f [open io.test r]
+    set f [open longfile r]
     set x [read $f 1024]
     set s [string length $x]
     unset x
@@ -2126,7 +2234,7 @@ test io-10.4 {Tcl_Read, positive byte count} {
     set s
 } 1024
 test io-10.5 {Tcl_Read, multiple buffers} {
-    set f [open io.test r]
+    set f [open longfile r]
     fconfigure $f -buffersize 100
     set x [read $f 1024]
     set s [string length $x]
@@ -2135,19 +2243,19 @@ test io-10.5 {Tcl_Read, multiple buffers} {
     set s
 } 1024
 test io-10.6 {Tcl_Read, very large read} {
-    set f1 [open io.test r]
+    set f1 [open longfile r]
     set z [read $f1 1000000]
     close $f1
     set l [string length $z]
     set x ok
-    set z [file size io.test]
+    set z [file size longfile]
     if {$z != $l} {
         set x broken
     }
     set x
 } ok
 test io-10.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
-    set f1 [open io.test r]
+    set f1 [open longfile r]
     fconfigure $f1 -blocking off
     set z [read $f1 20]
     close $f1
@@ -2159,25 +2267,25 @@ test io-10.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
     set x
 } ok
 test io-10.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
-    set f1 [open io.test r]
+    set f1 [open longfile r]
     fconfigure $f1 -blocking off
     set z [read $f1 1000000]
     close $f1
     set x ok
     set l [string length $z]]
-    set z [file size io.test]]
+    set z [file size longfile]]
     if {$z != $l} {
         set x broken
     }
   set x
 } ok
 test io-10.9 {Tcl_Read, read to end of file} {
-    set f1 [open io.test r]
+    set f1 [open longfile r]
     set z [read $f1]
     close $f1
     set l [string length $z]
     set x ok
-    set z [file size io.test]
+    set z [file size longfile]
     if {$z != $l} {
         set x broken
     }
@@ -2295,7 +2403,7 @@ test io-11.1 {Tcl_Gets, reading what was written} {
     set z
 } ok
 test io-11.2 {Tcl_Gets into variable} {
-    set f1 [open io.test r]
+    set f1 [open longfile r]
     set c [gets $f1 x]
     set l [string length x]
     set z ok
@@ -2412,7 +2520,7 @@ test io-11.10 {Tcl_Gets, exercising double buffering} {
 # Test Tcl_Seek and Tcl_Tell.
 
 test io-12.1 {Tcl_Seek to current position at start of file} {
-    set f1 [open io.test r]
+    set f1 [open longfile r]
     seek $f1 0 current
     set c [tell $f1]
     close $f1
@@ -3040,7 +3148,7 @@ test io-14.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
 # Test Tcl_InputBuffered
 
 test io-15.1 {Tcl_InputBuffered} {
-    set f [open io.test r]
+    set f [open longfile r]
     fconfigure $f -buffersize 4096
     read $f 3
     set l ""
@@ -3050,7 +3158,7 @@ test io-15.1 {Tcl_InputBuffered} {
     set l
 } {4093 3}
 test io-15.2 {Tcl_InputBuffered, test input flushing on seek} {
-    set f [open io.test r]
+    set f [open longfile r]
     fconfigure $f -buffersize 4096
     read $f 3
     set l ""
@@ -3066,13 +3174,13 @@ test io-15.2 {Tcl_InputBuffered, test input flushing on seek} {
 # Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize
 
 test io-16.1 {Tcl_GetChannelBufferSize, default buffer size} {
-    set f [open io.test r]
+    set f [open longfile r]
     set s [fconfigure $f -buffersize]
     close $f
     set s
 } 4096
 test io-16.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
-    set f [open io.test r]
+    set f [open longfile r]
     set l ""
     lappend l [fconfigure $f -buffersize]
     fconfigure $f -buffersize 10000
@@ -3360,7 +3468,7 @@ test io-18.8 {POSIX open access modes: TRUNC} {
     close $f
     set x
 } abc
-test io-18.9 {POSIX open access modes: NONBLOCK} {nonPortable} {
+test io-18.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
     removeFile test3
     set f [open test3 {WRONLY NONBLOCK CREAT}]
     puts $f "NONBLOCK test"
@@ -3511,9 +3619,8 @@ test io-22.1 {FileEventProc procedure: normal read event} {
 	set x [gets $f2]; fileevent $f2 readable {}
     }
     puts $f2 text; flush $f2
-    after 200
     set x initial
-    update
+    vwait x
     set x
 } {text}
 test io-22.2 {FileEventProc procedure: error in read event} {
@@ -3523,9 +3630,8 @@ test io-22.2 {FileEventProc procedure: error in read event} {
     }
     fileevent $f2 readable {error bogus}
     puts $f2 text; flush $f2
-    after 200
     set x initial
-    update
+    vwait x
     rename bgerror {}
     list $x [fileevent $f2 readable]
 } {bogus {}}
@@ -3539,7 +3645,9 @@ test io-22.3 {FileEventProc procedure: normal write event} {
     }
     set x initial
     set count 3
-    update
+    vwait x
+    vwait x
+    vwait x
     set x
 } {initial triggered triggered triggered}
 test io-22.4 {FileEventProc procedure: eror in write event} {
@@ -3549,7 +3657,7 @@ test io-22.4 {FileEventProc procedure: eror in write event} {
     }
     fileevent $f2 writable {error bad-write}
     set x initial
-    update
+    vwait x
     rename bgerror {}
     list $x [fileevent $f2 writable]
 } {bad-write {}}
@@ -3563,9 +3671,9 @@ test io-22.5 {FileEventProc procedure: end of file} {unixOrPc unixExecs} {
 	    lappend x $line
 	}
     }
-    after 200
     set x initial
-    update
+    vwait x
+    vwait x
     close $f4
     set x
 } {initial foo eof}
@@ -3573,7 +3681,8 @@ test io-22.5 {FileEventProc procedure: end of file} {unixOrPc unixExecs} {
 catch {close $f2}
 catch {close $f3}
 
-}	# Closes if {($platform(platform) != "macintosh") && \
+}
+	# Closes if {($platform(platform) != "macintosh") && \
 	#		($testConfig(unixExecs) == 1)} clause
 
 close $f
@@ -3602,11 +3711,10 @@ test io-23.2 {DeleteFileEvent, cleanup on close} {
     }
     close $f
     set x initial
-    update
+    vwait x
     close $f2
     set x
 } {initial {f2 triggered: "foo bar"}}
-
 test io-23.3 {DeleteFileEvent, cleanup on close} {
     set f [open foo r]
     set f2 [open foo r]
@@ -3629,9 +3737,9 @@ test io-23.3 {DeleteFileEvent, cleanup on close} {
 	    [catch {fileevent $f3 readable}]
 } {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}
 
-if {[info commands testfevent] == ""} {
-	break
-}
+# Execute these tests only if the "testfevent" command is present.
+
+if {[info commands testfevent] == "testfevent"} {
 
 test io-24.1 {Tcl event loop vs multiple interpreters} {
     testfevent create
@@ -3774,6 +3882,10 @@ test io-25.6 {file events on shared files, deleting file events} {
     set x
 } {{script 1} {}}
 
+}
+
+# The above curly closes the test for presence of the "testfevent" command.
+
 test io-26.1 {testing readability conditions} {
     set f [open bar w]
     puts $f abcdefg
@@ -4329,6 +4441,7 @@ test io-27.6 {testing handler deletion vs reentrant calls} {
 	      {first after update}]
 } 0
 
+removeFile longfile
 removeFile script
 removeFile output
 removeFile test1
diff --git a/contrib/tcl/tests/license.terms b/contrib/tcl/tests/license.terms
index 3dcd816f4a3f..96ad96637376 100644
--- a/contrib/tcl/tests/license.terms
+++ b/contrib/tcl/tests/license.terms
@@ -26,7 +26,14 @@ IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
 NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
 MODIFICATIONS.
 
-RESTRICTED RIGHTS: Use, duplication or disclosure by the government
-is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
-of the Rights in Technical Data and Computer Software Clause as DFARS
-252.227-7013 and FAR 52.227-19.
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal 
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license. 
diff --git a/contrib/tcl/tests/lrange.test b/contrib/tcl/tests/lrange.test
index 43d92e2700a4..91f443936bb8 100644
--- a/contrib/tcl/tests/lrange.test
+++ b/contrib/tcl/tests/lrange.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: @(#) lrange.test 1.5 96/02/16 08:56:13
+# SCCS: @(#) lrange.test 1.6 96/07/10 17:16:47
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -56,6 +56,9 @@ test lrange-1.13 {range of list elements} {
 test lrange-1.14 {range of list elements} {
     lrange "a b c d" end 2
 } {}
+test lrange-1.14 {range of list elements} {
+    concat \"[lrange {a b \{\   	} 0 2]"
+} {"a b \{\ "}
 
 test lrange-2.1 {error conditions} {
     list [catch {lrange a b} msg] $msg
diff --git a/contrib/tcl/tests/lreplace.test b/contrib/tcl/tests/lreplace.test
index 95c14c0ad1e0..75cddb213418 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.12 96/02/16 08:56:14
+# SCCS: @(#) lreplace.test 1.13 96/07/10 17:16:47
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -86,6 +86,9 @@ test lreplace-1.23 {lreplace command} {
 test lreplace-1.24 {lreplace command} {
     lreplace {1 2 3 4} end -1 z
 } {1 2 3 z 4}
+test lreplace-1.25 {lreplace command} {
+    concat \"[lreplace {\}\     hello} end end]\"
+} {"\}\ "}
 
 
 test lreplace-2.1 {lreplace errors} {
diff --git a/contrib/tcl/tests/socket.test b/contrib/tcl/tests/socket.test
index a6c66428ea9e..8a356f600091 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.
 #
-# "@(#) socket.test 1.56 96/04/20 13:29:26"
+# SCCS: @(#) socket.test 1.62 96/08/01 15:57:49
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -108,6 +108,7 @@ if {$doTestsWithRemoteServer == 1} {
     if {[catch {set commandSocket [socket $remoteServerIP \
 						$remoteServerPort]}] != 0} {
 	if {[info commands exec] == ""} {
+	    set noRemoteTestReason "can't exec"
 	    set doTestsWithRemoteServer 0
 	} else {
 	    set remoteServerIP localhost
@@ -118,23 +119,28 @@ if {$doTestsWithRemoteServer == 1} {
 		   msg] == 0} {
 		after 1000
 		if {[catch {set commandSocket [socket $remoteServerIP \
-				$remoteServerPort]}] == 0} {
+				$remoteServerPort]} msg] == 0} {
 		    fconfigure $commandSocket -translation crlf -buffering line
 		} else {
+		    set noRemoteTestReason $msg
 		    set doTestsWithRemoteServer 0
 		}
 	    } else {
+		set noRemoteTestReason "$msg $tcltest"
 		set doTestsWithRemoteServer 0
 	    }
 	}
     } else {
 	fconfigure $commandSocket -translation crlf -buffering line
-   }
+    }
 }
 
 if {$doTestsWithRemoteServer == 0} {
-   puts "Skipping tests with remote server. See tests/socket.test for"
-   puts "information on how to run remote server."
+    puts "Skipping tests with remote server. See tests/socket.test for"
+    puts "information on how to run remote server."
+    if {[info exists VERBOSE] && ($VERBOSE != 0)} {
+	puts "Reason for not doing remote tests: $noRemoteTestReason"
+    }
 }
 
 #
@@ -481,6 +487,27 @@ test socket-2.9 {socket conflict} {unixOrPc} {
     invoked from within
 "set f [socket -server accept 2828]..."
     (file "script" line 1)}}
+test socket-2.10 {close on accept, accepted socket lives} {
+    set done 0
+    set ss [socket -server accept 2828]
+    proc accept {s a p} {
+	global ss
+	close $ss
+	fileevent $s readable "readit $s"
+	fconfigure $s -trans lf
+    }
+    proc readit {s} {
+	global done
+	gets $s
+	close $s
+	set done 1
+    }
+    set cs [socket [info hostname] 2828]
+    puts $cs hello
+    close $cs
+    vwait done
+    set done
+} 1
 
 test socket-3.1 {socket conflict} {unixOrPc} {
     removeFile script
@@ -733,6 +760,20 @@ test socket-7.4 {testing socket specific options} {
 	set x [fconfigure $s -sockname]
 	close $s
     }
+    set s1 [socket [info hostname] 2828]
+    vwait x
+    close $s
+    close $s1
+    set l ""
+    lappend l [lindex $x 2] [llength $x]
+} {2828 3}
+test socket-7.5 {testing socket specific options} {unixOrPc} {
+    set s [socket -server accept 2828]
+    proc accept {s a p} {
+	global x
+	set x [fconfigure $s -sockname]
+	close $s
+    }
     set s1 [socket localhost 2828]
     vwait x
     close $s
@@ -763,7 +804,7 @@ test socket-8.1 {testing -async flag on sockets} {
 	close $s
 	set x done
     }
-    set s1 [socket -async localhost 2828]
+    set s1 [socket -async [info hostname] 2828]
     vwait x
     set z [gets $s1]
     close $s
@@ -771,6 +812,83 @@ test socket-8.1 {testing -async flag on sockets} {
     set z
 } bye
 
+test socket-9.1 {testing spurious events} {
+    set len 0
+    set spurious 0
+    set done 0
+    proc readlittle {s} {
+	global spurious done len
+	set l [read $s 1]
+	if {[string length $l] == 0} {
+	    if {![eof $s]} {
+		incr spurious
+	    } else {
+		close $s
+		set done 1
+	    }
+	} else {
+	    incr len [string length $l]
+	}
+    }
+    proc accept {s a p} {
+	fconfigure $s -buffering none -blocking off
+	fileevent $s readable [list readlittle $s]
+    }
+    set s [socket -server accept 2828]
+    set c [socket [info hostname] 2828]
+    puts -nonewline $c 01234567890123456789012345678901234567890123456789
+    close $c
+    vwait done
+    close $s
+    list $spurious $len
+} {0 50}
+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 ""
+    for {set i 0} {$i < 16} {incr i} {
+	set secondblock "b$secondblock$secondblock"
+    }
+    set l [socket -server accept 8080]
+    proc accept {s a p} {
+	fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
+		-buffering line
+	fileevent $s readable "readable $s"
+    }
+    proc readable {s} {
+	set l [gets $s]
+	fileevent $s readable {}
+	after 1000 respond $s
+    }
+    proc respond {s} {
+	global firstblock
+	puts -nonewline $s $firstblock
+	after 1000 writedata $s
+    }
+    proc writedata {s} {
+	global secondblock
+	puts -nonewline $s $secondblock
+	close $s
+    }
+    set s [socket [info hostname] 8080]
+    fconfigure $s -blocking 0 -trans lf -buffering line
+    set count 0
+    puts $s hello
+    proc readit {s} {
+	global count done
+	set l [read $s]
+	incr count [string length $l]
+	if {[eof $s]} {
+	    close $s
+	    set done 1
+	}
+    }
+    fileevent $s readable "readit $s"
+    vwait done
+    close $l
+    set count
+} 65566
+
 removeFile script
 
 #
@@ -782,7 +900,7 @@ if {$doTestsWithRemoteServer == 0} {
     return
 }
 
-test socket-9.1 {tcp connection} {
+test socket-10.1 {tcp connection} {
     sendCommand {
 	set socket9_1_test_server [socket -server accept 2828]
 	proc accept {s a p} {
@@ -796,7 +914,7 @@ test socket-9.1 {tcp connection} {
     sendCommand {close $socket9_1_test_server}
     set r
 } done
-test socket-9.2 {client specifies its port} {
+test socket-10.2 {client specifies its port} {
     if {[info exists port]} {
 	incr port
     } else {
@@ -821,9 +939,9 @@ test socket-9.2 {client specifies its port} {
     set result
 } ok
 #
-# Tests io-9.3, io-9.4 have been removed.
+# Tests io-10.3, io-10.4 have been removed.
 #
-test socket-9.5 {trying to connect, no server} {
+test socket-10.5 {trying to connect, no server} {
     set status ok
     if {![catch {set s [socket $remoteServerIp 2828]}]} {
 	if {![catch {gets $s}]} {
@@ -833,9 +951,9 @@ test socket-9.5 {trying to connect, no server} {
     }
     set status
 } ok
-test socket-9.6 {remote echo, one line} {
+test socket-10.6 {remote echo, one line} {
     sendCommand {
-	set socket9_6_test_server [socket -server accept 2828]
+	set socket10_6_test_server [socket -server accept 2828]
 	proc accept {s a p} {
 	    fileevent $s readable [list echo $s]
 	    fconfigure $s -buffering line -translation crlf
@@ -854,12 +972,12 @@ test socket-9.6 {remote echo, one line} {
     puts $f hello
     set r [gets $f]
     close $f
-    sendCommand {close $socket9_6_test_server}
+    sendCommand {close $socket10_6_test_server}
     set r
 } hello
-test socket-9.7 {remote echo, 50 lines} {
+test socket-10.7 {remote echo, 50 lines} {
     sendCommand {
-	set socket9_7_test_server [socket -server accept 2828]
+	set socket10_7_test_server [socket -server accept 2828]
 	proc accept {s a p} {
 	    fileevent $s readable [list echo $s]
 	    fconfigure $s -buffering line -translation crlf
@@ -882,7 +1000,7 @@ test socket-9.7 {remote echo, 50 lines} {
 	}
     }
     close $f
-    sendCommand {close $socket9_7_test_server}
+    sendCommand {close $socket10_7_test_server}
     set cnt
 } 50
 # Macintosh sockets can have more than one server per port
@@ -891,7 +1009,7 @@ if {$tcl_platform(platform) == "macintosh"} {
 } else {
     set conflictResult {1 {couldn't open socket: address already in use}}
 }
-test socket-9.8 {socket conflict} {
+test socket-10.8 {socket conflict} {
     set s1 [socket -server accept 2828]
     if {[catch {set s2 [socket -server accept 2828]} msg]} {
 	set result [list 1 $msg]
@@ -902,9 +1020,9 @@ test socket-9.8 {socket conflict} {
     close $s1
     set result
 } $conflictResult
-test socket-9.9 {server with several clients} {
+test socket-10.9 {server with several clients} {
     sendCommand {
-	set socket9_9_test_server [socket -server accept 2828]
+	set socket10_9_test_server [socket -server accept 2828]
 	proc accept {s a p} {
 	    fconfigure $s -buffering line
 	    fileevent $s readable [list echo $s]
@@ -935,10 +1053,10 @@ test socket-9.9 {server with several clients} {
     close $s1
     close $s2
     close $s3
-    sendCommand {close $socket9_9_test_server}
+    sendCommand {close $socket10_9_test_server}
     set i
 } 100    
-test socket-9.10 {client with several servers} {
+test socket-10.10 {client with several servers} {
     sendCommand {
 	set s1 [socket -server "accept 3000" 3000]
 	set s2 [socket -server "accept 3001" 3001]
@@ -964,7 +1082,7 @@ test socket-9.10 {client with several servers} {
     }
     set l
 } {3000 {} 1 3001 {} 1 3002 {} 1}
-test socket-9.11 {accept callback error} {
+test socket-10.11 {accept callback error} {
     set s [socket -server accept 2828]
     proc accept {s a p} {expr 10 / 0}
     proc bgerror args {
@@ -984,9 +1102,9 @@ test socket-9.11 {accept callback error} {
     rename bgerror {}
     set x
 } {{divide by zero}}
-test socket-9.12 {testing socket specific options} {
+test socket-10.12 {testing socket specific options} {
     sendCommand {
-	set socket9_12_test_server [socket -server accept 2828]
+	set socket10_12_test_server [socket -server accept 2828]
 	proc accept {s a p} {close $s}
     }
     set s [socket $remoteServerIP 2828]
@@ -995,7 +1113,7 @@ test socket-9.12 {testing socket specific options} {
     set l ""
     lappend l [lindex $p 2] [llength $p] [llength $p]
     close $s
-    sendCommand {close $socket9_12_test_server}
+    sendCommand {close $socket10_12_test_server}
     set l
 } {2828 3 3}