steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/io/streams/limited/limited-tests.factor
View File

@ -1,7 +1,7 @@
IN: io.streams.limited.tests
USING: io io.streams.limited io.encodings io.encodings.string USING: io io.streams.limited io.encodings io.encodings.string
io.encodings.ascii io.encodings.binary io.streams.byte-array 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" "hello world\nhow are you today\nthis is a very long line indeed"
@ -41,3 +41,15 @@ namespaces tools.test strings kernel ;
[ CHAR: a ] [ CHAR: a ]
[ "a" <string-reader> 1 <limited-stream> stream-read1 ] unit-test [ "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

27
basis/io/streams/limited/limited.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2008 Slava Pestov ! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math io io.encodings destructors accessors USING: kernel math io io.encodings destructors accessors
sequences namespaces byte-vectors ; sequences namespaces byte-vectors fry ;
IN: io.streams.limited 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> ( stream limit -- stream' )
limited-stream new limited-stream new
@ -22,19 +22,30 @@ M: object limit <limited-stream> ;
ERROR: limit-exceeded ; ERROR: limit-exceeded ;
: check-limit ( n stream -- ) : adjust-limit ( n stream -- n' stream )
[ + ] change-count 2dup [ + ] change-count
[ count>> ] [ limit>> ] bi > [ 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 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 M: limited-stream stream-read
2dup check-limit stream>> stream-read ; adjust-limit [ stream-read ] maybe-read ;
M: limited-stream stream-read-partial 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 ) : (read-until) ( stream seps buf -- stream seps buf sep/f )
3dup [ [ stream-read1 dup ] dip memq? ] dip 3dup [ [ stream-read1 dup ] dip memq? ] dip