Merge completion of dgp-read-bytes branch.

5 files changed, 232 insertions, 10 deletions

diff --git a/tests/clock.test b/tests/clock.test
index fea1fc9..7d62a60 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36927,6 +36927,15 @@ test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
     clock format [clock seconds] -format %%r
 } %r
 
+test clock-67.2 {Bug d19a30db57} -body {
+    # error, not segfault
+    tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+} -returnCodes error -match glob -result *
+test clock-67.3 {Bug d19a30db57} -body {
+    # error, not segfault
+    tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
+} -returnCodes error -match glob -result *
+
 # cleanup
 
 namespace delete ::testClock
diff --git a/tests/io.test b/tests/io.test
index 53b7105..ff5554e 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -4760,7 +4760,7 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
     close $f
     list $c $l $e
 } {21 8 1}
-test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} {
+test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr
@@ -4773,8 +4773,8 @@ test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {8 8 1 13}
-test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} {
+} -result {8 8 1 13}
+test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr -eofchar \x1a
@@ -4787,8 +4787,8 @@ test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {9 8 1 13}
-test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} {
+} -result {9 8 1 13}
+test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -constraints knownBug -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr -eofchar \x1a
@@ -4801,8 +4801,8 @@ test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {2 1 1 13}
-test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} {
+} -result {2 1 1 13}
+test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr
@@ -4815,8 +4815,8 @@ test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {1 1 1 13}
-test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} {
+} -result {1 1 1 13}
+test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr -eofchar {}
@@ -4830,7 +4830,7 @@ test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $c $l $e [scan [string index $in end] %c]
-} {17 8 1 13}
+} -result {17 8 1 13}
 test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} {
     file delete $path(test1)
     set f [open $path(test1) w]
@@ -6917,6 +6917,34 @@ test io-52.14 {coverage of -translation crlf} {
     close $out
     file size $path(test2)
 } 29
+test io-52.14.1 {coverage of -translation crlf} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 8 -translation crlf
+    set out [open $path(test2) w]
+    fcopy $in $out -size 2
+    close $in
+    close $out
+    file size $path(test2)
+} 2
+test io-52.14.2 {coverage of -translation crlf} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -translation crlf
+    set out [open $path(test2) w]
+    fcopy $in $out -size 9
+    close $in
+    close $out
+    file size $path(test2)
+} 9
 test io-52.15 {coverage of -translation crlf} {
     file delete $path(test1) $path(test2)
     set out [open $path(test1) wb]
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 768a748..bb133f9 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -755,6 +755,90 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
     rename foo {}
     set res
 } -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
+test iocmd-21.20 {Bug 88aef05cda} -setup {
+    proc foo {method chan args} {
+	switch -- $method blocking {
+	    chan configure $chan -blocking [lindex $args 0]
+	    return
+	} initialize {
+	    return {initialize finalize watch blocking read write
+		    configure cget cgetall}
+	} finalize {
+	    return
+	}
+    }
+    set ch [chan create {read write} foo]
+} -body {
+    list [catch {chan configure $ch -blocking 0} m] $m
+} -cleanup {
+    close $ch
+    rename foo {}
+} -match glob -result {1 {*nested eval*}}
+test iocmd-21.21 {[close] in [read] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    close $chan
+	    return a
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    read $ch 0
+} -cleanup {
+    close $ch
+    rename foo {}
+} -result {}
+test iocmd-21.22 {[close] in [read] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return a
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    read $ch 1
+} -returnCodes error -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -match glob -result {*invalid argument*}
+test iocmd-21.23 {[close] in [gets] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return \n
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    gets $ch
+} -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -result {}
+test iocmd-21.24 {[close] in binary [gets] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return \n
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    chan configure $ch -translation binary
+    gets $ch
+} -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -result {}
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
@@ -1013,6 +1097,20 @@ test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glo
     rename foo {}
     unset res
 } -result {{read rc* 4096} {} 0}
+test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	set args [lassign $args sub id]
+	if {$sub ne "read"} {return}
+	close $id
+	return {}
+    }
+    set c [chan create {r} foo]
+    note [read $c]
+    rename foo {}
+    set res
+} -result {{read rc* 4096} {}}
 
 # --- === *** ###########################
 # method write
diff --git a/tests/iogt.test b/tests/iogt.test
index 3882ecc..d4291b3 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -242,6 +242,36 @@ proc id_fulltrail {var op data} {
     return $res
 }
 
+proc id_torture {chan op data} {
+    switch -- $op {
+	create/write -
+	create/read  -
+	delete/write -
+	delete/read  -
+	clear_read   {;#ignore}
+	flush/write -
+	flush/read  {}
+	write       {
+	    global level
+	    if {$level} {
+		return
+	    }
+	    incr level
+	    testchannel unstack $chan
+	    testchannel transform $chan \
+		-command [namespace code [list id_torture $chan]]
+	    return $data
+	}
+	read        {
+	    testchannel unstack $chan
+	    testchannel transform $chan \
+		-command [namespace code [list id_torture $chan]]
+	    return $data
+	}
+	query/maxRead {return -1}
+    }
+}
+
 proc counter {var op data} {
     variable $var
     upvar 0 $var n
@@ -364,6 +394,10 @@ proc audit_flow {var -attach channel} {
     testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
 }
 
+proc torture {-attach channel} {
+    testchannel transform $channel -command [namespace code [list id_torture $channel]]
+}
+
 proc stopafter {var n -attach channel} {
     variable $var
     upvar 0 $var vn
@@ -632,6 +666,24 @@ delete/read {} *ignored*
 flush/write {} {}
 delete/write {} *ignored*}
 
+test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
+    set fh [open $path(dummy) r]
+    torture -attach $fh
+    chan configure $fh -buffersize 2
+    set x [read $fh]
+    testchannel unstack $fh
+    close   $fh
+    set x
+} {}
+test iogt-2.5 {basic I/O, mixed trail} {testchannel} {
+    set ::level 0
+    set fh [open $path(dummyout) w]
+    torture -attach $fh
+    puts -nonewline $fh abcdef
+    flush $fh
+    testchannel unstack $fh
+    close   $fh
+} {}
 
 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
 	{testchannel unknownFailure} {
diff --git a/tests/socket.test b/tests/socket.test
index 0ae5abd..1b7c5fa 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -67,6 +67,10 @@ namespace import -force ::tcltest::*
 testConstraint testthread [llength [info commands testthread]]
 testConstraint exec [llength [info commands exec]]
 
+# Produce a random port number in the Dynamic/Private range
+# from 49152 through 65535.
+proc randport {} { expr {int(rand()*16383+49152)} }
+
 # If remoteServerIP or remoteServerPort are not set, check in the
 # environment variables for externally set values.
 #
@@ -1683,6 +1687,37 @@ if {[string match sock* $commandSocket] == 1} {
 }
 catch {close $commandSocket}
 catch {close $remoteProcChan}
+test socket-14.13 {testing writable event when quick failure} -constraints {socket win supported_inet} -body {
+    # Test for bug 336441ed59 where a quick background fail was ignored
+    
+    # Test only for windows as socket -async 255.255.255.255 fails
+    # directly on unix
+    
+    # The following connect should fail very quickly
+    set a1 [after 2000 {set x timeout}]
+    set s [socket -async 255.255.255.255 43434]
+    fileevent $s writable {set x writable}
+    vwait x
+    set x
+} -cleanup {
+    catch {close $s}
+    after cancel $a1
+} -result writable
+
+test socket-14.14 {testing fileevent readable on failed async socket connect} -constraints [list socket] -body {
+    # Test for bug 581937ab1e
+    
+    set a1 [after 5000 {set x timeout}]
+    # This connect should fail
+    set s [socket -async localhost [randport]]
+    fileevent $s readable {set x readable}
+    vwait x
+    set x
+} -cleanup {
+    catch {close $s}
+    after cancel $a1
+} -result readable
+
 ::tcltest::cleanupTests
 flush stdout
 return