Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | refchan pipe ? |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
b93d0b1571a42e1515e16e168450b1f2 |
User & Date: | aspect 2019-04-26 14:22:28.639 |
Context
2019-10-31
| ||
02:54 | (no comment) check-in: 075928d0e2 user: aspect tags: trunk | |
2019-04-26
| ||
14:22 | refchan pipe ? check-in: b93d0b1571 user: aspect tags: trunk | |
14:22 | Fix tclish symlink resolution check-in: 3eaba8d90c user: aspect tags: trunk | |
Changes
Added tmp/refpipe.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 | # making a [chan pipe] out of refpipes # passes the rudimentary synchronous test cases, does it pass async? namespace eval refpipe { oo::class create Buffer { variable Size variable Data variable Block variable Watch constructor {size} { set Size $size set Block 1 set Watch {} set Data {} } method initialize {chan mode} { return {initialize finalize blocking watch write read configure} } method finalize {chan} { puts "[self class] [self] finalize!" my destroy } method blocking {chan mode} { puts "[self class] [self] blocking $mode" set Block $mode } method watch {chan events} { set Watch $events } method configure {chan key val} { if {$key ne "-size"} { return -code error "Bad option \"$key\", should be \"-size\"" } if {![string is integer $val]} { return -code error "Expected integer but got \"$val\"" } set Size $val } method Postevent {chan event} { if {$event in $Watch} { # (see http://core.tcl.tk/tcl/tktview?name=67a5eabbd3) after idle [list chan postevent $chan $event] } } method write {chan data} { if {[string length $Data] + [string length $data] > $Size} { if {$Block} { throw {POSIX EPIPE} "Buffer is full!" } else { throw EAGAIN EAGAIN } } append Data $data my Postevent $chan "read" if {[string length $Data] < $Size} { my Postevent $chan "write" } return [string length $data] } method read {chan bytes} { if {$Data eq ""} { if {$Block} { return "" } else { throw EAGAIN EAGAIN } } set r [string range $Data 0 $bytes] set Data [string replace $Data 0 $bytes] return $r } } oo::class create Writer { variable Buffer variable Watch variable Block constructor {buffer} { set Buffer $buffer set Block 1 set Watch {} } method initialize {chan mode} { return {initialize finalize blocking watch write} } method finalize {chan} { puts "[self class] [self] finalize!" my destroy } method blocking {chan mode} { set Block $mode } method watch {chan events} { set Watch $events } method Postevent {chan event} { if {$event in $Watch} { # (see http://core.tcl.tk/tcl/tktview?name=67a5eabbd3) after idle [list chan postevent $chan $event] } } method write {chan data} { puts -nonewline $Buffer $data return [string length $data] } } oo::class create Reader { variable Buffer variable Watch variable Block constructor {buffer} { set Buffer $buffer set Block 1 set Watch {} } method initialize {chan mode} { return {initialize finalize blocking watch read} } method finalize {chan} { puts "[self class] [self] finalize!" chan configure $Buffer -size 0 my destroy } method blocking {chan mode} { set Block $mode } method watch {chan events} { set Watch $events } method Postevent {chan event} { if {$event in $Watch} { # (see http://core.tcl.tk/tcl/tktview?name=67a5eabbd3) after idle [list chan postevent $chan $event] } } method read {chan size} { read $Buffer $size } } proc buffer {{size Inf}} { set fd [chan create {read write} [Buffer new $size]] chan configure $fd -buffering none return $fd } proc pipe {{size Inf}} { set buf [buffer $size] set rd [chan create read [Reader new $buf]] set wr [chan create write [Writer new $buf]] chan configure $wr -buffering none list $rd $wr } } proc ok {result args} { set r [uplevel 1 $args] if {$r eq $result} { puts "OK: got expected \"$result\"" } else { puts "ERR: expected \"$result\" but got \"$r\"" } } proc err {code args} { set rc [catch {uplevel 1 $args} res opts] set errcode {} catch {set errcode [dict get $opts -errorcode]} if {$errcode eq $code} { puts "OK: got expected {$code} \"$res\"" } else { puts "ERR: expected error {$code} but got $rc \"$res\" $opts" } } proc main {} { set buf [refpipe::buffer 10] chan configure $buf -buffering none ok "" puts $buf "Hello" err {POSIX EPIPE} puts $buf "World" ok "Hello" gets $buf ok "" gets $buf ok 1 eof $buf ok "" puts $buf "Hi" ok "" puts $buf "Mate" ok "Hi" gets $buf ok "Mate" gets $buf ok "" close $buf puts "buf ok" lassign [refpipe::pipe] rd wr ok "" puts $wr "Hello" ok "" puts $wr "World" ok "" close $wr ok "Hello" gets $rd ok "World" gets $rd ok "" gets $rd ok 1 eof $rd puts done! lassign [refpipe::pipe] rd wr close $rd err {POSIX EPIPE} puts $wr "Hello" } main |