add a no-throw? flag to limited-streams, add unit tests
parent
e323ae3a32
commit
0563bedefa
basis/io/streams/limited
|
@ -1,7 +1,7 @@
|
|||
IN: io.streams.limited.tests
|
||||
USING: io io.streams.limited io.encodings io.encodings.string
|
||||
io.encodings.ascii io.encodings.binary io.streams.byte-array
|
||||
namespaces tools.test strings kernel ;
|
||||
namespaces tools.test strings kernel io.streams.string accessors ;
|
||||
IN: io.streams.limited.tests
|
||||
|
||||
[ ] [
|
||||
"hello world\nhow are you today\nthis is a very long line indeed"
|
||||
|
@ -41,3 +41,15 @@ namespaces tools.test strings kernel ;
|
|||
|
||||
[ CHAR: a ]
|
||||
[ "a" <string-reader> 1 <limited-stream> stream-read1 ] unit-test
|
||||
|
||||
[ "abc" ]
|
||||
[
|
||||
"abc" <string-reader> 3 <limited-stream> t >>no-throw?
|
||||
4 swap stream-read
|
||||
] unit-test
|
||||
|
||||
[ f ]
|
||||
[
|
||||
"abc" <string-reader> 3 <limited-stream> t >>no-throw?
|
||||
4 over stream-read drop 10 swap stream-read
|
||||
] unit-test
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math io io.encodings destructors accessors
|
||||
sequences namespaces byte-vectors ;
|
||||
sequences namespaces byte-vectors fry ;
|
||||
IN: io.streams.limited
|
||||
|
||||
TUPLE: limited-stream stream count limit ;
|
||||
TUPLE: limited-stream stream count limit no-throw? ;
|
||||
|
||||
: <limited-stream> ( stream limit -- stream' )
|
||||
limited-stream new
|
||||
|
@ -22,19 +22,30 @@ M: object limit <limited-stream> ;
|
|||
|
||||
ERROR: limit-exceeded ;
|
||||
|
||||
: check-limit ( n stream -- )
|
||||
[ + ] change-count
|
||||
: adjust-limit ( n stream -- n' stream )
|
||||
2dup [ + ] change-count
|
||||
[ count>> ] [ limit>> ] bi >
|
||||
[ limit-exceeded ] when ; inline
|
||||
[
|
||||
dup no-throw?>> [
|
||||
dup [ count>> ] [ limit>> ] bi -
|
||||
'[ _ - ] dip
|
||||
] [
|
||||
limit-exceeded
|
||||
] if
|
||||
] when ; inline
|
||||
|
||||
: maybe-read ( n limited-stream quot: ( n stream -- seq/f ) -- seq/f )
|
||||
pick 0 <= [ 3drop f ] [ [ stream>> ] dip call ] if ; inline
|
||||
|
||||
M: limited-stream stream-read1
|
||||
1 over check-limit stream>> stream-read1 ;
|
||||
1 swap adjust-limit
|
||||
[ nip stream-read1 ] maybe-read ;
|
||||
|
||||
M: limited-stream stream-read
|
||||
2dup check-limit stream>> stream-read ;
|
||||
adjust-limit [ stream-read ] maybe-read ;
|
||||
|
||||
M: limited-stream stream-read-partial
|
||||
2dup check-limit stream>> stream-read-partial ;
|
||||
adjust-limit [ stream-read-partial ] maybe-read ;
|
||||
|
||||
: (read-until) ( stream seps buf -- stream seps buf sep/f )
|
||||
3dup [ [ stream-read1 dup ] dip memq? ] dip
|
||||
|
|
Loading…
Reference in New Issue