Artifact
6df6a7c51076b6860ced2a4f36309bdc9cab830794b51b6f9773dabd52e67388:
Attachment "refchan-async-test.tcl" to
ticket [de232b49f2]
added by
apnadkarni
2024-03-31 15:59:35.
0000: 73 65 74 20 3a 3a 6e 75 6d 42 79 74 65 73 57 72 set ::numBytesWr
0010: 69 74 74 65 6e 20 30 0d 0a 0d 0a 6e 61 6d 65 73 itten 0....names
0020: 70 61 63 65 20 65 76 61 6c 20 72 65 66 63 68 61 pace eval refcha
0030: 6e 20 7b 0d 0a 20 20 20 20 6e 61 6d 65 73 70 61 n {.. namespa
0040: 63 65 20 65 6e 73 65 6d 62 6c 65 20 63 72 65 61 ce ensemble crea
0050: 74 65 0d 0a 20 20 20 20 6e 61 6d 65 73 70 61 63 te.. namespac
0060: 65 20 65 78 70 6f 72 74 20 2a 0d 0a 0d 0a 0d 0a e export *......
0070: 20 20 20 20 70 72 6f 63 20 66 69 6e 61 6c 69 7a proc finaliz
0080: 65 20 7b 63 68 61 6e 20 61 72 67 73 7d 20 7b 0d e {chan args} {.
0090: 0a 20 20 20 20 20 20 20 20 6e 61 6d 65 73 70 61 . namespa
00a0: 63 65 20 64 65 6c 65 74 65 20 63 5f 24 63 68 61 ce delete c_$cha
00b0: 6e 0d 0a 20 20 20 20 7d 0d 0a 0d 0a 20 20 20 20 n.. }....
00c0: 70 72 6f 63 20 69 6e 69 74 69 61 6c 69 7a 65 20 proc initialize
00d0: 7b 63 68 61 6e 20 61 72 67 73 7d 20 7b 0d 0a 20 {chan args} {..
00e0: 20 20 20 20 20 20 20 6e 61 6d 65 73 70 61 63 65 namespace
00f0: 20 65 76 61 6c 20 63 5f 24 63 68 61 6e 20 7b 7d eval c_$chan {}
0100: 0d 0a 20 20 20 20 20 20 20 20 6e 61 6d 65 73 70 .. namesp
0110: 61 63 65 20 75 70 76 61 72 20 63 5f 24 63 68 61 ace upvar c_$cha
0120: 6e 20 77 61 74 63 68 69 6e 67 20 77 61 74 63 68 n watching watch
0130: 69 6e 67 0d 0a 20 20 20 20 20 20 20 20 73 65 74 ing.. set
0140: 20 77 61 74 63 68 69 6e 67 20 7b 7d 0d 0a 20 20 watching {}..
0150: 20 20 20 20 20 20 6c 69 73 74 20 66 69 6e 61 6c list final
0160: 69 7a 65 20 69 6e 69 74 69 61 6c 69 7a 65 20 73 ize initialize s
0170: 65 65 6b 20 77 61 74 63 68 20 77 72 69 74 65 0d eek watch write.
0180: 0a 20 20 20 20 7d 0d 0a 0d 0a 20 20 20 20 70 72 . }.... pr
0190: 6f 63 20 77 61 74 63 68 20 7b 63 68 61 6e 20 61 oc watch {chan a
01a0: 72 67 73 7d 20 7b 0d 0a 20 20 20 20 20 20 20 20 rgs} {..
01b0: 6e 61 6d 65 73 70 61 63 65 20 75 70 76 61 72 20 namespace upvar
01c0: 63 5f 24 63 68 61 6e 20 77 61 74 63 68 69 6e 67 c_$chan watching
01d0: 20 77 61 74 63 68 69 6e 67 0d 0a 20 20 20 20 20 watching..
01e0: 20 20 20 66 6f 72 65 61 63 68 20 61 72 67 20 24 foreach arg $
01f0: 61 72 67 73 20 7b 0d 0a 20 20 20 20 20 20 20 20 args {..
0200: 20 20 20 20 73 77 69 74 63 68 20 24 61 72 67 20 switch $arg
0210: 7b 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {..
0220: 20 20 20 77 72 69 74 65 20 7b 0d 0a 20 20 20 20 write {..
0230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0240: 69 66 20 7b 24 61 72 67 20 6e 69 20 24 77 61 74 if {$arg ni $wat
0250: 63 68 69 6e 67 7d 20 7b 0d 0a 20 20 20 20 20 20 ching} {..
0260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0270: 20 20 6c 61 70 70 65 6e 64 20 77 61 74 63 68 69 lappend watchi
0280: 6e 67 20 24 61 72 67 0d 0a 20 20 20 20 20 20 20 ng $arg..
0290: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0d 0a }..
02a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
02b0: 20 20 20 20 61 66 74 65 72 20 69 64 6c 65 20 61 after idle a
02c0: 66 74 65 72 20 30 20 63 68 61 6e 20 70 6f 73 74 fter 0 chan post
02d0: 65 76 65 6e 74 20 24 63 68 61 6e 20 24 61 72 67 event $chan $arg
02e0: 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
02f0: 20 20 7d 0d 0a 20 20 20 20 20 20 20 20 20 20 20 }..
0300: 20 7d 0d 0a 20 20 20 20 20 20 20 20 7d 0d 0a 20 }.. }..
0310: 20 20 20 7d 0d 0a 0d 0a 20 20 20 20 70 72 6f 63 }.... proc
0320: 20 77 72 69 74 65 20 7b 63 68 61 6e 20 61 72 67 write {chan arg
0330: 73 7d 20 7b 0d 0a 20 20 20 20 20 20 20 20 69 6e s} {.. in
0340: 63 72 20 3a 3a 63 6f 75 6e 74 65 72 0d 0a 20 20 cr ::counter..
0350: 20 20 20 20 20 20 61 66 74 65 72 20 69 64 6c 65 after idle
0360: 20 61 66 74 65 72 20 30 20 63 68 61 6e 20 70 6f after 0 chan po
0370: 73 74 65 76 65 6e 74 20 24 63 68 61 6e 20 77 72 stevent $chan wr
0380: 69 74 65 0d 0a 20 20 20 20 20 20 20 20 72 65 74 ite.. ret
0390: 75 72 6e 20 31 0d 0a 20 20 20 20 7d 0d 0a 7d 0d urn 1.. }..}.
03a0: 0a 0d 0a 73 65 74 20 66 20 5b 63 68 61 6e 20 63 ...set f [chan c
03b0: 72 65 61 74 65 20 77 20 5b 6e 61 6d 65 73 70 61 reate w [namespa
03c0: 63 65 20 77 68 69 63 68 20 72 65 66 63 68 61 6e ce which refchan
03d0: 5d 5d 0d 0a 63 68 61 6e 20 63 6f 6e 66 69 67 75 ]]..chan configu
03e0: 72 65 20 24 66 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $f -blocking
03f0: 30 0d 0a 63 68 61 6e 20 65 76 65 6e 74 20 24 66 0..chan event $f
0400: 20 77 72 69 74 61 62 6c 65 20 5b 6e 61 6d 65 73 writable [names
0410: 70 61 63 65 20 63 6f 64 65 20 7b 0d 0a 20 20 20 pace code {..
0420: 20 70 75 74 73 20 24 66 20 58 0d 0a 7d 5d 0d 0a puts $f X..}]..
0430: 0d 0a 70 72 6f 63 20 65 76 65 72 79 31 20 7b 7d ..proc every1 {}
0440: 20 7b 0d 0a 20 20 20 20 61 66 74 65 72 20 69 64 {.. after id
0450: 6c 65 20 61 66 74 65 72 20 31 30 30 30 20 65 76 le after 1000 ev
0460: 65 72 79 31 0d 0a 20 20 20 20 70 75 74 73 20 5b ery1.. puts [
0470: 63 6c 6f 63 6b 20 73 65 63 6f 6e 64 73 5d 0d 0a clock seconds]..
0480: 7d 0d 0a 0d 0a 65 76 65 72 79 31 0d 0a 0d 0a 76 }....every1....v
0490: 77 61 69 74 20 66 6f 72 65 76 65 72 0d 0a 0d 0a wait forever....
04a0: 0d 0a ..
