add a no-throw? flag to limited-streams, add unit tests

db4
U-C4\Administrator 2009-01-19 18:52:09 -06:00
parent e323ae3a32
commit 0563bedefa
2 changed files with 33 additions and 10 deletions
basis/io/streams/limited

View File

@ -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

View File

@ -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