Split off io.streams.throwing from io.streams.limited and update usages of limited streams
Doug Coleman
parent
e752b4ff62
commit
2ca509a8fe
|
|
@ -14,6 +14,7 @@ io.encodings.ascii
|
|||
io.encodings.binary
|
||||
io.streams.limited
|
||||
io.streams.string
|
||||
io.streams.throwing
|
||||
io.servers.connection
|
||||
io.timeouts
|
||||
io.crlf
|
||||
|
|
@ -50,13 +51,14 @@ ERROR: no-boundary ;
|
|||
SYMBOL: upload-limit
|
||||
|
||||
: read-multipart-data ( request -- mime-parts )
|
||||
[ "content-type" header ]
|
||||
[ "content-length" header string>number ] bi
|
||||
unlimited-input
|
||||
upload-limit get stream-throws limit-input
|
||||
stream-eofs limit-input
|
||||
binary decode-input
|
||||
parse-multipart-form-data parse-multipart ;
|
||||
upload-limit get limited-input
|
||||
[ "content-type" header ]
|
||||
[ "content-length" header string>number limited-input ] bi
|
||||
[
|
||||
binary decode-input
|
||||
parse-multipart-form-data parse-multipart
|
||||
] input-throws-on-eof ;
|
||||
|
||||
: read-content ( request -- bytes )
|
||||
"content-length" header string>number read ;
|
||||
|
|
@ -277,15 +279,17 @@ TUPLE: http-server < threaded-server ;
|
|||
|
||||
SYMBOL: request-limit
|
||||
|
||||
64 1024 * request-limit set-global
|
||||
request-limit [ 64 1024 * ] initialize
|
||||
|
||||
M: http-server handle-client*
|
||||
drop [
|
||||
request-limit get stream-throws limit-input
|
||||
?refresh-all
|
||||
[ read-request ] ?benchmark
|
||||
[ do-request ] ?benchmark
|
||||
[ do-response ] ?benchmark
|
||||
request-limit get limited-input
|
||||
[
|
||||
?refresh-all
|
||||
[ read-request ] ?benchmark
|
||||
[ do-request ] ?benchmark
|
||||
[ do-response ] ?benchmark
|
||||
] input-throws-on-eof
|
||||
] with-destructors ;
|
||||
|
||||
: <http-server> ( -- server )
|
||||
|
|
|
|||
|
|
@ -1,11 +1,9 @@
|
|||
! Copyright (C) 2007, 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien alien.c-types arrays byte-arrays columns
|
||||
combinators compression.run-length endian fry grouping images
|
||||
images.loader images.normalization io io.binary
|
||||
io.encodings.8-bit.latin1 io.encodings.binary
|
||||
io.encodings.string io.files io.streams.limited kernel locals
|
||||
macros math math.bitwise math.functions namespaces sequences
|
||||
USING: accessors alien.c-types arrays byte-arrays combinators
|
||||
compression.run-length fry grouping images images.loader
|
||||
images.normalization io io.binary io.encodings.8-bit.latin1
|
||||
io.encodings.string kernel math math.bitwise sequences
|
||||
specialized-arrays summary ;
|
||||
QUALIFIED-WITH: bitstreams b
|
||||
SPECIALIZED-ARRAYS: uint ushort ;
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types arrays byte-arrays combinators
|
||||
compression.run-length fry grouping images images.loader io
|
||||
io.binary io.encodings.binary
|
||||
io.encodings.string io.streams.limited kernel math math.bitwise
|
||||
io.encodings.8-bit.latin1 sequences specialized-arrays summary images.bitmap ;
|
||||
|
|
@ -1,15 +1,15 @@
|
|||
! Copyright (C) 2009 Marc Fauconneau.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays byte-arrays combinators
|
||||
grouping compression.huffman images fry
|
||||
images.processing io io.binary io.encodings.binary io.files
|
||||
io.streams.byte-array kernel locals math math.bitwise
|
||||
math.constants math.functions math.matrices math.order
|
||||
math.ranges math.vectors memoize multiline namespaces
|
||||
sequences sequences.deep images.loader io.streams.limited ;
|
||||
IN: images.jpeg
|
||||
|
||||
compression.huffman fry grouping images images.loader
|
||||
images.processing io io.binary io.encodings.binary
|
||||
io.streams.byte-array io.streams.limited io.streams.throwing
|
||||
kernel locals math math.bitwise math.blas.matrices
|
||||
math.blas.vectors math.constants math.functions math.matrices
|
||||
math.order math.vectors memoize namespaces sequences
|
||||
sequences.deep ;
|
||||
QUALIFIED-WITH: bitstreams bs
|
||||
IN: images.jpeg
|
||||
|
||||
SINGLETON: jpeg-image
|
||||
|
||||
|
|
@ -121,7 +121,7 @@ TUPLE: jpeg-color-info
|
|||
|
||||
: decode-huff-table ( chunk -- )
|
||||
data>> [ binary <byte-reader> ] [ length ] bi
|
||||
stream-throws limit
|
||||
limit-stream <throws-on-eof>
|
||||
[
|
||||
[ input-stream get [ count>> ] [ limit>> ] bi < ]
|
||||
[
|
||||
|
|
@ -219,9 +219,6 @@ MEMO: dct-matrix ( -- m ) 64 iota [ 8 /mod dct-vect flatten ] map ;
|
|||
|
||||
: idct-factor ( b -- b' ) dct-matrix v.m ;
|
||||
|
||||
USE: math.blas.vectors
|
||||
USE: math.blas.matrices
|
||||
|
||||
MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
|
||||
: V.M ( x A -- x.A ) Mtranspose swap M.V ;
|
||||
: idct-blas ( b -- b' ) >float-blas-vector dct-matrix-blas V.M ;
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs byte-arrays combinators images
|
||||
io.encodings.binary io.files io.pathnames io.streams.byte-array
|
||||
io.streams.limited kernel namespaces sequences splitting
|
||||
strings unicode.case ;
|
||||
USING: assocs byte-arrays io.encodings.binary io.files
|
||||
io.pathnames io.streams.byte-array io.streams.limited
|
||||
io.streams.throwing kernel namespaces sequences strings
|
||||
unicode.case fry ;
|
||||
IN: images.loader
|
||||
|
||||
ERROR: unknown-image-extension extension ;
|
||||
|
|
@ -18,7 +18,7 @@ types [ H{ } clone ] initialize
|
|||
[ unknown-image-extension ] unless ;
|
||||
|
||||
: open-image-file ( path -- stream )
|
||||
binary stream-throws <limited-file-reader> ;
|
||||
binary <limited-file-reader> ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
@ -36,9 +36,9 @@ GENERIC: stream>image ( stream class -- image )
|
|||
|
||||
M: byte-array load-image*
|
||||
[
|
||||
[ binary <byte-reader> ]
|
||||
[ length stream-throws <limited-stream> ] bi
|
||||
] dip stream>image ;
|
||||
[ binary <byte-reader> ] [ length ] bi
|
||||
<limited-stream> dup
|
||||
] dip '[ _ stream>image ] throws-on-eof ;
|
||||
|
||||
M: limited-stream load-image* stream>image ;
|
||||
|
||||
|
|
|
|||
|
|
@ -5,53 +5,29 @@ IN: io.streams.limited
|
|||
|
||||
HELP: <limited-stream>
|
||||
{ $values
|
||||
{ "stream" "an input stream" } { "limit" integer } { "mode" { $link stream-throws } " or " { $link stream-eofs } }
|
||||
{ "stream" "an input stream" } { "limit" integer }
|
||||
{ "stream'" "an input stream" }
|
||||
}
|
||||
{ $description "Constructs a new " { $link limited-stream } " from an existing stream. User code should use " { $link limit } " or " { $link limit-input } "." } ;
|
||||
{ $description "Constructs a new " { $link limited-stream } " from an existing stream. User code should use " { $link limit-stream } " or " { $link limited-input } "." } ;
|
||||
|
||||
HELP: limit
|
||||
HELP: limit-stream
|
||||
{ $values
|
||||
{ "stream" "an input stream" } { "limit" integer } { "mode" { $link stream-throws } " or " { $link stream-eofs } }
|
||||
{ "stream" "an input stream" } { "limit" integer }
|
||||
{ "stream'" "a stream" }
|
||||
}
|
||||
{ $description "Changes a decoder's stream to be a limited stream, or wraps " { $snippet "stream" } " in a " { $link limited-stream } "." }
|
||||
{ $examples "Throwing an exception:"
|
||||
{ $example
|
||||
"USING: continuations io io.streams.limited io.streams.string"
|
||||
"kernel prettyprint ;"
|
||||
"["
|
||||
" \"123456\" <string-reader> 3 stream-throws limit"
|
||||
" 100 swap stream-read ."
|
||||
"] [ ] recover ."
|
||||
"""T{ limit-exceeded
|
||||
{ n 1 }
|
||||
{ stream
|
||||
T{ limited-stream
|
||||
{ stream
|
||||
T{ string-reader
|
||||
{ underlying "123456" }
|
||||
{ i 3 }
|
||||
}
|
||||
}
|
||||
{ mode stream-throws }
|
||||
{ count 4 }
|
||||
{ limit 3 }
|
||||
}
|
||||
}
|
||||
}"""
|
||||
}
|
||||
"Returning " { $link f } " on exhaustion:"
|
||||
{ $examples
|
||||
"Limiting a longer stream to length three:"
|
||||
{ $example
|
||||
"USING: accessors continuations io io.streams.limited"
|
||||
"io.streams.string kernel prettyprint ;"
|
||||
"\"123456\" <string-reader> 3 stream-eofs limit"
|
||||
"\"123456\" <string-reader> 3 limit-stream"
|
||||
"100 swap stream-read ."
|
||||
"\"123\""
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: unlimited
|
||||
HELP: unlimit-stream
|
||||
{ $values
|
||||
{ "stream" "an input stream" }
|
||||
{ "stream'" "a stream" }
|
||||
|
|
@ -64,42 +40,22 @@ HELP: limited-stream
|
|||
}
|
||||
{ $description "Limited streams wrap other streams, changing their behavior to throw an exception or return " { $link f } " upon exhaustion." } ;
|
||||
|
||||
HELP: limit-input
|
||||
{ $values
|
||||
{ "limit" integer } { "mode" { $link stream-throws } " or " { $link stream-eofs } }
|
||||
}
|
||||
HELP: limited-input
|
||||
{ $values { "limit" integer } }
|
||||
{ $description "Wraps the current " { $link input-stream } " in a " { $link limited-stream } "." } ;
|
||||
|
||||
HELP: unlimited-input
|
||||
{ $description "Returns the underlying stream of the limited-stream stored in " { $link input-stream } "." } ;
|
||||
|
||||
HELP: stream-eofs
|
||||
{ $values
|
||||
{ "value" { $link stream-throws } " or " { $link stream-eofs } }
|
||||
}
|
||||
{ $description "If the " { $slot "mode" } " of a limited stream is set to this singleton, the stream will return " { $link f } " upon exhaustion." } ;
|
||||
|
||||
HELP: stream-throws
|
||||
{ $values
|
||||
{ "value" { $link stream-throws } " or " { $link stream-eofs } }
|
||||
}
|
||||
{ $description "If the " { $slot "mode" } " of a limited stream is set to this singleton, the stream will throw " { $link limit-exceeded } " upon exhaustion." } ;
|
||||
|
||||
{ stream-eofs stream-throws } related-words
|
||||
|
||||
ARTICLE: "io.streams.limited" "Limited input streams"
|
||||
"The " { $vocab-link "io.streams.limited" } " vocabulary wraps a stream to behave as if it had only a limited number of bytes, either throwing an error or returning " { $link f } " upon reaching the end. Limiting a non-seekable stream keeps a byte count and triggers the end-of-stream behavior when this byte count has been reached. However, limiting a seekable stream creates a window of bytes that supports seeking and re-reading of bytes in that window." $nl
|
||||
"Wrap a stream in a limited stream:"
|
||||
{ $subsections limit }
|
||||
{ $subsections limited-stream }
|
||||
"Wrap the current " { $link input-stream } " in a limited stream:"
|
||||
{ $subsections limit-input }
|
||||
{ $subsections limited-input }
|
||||
"Unlimits a limited stream:"
|
||||
{ $subsections unlimited }
|
||||
{ $subsections unlimit-stream }
|
||||
"Unlimits the current " { $link input-stream } ":"
|
||||
{ $subsections unlimited-input }
|
||||
"Make a limited stream throw an exception on exhaustion:"
|
||||
{ $subsections stream-throws }
|
||||
"Make a limited stream return " { $link f } " on exhaustion:"
|
||||
{ $subsections stream-eofs } ;
|
||||
{ $subsections unlimited-input } ;
|
||||
|
||||
ABOUT: "io.streams.limited"
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ IN: io.streams.limited.tests
|
|||
ascii encode binary <byte-reader> "data" set
|
||||
] unit-test
|
||||
|
||||
[ ] [ "data" get 24 stream-throws <limited-stream> "limited" set ] unit-test
|
||||
[ ] [ "data" get 24 <limited-stream> "limited" set ] unit-test
|
||||
|
||||
[ CHAR: h ] [ "limited" get stream-read1 ] unit-test
|
||||
|
||||
|
|
@ -21,51 +21,48 @@ IN: io.streams.limited.tests
|
|||
|
||||
[ "how " ] [ 4 "decoded" get stream-read ] unit-test
|
||||
|
||||
[ "decoded" get stream-readln ] [ limit-exceeded? ] must-fail-with
|
||||
[ "are you " ] [ "decoded" get stream-readln ] unit-test
|
||||
|
||||
[ f ] [ "decoded" get stream-readln ] unit-test
|
||||
|
||||
|
||||
[ ] [
|
||||
"abc\ndef\nghi"
|
||||
ascii encode binary <byte-reader> "data" set
|
||||
] unit-test
|
||||
|
||||
[ ] [ "data" get 7 stream-throws <limited-stream> "limited" set ] unit-test
|
||||
[ ] [ "data" get 4 <limited-stream> "limited" set ] unit-test
|
||||
|
||||
[ "abc" CHAR: \n ] [ "\n" "limited" get stream-read-until [ >string ] dip ] unit-test
|
||||
[ "abc" CHAR: \n ]
|
||||
[ "\n" "limited" get stream-read-until [ >string ] dip ] unit-test
|
||||
|
||||
[ "\n" "limited" get stream-read-until ] [ limit-exceeded? ] must-fail-with
|
||||
[ "" f ] [ "\n" "limited" get stream-read-until [ >string ] dip ] unit-test
|
||||
|
||||
[ "he" CHAR: l ] [
|
||||
B{ CHAR: h CHAR: e CHAR: l CHAR: l CHAR: o }
|
||||
ascii <byte-reader> [
|
||||
5 stream-throws limit-input
|
||||
"l" read-until
|
||||
] with-input-stream
|
||||
] unit-test
|
||||
|
||||
[ CHAR: a ]
|
||||
[ "a" <string-reader> 1 stream-eofs <limited-stream> stream-read1 ] unit-test
|
||||
[ "a" <string-reader> 1 <limited-stream> stream-read1 ] unit-test
|
||||
|
||||
[ "abc" ]
|
||||
[
|
||||
"abc" <string-reader> 3 stream-eofs <limited-stream>
|
||||
"abc" <string-reader> 3 <limited-stream>
|
||||
4 swap stream-read
|
||||
] unit-test
|
||||
|
||||
[ f ]
|
||||
[
|
||||
"abc" <string-reader> 3 stream-eofs <limited-stream>
|
||||
"abc" <string-reader> 3 <limited-stream>
|
||||
4 over stream-read drop 10 swap stream-read
|
||||
] unit-test
|
||||
|
||||
[ t ]
|
||||
[
|
||||
"abc" <string-reader> 3 stream-eofs limit unlimited
|
||||
"abc" <string-reader> 3 limit-stream unlimit-stream
|
||||
"abc" <string-reader> =
|
||||
] unit-test
|
||||
|
||||
[ t ]
|
||||
[
|
||||
"abc" <string-reader> 3 stream-eofs limit unlimited
|
||||
"abc" <string-reader> 3 limit-stream unlimit-stream
|
||||
"abc" <string-reader> =
|
||||
] unit-test
|
||||
|
||||
|
|
@ -73,145 +70,41 @@ IN: io.streams.limited.tests
|
|||
[
|
||||
[
|
||||
"resource:license.txt" utf8 <file-reader> &dispose
|
||||
3 stream-eofs limit unlimited
|
||||
3 limit-stream unlimit-stream
|
||||
"resource:license.txt" utf8 <file-reader> &dispose
|
||||
[ decoder? ] both?
|
||||
] with-destructors
|
||||
] unit-test
|
||||
|
||||
[ "HELL" ] [
|
||||
"HELLO"
|
||||
[ f stream-throws limit-input 4 read ]
|
||||
with-string-reader
|
||||
] unit-test
|
||||
|
||||
|
||||
[ "asdf" ] [
|
||||
"asdf" <string-reader> 2 stream-eofs <limited-stream> [
|
||||
"asdf" <string-reader> 2 <limited-stream> [
|
||||
unlimited-input contents
|
||||
] with-input-stream
|
||||
] unit-test
|
||||
|
||||
[ 4 ] [
|
||||
"abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
|
||||
4 seek-relative seek-input tell-input
|
||||
] with-input-stream
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
|
||||
4 seek-relative seek-input
|
||||
4 read
|
||||
] with-input-stream
|
||||
] [
|
||||
limit-exceeded?
|
||||
] must-fail-with
|
||||
|
||||
[
|
||||
"abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
|
||||
4 seek-relative seek-input
|
||||
-2 seek-relative
|
||||
2 read
|
||||
] with-input-stream
|
||||
] [
|
||||
limit-exceeded?
|
||||
] must-fail-with
|
||||
|
||||
[
|
||||
"abcdefgh" <string-reader> [
|
||||
4 seek-relative seek-input
|
||||
2 stream-throws limit-input
|
||||
-2 seek-relative seek-input
|
||||
2 read
|
||||
] with-input-stream
|
||||
] [
|
||||
limit-exceeded?
|
||||
] must-fail-with
|
||||
|
||||
[ "ef" ] [
|
||||
"abcdefgh" <string-reader> [
|
||||
4 seek-relative seek-input
|
||||
2 stream-throws limit-input
|
||||
4 seek-absolute seek-input
|
||||
2 read
|
||||
] with-input-stream
|
||||
] unit-test
|
||||
|
||||
[ "ef" ] [
|
||||
"abcdefgh" <string-reader> [
|
||||
4 seek-absolute seek-input
|
||||
2 stream-throws limit-input
|
||||
2 seek-absolute seek-input
|
||||
4 seek-absolute seek-input
|
||||
2 read
|
||||
] with-input-stream
|
||||
] unit-test
|
||||
|
||||
! stream-throws, pipes are duplex and not seekable
|
||||
! pipes are duplex and not seekable
|
||||
[ "as" ] [
|
||||
latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
|
||||
"asdf" over stream-write dup stream-flush
|
||||
2 swap stream-read
|
||||
] unit-test
|
||||
|
||||
[
|
||||
latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
|
||||
"asdf" over stream-write dup stream-flush
|
||||
3 swap stream-read
|
||||
] [
|
||||
limit-exceeded?
|
||||
] must-fail-with
|
||||
|
||||
! stream-eofs, pipes are duplex and not seekable
|
||||
[ "as" ] [
|
||||
latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
|
||||
latin1 <pipe> [ 2 <limited-stream> ] change-in
|
||||
"asdf" over stream-write dup stream-flush
|
||||
2 swap stream-read
|
||||
] unit-test
|
||||
|
||||
[ "as" ] [
|
||||
latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
|
||||
latin1 <pipe> [ 2 <limited-stream> ] change-in
|
||||
"asdf" over stream-write dup stream-flush
|
||||
3 swap stream-read
|
||||
] unit-test
|
||||
|
||||
! test seeking on limited unseekable streams
|
||||
[ "as" ] [
|
||||
latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
|
||||
latin1 <pipe> [ 2 <limited-stream> ] change-in
|
||||
"asdf" over stream-write dup stream-flush
|
||||
2 swap stream-read
|
||||
] unit-test
|
||||
|
||||
[ "as" ] [
|
||||
latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
|
||||
latin1 <pipe> [ 2 <limited-stream> ] change-in
|
||||
"asdf" over stream-write dup stream-flush
|
||||
3 swap stream-read
|
||||
] unit-test
|
||||
|
||||
[
|
||||
latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
|
||||
2 seek-absolute rot in>> stream-seek
|
||||
] must-fail
|
||||
|
||||
[
|
||||
"as"
|
||||
] [
|
||||
latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
|
||||
"asdf" over stream-write dup stream-flush
|
||||
[ 2 seek-absolute rot in>> stream-seek ] [ drop ] recover
|
||||
2 swap stream-read
|
||||
] unit-test
|
||||
|
||||
[ 7 ] [
|
||||
image binary stream-throws <limited-file-reader> [
|
||||
7 read drop
|
||||
tell-input
|
||||
] with-input-stream
|
||||
] unit-test
|
||||
|
||||
[ 70000 ] [
|
||||
image binary stream-throws <limited-file-reader> [
|
||||
70000 read drop
|
||||
tell-input
|
||||
] with-input-stream
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -6,87 +6,67 @@ io.encodings io.files io.files.info kernel locals math
|
|||
namespaces sequences ;
|
||||
IN: io.streams.limited
|
||||
|
||||
TUPLE: limited-stream
|
||||
stream mode
|
||||
count limit
|
||||
current start stop ;
|
||||
TUPLE: limited-stream stream count limit current start stop ;
|
||||
|
||||
SINGLETONS: stream-throws stream-eofs ;
|
||||
|
||||
: <limited-stream> ( stream limit mode -- stream' )
|
||||
: <limited-stream> ( stream limit -- stream' )
|
||||
limited-stream new
|
||||
swap >>mode
|
||||
swap >>limit
|
||||
swap >>stream
|
||||
0 >>count ;
|
||||
|
||||
: <limited-file-reader> ( path encoding mode -- stream' )
|
||||
[
|
||||
[ <file-reader> ]
|
||||
[ drop file-info size>> ] 2bi
|
||||
] dip <limited-stream> ;
|
||||
: <limited-file-reader> ( path encoding -- stream' )
|
||||
[ <file-reader> ]
|
||||
[ drop file-info size>> ] 2bi
|
||||
<limited-stream> ;
|
||||
|
||||
GENERIC# limit 2 ( stream limit mode -- stream' )
|
||||
GENERIC# limit-stream 1 ( stream limit -- stream' )
|
||||
|
||||
M: decoder limit ( stream limit mode -- stream' )
|
||||
[ clone ] 2dip '[ _ _ limit ] change-stream ;
|
||||
M: decoder limit-stream ( stream limit -- stream' )
|
||||
[ clone ] dip '[ _ limit-stream ] change-stream ;
|
||||
|
||||
M: object limit ( stream limit mode -- stream' )
|
||||
over [ <limited-stream> ] [ 2drop ] if ;
|
||||
M: object limit-stream ( stream limit -- stream' )
|
||||
<limited-stream> ;
|
||||
|
||||
GENERIC: unlimited ( stream -- stream' )
|
||||
GENERIC: unlimit-stream ( stream -- stream' )
|
||||
|
||||
M: decoder unlimited ( stream -- stream' )
|
||||
M: decoder unlimit-stream ( stream -- stream' )
|
||||
[ stream>> ] change-stream ;
|
||||
|
||||
M: object unlimited ( stream -- stream' )
|
||||
stream>> ;
|
||||
M: limited-stream unlimit-stream ( stream -- stream' ) stream>> ;
|
||||
|
||||
: limit-input ( limit mode -- )
|
||||
[ input-stream ] 2dip '[ _ _ limit ] change ;
|
||||
M: object unlimit-stream ( stream -- stream' ) ;
|
||||
|
||||
: limited-input ( limit -- )
|
||||
[ input-stream ] dip '[ _ limit-stream ] change ;
|
||||
|
||||
: unlimited-input ( -- )
|
||||
input-stream [ unlimited ] change ;
|
||||
input-stream [ unlimit-stream ] change ;
|
||||
|
||||
: with-unlimited-stream ( stream quot -- )
|
||||
[ clone unlimited ] dip call ; inline
|
||||
[ clone unlimit-stream ] dip call ; inline
|
||||
|
||||
: with-limited-stream ( stream limit mode quot -- )
|
||||
[ limit ] dip call ; inline
|
||||
: with-limited-stream ( stream limit quot -- )
|
||||
[ limit-stream ] dip call ; inline
|
||||
|
||||
ERROR: limit-exceeded n stream ;
|
||||
|
||||
ERROR: bad-stream-mode mode ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: adjust-current-limit ( n stream -- n' stream )
|
||||
2dup [ + ] change-current
|
||||
[ current>> ] [ stop>> ] bi >
|
||||
[
|
||||
dup mode>> {
|
||||
{ stream-throws [ limit-exceeded ] }
|
||||
{ stream-eofs [
|
||||
dup [ current>> ] [ stop>> ] bi -
|
||||
'[ _ - ] dip
|
||||
] }
|
||||
[ bad-stream-mode ]
|
||||
} case
|
||||
dup [ current>> ] [ stop>> ] bi -
|
||||
'[ _ - ] dip
|
||||
] when ; inline
|
||||
|
||||
: adjust-count-limit ( n stream -- n' stream )
|
||||
2dup [ + ] change-count
|
||||
[ count>> ] [ limit>> ] bi >
|
||||
[
|
||||
dup mode>> {
|
||||
{ stream-throws [ limit-exceeded ] }
|
||||
{ stream-eofs [
|
||||
dup [ count>> ] [ limit>> ] bi -
|
||||
'[ _ - ] dip
|
||||
dup limit>> >>count
|
||||
] }
|
||||
[ bad-stream-mode ]
|
||||
} case
|
||||
dup [ count>> ] [ limit>> ] bi -
|
||||
'[ _ - ] dip
|
||||
dup limit>> >>count
|
||||
] when ; inline
|
||||
|
||||
: check-count-bounds ( n stream -- n stream )
|
||||
|
|
@ -124,7 +104,11 @@ M: limited-stream stream-read-partial
|
|||
|
||||
: (read-until) ( stream seps buf -- stream seps buf sep/f )
|
||||
3dup [ [ stream-read1 dup ] dip member-eq? ] dip
|
||||
swap [ drop ] [ push (read-until) ] if ;
|
||||
swap [
|
||||
drop
|
||||
] [
|
||||
over [ push (read-until) ] [ drop ] if
|
||||
] if ;
|
||||
|
||||
:: limited-stream-seek ( n seek-type stream -- )
|
||||
seek-type {
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
! Copyright (C) 2010 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io io.streams.limited io.streams.string
|
||||
io.streams.throwing tools.test ;
|
||||
IN: io.streams.throwing.tests
|
||||
|
||||
[ "as" ]
|
||||
[
|
||||
"asdf" <string-reader> 2 <limited-stream>
|
||||
[ 6 read-partial ] throws-on-eof
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"asdf" <string-reader> 2 <limited-stream>
|
||||
[ contents ] throws-on-eof
|
||||
] [ stream-exhausted? ] must-fail-with
|
||||
|
||||
[
|
||||
"asdf" <string-reader> 2 <limited-stream>
|
||||
[ 2 read read1 ] throws-on-eof
|
||||
] [ stream-exhausted? ] must-fail-with
|
||||
|
||||
[
|
||||
"asdf" <string-reader> 2 <limited-stream>
|
||||
[ 3 read ] throws-on-eof
|
||||
] [ stream-exhausted? ] must-fail-with
|
||||
|
||||
[
|
||||
"asdf" <string-reader> 2 <limited-stream>
|
||||
[ 2 read 2 read ] throws-on-eof
|
||||
] [ stream-exhausted? ] must-fail-with
|
||||
|
||||
[
|
||||
"asdf" <string-reader> 2 <limited-stream>
|
||||
[ contents contents ] throws-on-eof
|
||||
] [ stream-exhausted? ] must-fail-with
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
! Copyright (C) 2010 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors destructors io kernel locals namespaces
|
||||
sequences ;
|
||||
IN: io.streams.throwing
|
||||
|
||||
ERROR: stream-exhausted n stream word ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: throws-on-eof stream ;
|
||||
|
||||
C: <throws-on-eof> throws-on-eof
|
||||
|
||||
M: throws-on-eof stream-element-type stream>> stream-element-type ;
|
||||
|
||||
M: throws-on-eof dispose stream>> dispose ;
|
||||
|
||||
M:: throws-on-eof stream-read1 ( stream -- obj )
|
||||
stream stream>> stream-read1
|
||||
[ 1 stream \ read1 stream-exhausted ] unless* ;
|
||||
|
||||
M:: throws-on-eof stream-read ( n stream -- seq )
|
||||
n stream stream>> stream-read
|
||||
dup length n = [ n stream \ read stream-exhausted ] unless ;
|
||||
|
||||
M:: throws-on-eof stream-read-partial ( n stream -- seq )
|
||||
n stream stream>> stream-read-partial
|
||||
[ n stream \ read-partial stream-exhausted ] unless* ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: throws-on-eof ( stream quot -- )
|
||||
[ <throws-on-eof> ] dip with-input-stream ; inline
|
||||
|
||||
: input-throws-on-eof ( quot -- )
|
||||
[ input-stream get <throws-on-eof> ] dip with-input-stream ; inline
|
||||
|
|
@ -1,11 +1,9 @@
|
|||
! Copyrigt (C) 2009 Doug Coleman, Keith Lazuka
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs combinators compression.lzw
|
||||
USING: accessors arrays combinators compression.lzw
|
||||
constructors destructors grouping images images.loader io
|
||||
io.binary io.buffers io.encodings.binary io.encodings.string
|
||||
io.encodings.utf8 io.files io.files.info io.ports
|
||||
io.streams.limited kernel make math math.bitwise math.functions
|
||||
multiline namespaces prettyprint sequences ;
|
||||
io.binary io.buffers io.encodings.string io.encodings.utf8
|
||||
io.ports kernel make math math.bitwise namespaces sequences ;
|
||||
IN: images.gif
|
||||
|
||||
SINGLETON: gif-image
|
||||
|
|
|
|||
Loading…
Reference in New Issue