merge trunkrobust_async_connect_tests

4 files changed, 80 insertions, 3 deletions

diff --git a/tests/all.tcl b/tests/all.tcl
index 05d3024..0a6f57f 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -15,5 +15,8 @@ package require Tcl 8.5
 package require tcltest 2.2
 namespace import tcltest::*
 configure {*}$argv -testdir [file dir [info script]]
+if {[singleProcess]} {
+    interp debug {} -frame 1
+}
 runAllTests
 proc exit args {}
diff --git a/tests/io.test b/tests/io.test
index bf5adb0..cef3e81 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7612,6 +7612,66 @@ test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix op
     close $f1
     list $::done $ch
 } {ok A}
+test io-53.13 {TclCopyChannel: read error reporting} -setup {
+    proc driver {cmd args} {
+        variable buffer
+        variable index
+        set chan [lindex $args 0]
+        switch -- $cmd {
+            initialize {
+                return {initialize finalize watch read}
+            }
+            finalize {
+                return
+            }
+            watch {}
+            read {
+		error FAIL
+            }
+        }
+    }
+    set outFile [makeFile {} out]
+} -body {
+    set in [chan create read [namespace which driver]]
+    chan configure $in -translation binary
+    set out [open $outFile wb]
+    chan copy $in $out
+} -cleanup {
+    catch {close $in}
+    catch {close $out}
+    removeFile out
+    rename driver {}
+} -result {error reading "*": *} -returnCodes error -match glob
+test io-53.14 {TclCopyChannel: write error reporting} -setup {
+    proc driver {cmd args} {
+        variable buffer
+        variable index
+        set chan [lindex $args 0]
+        switch -- $cmd {
+            initialize {
+                return {initialize finalize watch write}
+            }
+            finalize {
+                return
+            }
+            watch {}
+            write {
+                error FAIL
+            }
+        }
+    }
+    set inFile [makeFile {aaa} in]
+} -body {
+    set in [open $inFile rb]
+    set out [chan create write [namespace which driver]]
+    chan configure $out -translation binary
+    chan copy $in $out
+} -cleanup {
+    catch {close $in}
+    catch {close $out}
+    removeFile in
+    rename driver {}
+} -result {error writing "*": *} -returnCodes error -match glob
 
 test io-54.1 {Recursive channel events} {socket fileevent} {
     # This test checks to see if file events are delivered during recursive
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 8d35ec7..57f8d47 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -2748,10 +2748,9 @@ test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
 	    init* {set ret {initialize finalize watch read}}
 	    watch {
 		set l [lindex $args 0]
+		catch {after cancel $::timer}
 		if {[llength $l]} {
 		    set ::timer [after $::drive [list POST $ch]]
-		} else {
-		    after cancel $::timer
 		}
 	    }
 	    finalize {
@@ -2814,7 +2813,9 @@ test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
 	    update
 	}
 	LOG THREAD-LOOP-DONE
-	thread::exit
+	#thread::exit
+	# Thread exits cause leaks;  Use clean thread shutdown
+	set forever yourGirl
     }
 
     LOG MAIN_WAITING
diff --git a/tests/oo.test b/tests/oo.test
index d63e931..fcd9818 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -258,6 +258,19 @@ test oo-1.18 {OO: create object in NS with same name as global cmd} -setup {
     rename test-oo-1.18 {}
     A destroy
 } -result ::C
+test oo-1.18.1 {Bug 75b8433707: memory leak in oo-1.18} -setup {
+    proc test-oo-1.18 {} return
+} -constraints memory -body {
+    leaktest {
+	oo::class create A
+	oo::class create B {superclass A}
+	oo::define B constructor {} {A create test-oo-1.18}
+	B create C
+	A destroy
+    }
+} -cleanup {
+    rename test-oo-1.18 {}
+} -result 0
 test oo-1.19 {basic test of OO functionality: teardown order} -body {
     oo::object create o
     namespace delete [info object namespace o]