diff --git a/basis/io/streams/limited/limited-tests.factor b/basis/io/streams/limited/limited-tests.factor index 40f2c81c9a..11b93e62a5 100644 --- a/basis/io/streams/limited/limited-tests.factor +++ b/basis/io/streams/limited/limited-tests.factor @@ -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" 1 stream-read1 ] unit-test + +[ "abc" ] +[ + "abc" 3 t >>no-throw? + 4 swap stream-read +] unit-test + +[ f ] +[ + "abc" 3 t >>no-throw? + 4 over stream-read drop 10 swap stream-read +] unit-test diff --git a/basis/io/streams/limited/limited.factor b/basis/io/streams/limited/limited.factor index 51d6b54a4e..505fe79219 100755 --- a/basis/io/streams/limited/limited.factor +++ b/basis/io/streams/limited/limited.factor @@ -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? ; : ( stream limit -- stream' ) limited-stream new @@ -22,19 +22,30 @@ M: object limit ; 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