Artifact
07bfce7ee0e09bc90ab928e1c19380802c448c9d58d589903429cf0661d9bf5d:
Attachment "crash3.tcl" to
ticket [ea69b0258a]
added by
petrokaz
2023-03-07 10:31:17.
(unpublished)
0000: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
0010: 74 63 6c 3a 3a 74 72 61 6e 73 66 6f 72 6d 3a 3a tcl::transform::
0020: 6f 62 73 65 72 76 65 0a 0a 70 72 6f 63 20 77 72 observe..proc wr
0030: 69 74 61 62 6c 65 20 7b 73 6f 63 6b 7d 20 7b 0a itable {sock} {.
0040: 20 20 20 20 63 68 61 6e 20 65 76 65 6e 74 20 24 chan event $
0050: 73 6f 63 6b 20 77 72 69 74 61 62 6c 65 20 7b 7d sock writable {}
0060: 0a 20 20 20 20 63 68 61 6e 20 63 6f 6e 66 69 67 . chan config
0070: 75 72 65 20 24 73 6f 63 6b 20 2d 74 72 61 6e 73 ure $sock -trans
0080: 6c 61 74 69 6f 6e 20 7b 63 72 6c 66 20 6c 66 7d lation {crlf lf}
0090: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
00a0: 66 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d 65 6e ffering full -en
00b0: 63 6f 64 69 6e 67 20 62 69 6e 61 72 79 0a 20 20 coding binary.
00c0: 20 20 63 68 61 6e 20 65 76 65 6e 74 20 24 73 6f chan event $so
00d0: 63 6b 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 ck readable [lis
00e0: 74 20 72 65 61 64 61 62 6c 65 20 24 73 6f 63 6b t readable $sock
00f0: 5d 0a 20 20 20 20 73 65 74 20 3a 3a 73 74 61 74 ]. set ::stat
0100: 75 73 20 22 63 6f 6e 6e 65 63 74 65 64 22 0a 7d us "connected".}
0110: 0a 0a 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 ..proc readable
0120: 7b 73 6f 63 6b 7d 20 7b 0a 20 20 20 20 73 65 74 {sock} {. set
0130: 20 72 65 61 64 43 6f 75 6e 74 20 5b 63 68 61 6e readCount [chan
0140: 20 67 65 74 73 20 24 73 6f 63 6b 20 6c 69 6e 65 gets $sock line
0150: 5d 0a 20 20 20 20 69 66 20 7b 24 72 65 61 64 43 ]. if {$readC
0160: 6f 75 6e 74 20 3c 20 30 7d 20 7b 0a 20 20 20 20 ount < 0} {.
0170: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 6f if {[eof $so
0180: 63 6b 5d 7d 20 7b 20 0a 20 20 20 20 20 20 20 20 ck]} { .
0190: 20 20 20 20 70 75 74 73 20 22 43 6f 6e 6e 65 63 puts "Connec
01a0: 74 69 6f 6e 20 61 62 6f 72 74 65 64 22 0a 20 20 tion aborted".
01b0: 20 20 20 20 20 20 20 20 20 20 63 68 61 6e 20 65 chan e
01c0: 76 65 6e 74 20 24 73 6f 63 6b 20 72 65 61 64 61 vent $sock reada
01d0: 62 6c 65 20 7b 7d 0a 20 20 20 20 20 20 20 20 20 ble {}.
01e0: 20 20 20 73 65 74 20 3a 3a 6d 73 67 20 22 63 6c set ::msg "cl
01f0: 6f 73 65 64 22 0a 20 20 20 20 20 20 20 20 7d 0a osed". }.
0200: 20 20 20 20 20 20 20 20 72 65 74 75 72 6e 0a 20 return.
0210: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 3a 3a 6d }. set ::m
0220: 73 67 20 24 6c 69 6e 65 0a 7d 0a 0a 73 65 74 20 sg $line.}..set
0230: 73 6f 63 6b 20 5b 73 6f 63 6b 65 74 20 2d 61 73 sock [socket -as
0240: 79 6e 63 20 6c 6f 63 61 6c 68 6f 73 74 20 34 34 ync localhost 44
0250: 30 30 5d 0a 63 68 61 6e 20 65 76 65 6e 74 20 24 00].chan event $
0260: 73 6f 63 6b 20 77 72 69 74 61 62 6c 65 20 5b 6c sock writable [l
0270: 69 73 74 20 77 72 69 74 61 62 6c 65 20 24 73 6f ist writable $so
0280: 63 6b 5d 0a 76 77 61 69 74 20 3a 3a 73 74 61 74 ck].vwait ::stat
0290: 75 73 0a 70 75 74 73 20 22 53 74 61 74 75 73 3d us.puts "Status=
02a0: 24 73 74 61 74 75 73 22 0a 74 63 6c 3a 3a 74 72 $status".tcl::tr
02b0: 61 6e 73 66 6f 72 6d 3a 3a 6f 62 73 65 72 76 65 ansform::observe
02c0: 20 24 73 6f 63 6b 20 73 74 64 6f 75 74 20 22 22 $sock stdout ""
02d0: 0a 0a 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e ..puts -nonewlin
02e0: 65 20 24 73 6f 63 6b 20 22 48 65 6c 6c 6f 31 5c e $sock "Hello1\
02f0: 72 5c 6e 48 65 6c 6c 6f 32 5c 72 5c 6e 22 0a 66 r\nHello2\r\n".f
0300: 6c 75 73 68 20 24 73 6f 63 6b 0a 0a 76 77 61 69 lush $sock..vwai
0310: 74 20 3a 3a 6d 73 67 0a 70 75 74 73 20 22 47 6f t ::msg.puts "Go
0320: 74 20 24 6d 73 67 22 0a 0a 70 75 74 73 20 22 70 t $msg"..puts "p
0330: 65 6e 64 69 6e 67 20 69 6e 70 75 74 20 62 65 66 ending input bef
0340: 6f 72 65 20 70 6f 70 3a 20 5b 63 68 61 6e 20 70 ore pop: [chan p
0350: 65 6e 64 69 6e 67 20 69 6e 70 75 74 20 24 73 6f ending input $so
0360: 63 6b 5d 22 0a 63 68 61 6e 20 70 6f 70 20 24 73 ck]".chan pop $s
0370: 6f 63 6b 0a 70 75 74 73 20 22 70 65 6e 64 69 6e ock.puts "pendin
0380: 67 20 69 6e 70 75 74 20 61 66 74 65 72 20 70 6f g input after po
0390: 70 3a 20 5b 63 68 61 6e 20 70 65 6e 64 69 6e 67 p: [chan pending
03a0: 20 69 6e 70 75 74 20 24 73 6f 63 6b 5d 22 0a 61 input $sock]".a
03b0: 66 74 65 72 20 31 30 30 20 7b 73 65 74 20 3a 3a fter 100 {set ::
03c0: 66 6f 72 65 76 65 72 20 31 7d 0a 76 77 61 69 74 forever 1}.vwait
03d0: 20 66 6f 72 65 76 65 72 20 3b 23 20 63 72 61 73 forever ;# cras
03e0: 68 65 73 20 68 65 72 65 0a 0a 63 6c 6f 73 65 20 hes here..close
03f0: 24 73 6f 63 6b 0a 70 75 74 73 20 44 4f 4e 45 0a $sock.puts DONE.
