summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/io.test104
-rw-r--r--tests/socket.test22
2 files changed, 126 insertions, 0 deletions
diff --git a/tests/io.test b/tests/io.test
index d9a5167..33f91bd 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -4325,6 +4325,110 @@ test io-33.10 {Tcl_Gets, exercising double buffering} {
close $f
set y
} 300
+test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup {
+ proc driver {cmd args} {
+ variable buffer
+ variable index
+ set chan [lindex $args 0]
+ switch -- $cmd {
+ initialize {
+ set index($chan) 0
+ set buffer($chan) .......
+ return {initialize finalize watch read}
+ }
+ finalize {
+ unset index($chan) buffer($chan)
+ return
+ }
+ watch {}
+ read {
+ set n [lindex $args 1]
+ if {$n > 3} {set n 3}
+ set new [expr {$index($chan) + $n}]
+ set result [string range $buffer($chan) $index($chan) $new-1]
+ set index($chan) $new
+ return $result
+ }
+ }
+ }
+} -body {
+ set c [chan create read [namespace which driver]]
+ chan configure $c -translation binary -blocking 0
+ list [gets $c] [gets $c] [gets $c] [gets $c]
+} -cleanup {
+ close $c
+ rename driver {}
+} -result {{} {} {} .......}
+test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup {
+ proc driver {cmd args} {
+ variable buffer
+ variable index
+ set chan [lindex $args 0]
+ switch -- $cmd {
+ initialize {
+ set index($chan) 0
+ set buffer($chan) .......
+ return {initialize finalize watch read}
+ }
+ finalize {
+ unset index($chan) buffer($chan)
+ return
+ }
+ watch {}
+ read {
+ set n [lindex $args 1]
+ if {$n > 3} {set n 3}
+ set new [expr {$index($chan) + $n}]
+ set result [string range $buffer($chan) $index($chan) $new-1]
+ set index($chan) $new
+ return $result
+ }
+ }
+ }
+} -body {
+ set c [chan create read [namespace which driver]]
+ chan configure $c -blocking 0
+ list [gets $c] [gets $c] [gets $c] [gets $c]
+} -cleanup {
+ close $c
+ rename driver {}
+} -result {{} {} {} .......}
+test io-33.13 {Tcl_GetsObj, [10dc6daa37]} -setup {
+ proc driver {cmd args} {
+ variable buffer
+ variable index
+ set chan [lindex $args 0]
+ switch -- $cmd {
+ initialize {
+ set index($chan) 0
+ set buffer($chan) [string repeat \
+ [string repeat . 64]\n[string repeat . 25] 2]
+ return {initialize finalize watch read}
+ }
+ finalize {
+ unset index($chan) buffer($chan)
+ return
+ }
+ watch {}
+ read {
+ set n [lindex $args 1]
+ if {$n > 65} {set n 65}
+ set new [expr {$index($chan) + $n}]
+ set result [string range $buffer($chan) $index($chan) $new-1]
+ set index($chan) $new
+ return $result
+ }
+ }
+ }
+} -body {
+ set c [chan create read [namespace which driver]]
+ chan configure $c -blocking 0
+ list [gets $c] [gets $c] [gets $c] [gets $c] [gets $c]
+} -cleanup {
+ close $c
+ rename driver {}
+} -result [list [string repeat . 64] {} [string repeat . 89] \
+ [string repeat . 25] {}]
# Test Tcl_Seek and Tcl_Tell.
diff --git a/tests/socket.test b/tests/socket.test
index c50730c..d6cee30 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -2321,6 +2321,28 @@ test socket-14.15 {blocking read on async socket should not trigger event handle
set x
} -result ok
+# v4 and v6 is required to prevent that the async connect does not terminate
+# before the fconfigure command. There is always an additional ip to try.
+test socket-14.16 {empty -peername while [socket -async] connecting} \
+ -constraints {socket localhost_v4 localhost_v6} \
+ -body {
+ set client [socket -async localhost [randport]]
+ fconfigure $client -peername
+ } -cleanup {
+ catch {close $client}
+ } -result {}
+
+# v4 and v6 is required to prevent that the async connect does not terminate
+# before the fconfigure command. There is always an additional ip to try.
+test socket-14.17 {empty -sockname while [socket -async] connecting} \
+ -constraints {socket localhost_v4 localhost_v6} \
+ -body {
+ set client [socket -async localhost [randport]]
+ fconfigure $client -sockname
+ } -cleanup {
+ catch {close $client}
+ } -result {}
+
set num 0
set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}}