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

io.streams.throwing: rename throws-on-eof -> stream-throw-on-eof and input-throws-on-eof -> throw-on-eof and change stream-throw-on-eof to leave the rigged stream on the stack, to better follow convention of other io words

db4
Joe Groff 2010-07-09 18:08:45 -07:00
parent fb4cbd87d4
commit b1c557a825
10 changed files with 63 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/images/bitmap/bitmap.factor
View File

@ -363,7 +363,7 @@ ERROR: unsupported-bitmap-file magic ;
! { "PT" [ parse-os2-pointer ] }
[ unsupported-bitmap-file ]
} case
] input-throws-on-eof
] throw-on-eof
] with-input-stream ;
: loading-bitmap>bytes ( loading-bitmap -- byte-array )

18
basis/images/jpeg/jpeg.factor
View File

@ -121,15 +121,17 @@ TUPLE: jpeg-color-info
: decode-huff-table ( chunk -- )
data>> [ binary <byte-reader> ] [ length ] bi limit-stream [
[ input-stream get stream>> [ count>> ] [ limit>> ] bi < ]
[
read4/4 swap 2 * +
16 read
dup [ ] [ + ] map-reduce read
binary [ [ read [ B{ } ] unless* ] { } map-as ] with-byte-reader
swap jpeg> huff-tables>> set-nth
] while
] throws-on-eof ;
[ input-stream get stream>> [ count>> ] [ limit>> ] bi < ]
[
read4/4 swap 2 * +
16 read
dup [ ] [ + ] map-reduce read
binary [ [ read [ B{ } ] unless* ] { } map-as ] with-byte-reader
swap jpeg> huff-tables>> set-nth
] while
] with-input-stream*
] stream-throw-on-eof ;
: decode-scan ( chunk -- )
data>>

2
basis/images/pbm/pbm.factor
View File

@ -73,7 +73,7 @@ SINGLETON: pbm-image
PRIVATE>
M: pbm-image stream>image
drop [ [ read-pbm ] input-throws-on-eof ] with-input-stream ;
drop [ [ read-pbm ] throw-on-eof ] with-input-stream ;
M: pbm-image image>stream
drop {

2
basis/images/pgm/pgm.factor
View File

@ -50,7 +50,7 @@ SINGLETON: pgm-image
wide [ ushort-components ] [ ubyte-components ] if >>component-type ;
M: pgm-image stream>image
drop [ [ read-pgm ] input-throws-on-eof ] with-input-stream ;
drop [ [ read-pgm ] throw-on-eof ] with-input-stream ;
M: pgm-image image>stream
drop {

2
basis/images/png/png.factor
View File

@ -324,7 +324,7 @@ ERROR: invalid-color-type/bit-depth loading-png ;
read-png-header
read-png-chunks
parse-ihdr-chunk
] input-throws-on-eof
] throw-on-eof
] with-input-stream ;
M: png-image stream>image

2
basis/images/ppm/ppm.factor
View File

@ -47,7 +47,7 @@ SINGLETON: ppm-image
ubyte-components >>component-type ;
M: ppm-image stream>image
drop [ [ read-ppm ] input-throws-on-eof ] with-input-stream ;
drop [ [ read-ppm ] throw-on-eof ] with-input-stream ;
M: ppm-image image>stream
drop {

2
basis/images/tga/tga.factor
View File

@ -254,7 +254,7 @@ ERROR: bad-tga-unsupported ;
ubyte-components >>component-type ;
M: tga-image stream>image
drop [ [ read-tga ] input-throws-on-eof ] with-input-stream ;
drop [ [ read-tga ] throw-on-eof ] with-input-stream ;
M: tga-image image>stream
drop

2
basis/images/tiff/tiff.factor
View File

@ -561,6 +561,6 @@ ERROR: unknown-component-order ifd ;
! tiff files can store several images -- we just take the first for now
M: tiff-image stream>image ( stream tiff-image -- image )
drop [ [ load-tiff tiff>image ] input-throws-on-eof ] with-input-stream ;
drop [ [ load-tiff tiff>image ] throw-on-eof ] with-input-stream ;
{ "tif" "tiff" } [ tiff-image register-image-class ] each

57
basis/io/streams/throwing/throwing-tests.factor
View File

@ -1,56 +1,63 @@
! 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 kernel ;
USING: io io.encodings.utf8 io.files io.streams.string
io.streams.throwing kernel tools.test destructors ;
IN: io.streams.throwing.tests
[ "as" ]
[ "asdf" ]
[
"asdf" <string-reader> 2 <limited-stream>
[ 6 read-partial ] throws-on-eof
"asdf" [ [ 6 read-partial ] throw-on-eof ] with-string-reader
] unit-test
[
"asdf" <string-reader> 2 <limited-stream>
[ contents ] throws-on-eof
"asdf" [ [ 4 read read1 ] throw-on-eof ] with-string-reader
] [ stream-exhausted? ] must-fail-with
[
"asdf" <string-reader> 2 <limited-stream>
[ 2 read read1 ] throws-on-eof
[
"asdf" <string-reader> &dispose [
[ 4 swap stream-read ]
[ stream-read1 ] bi
] stream-throw-on-eof
] with-destructors
] [ stream-exhausted? ] must-fail-with
[
"asdf" <string-reader> 2 <limited-stream>
[ 3 read ] throws-on-eof
"asdf" [ [ 5 read ] throw-on-eof ] with-string-reader
] [ stream-exhausted? ] must-fail-with
[
"asdf" <string-reader> 2 <limited-stream>
[ 2 read 2 read ] throws-on-eof
"asdf" [ [ 4 read 4 read ] throw-on-eof ] with-string-reader
] [ stream-exhausted? ] must-fail-with
[
"asdf" <string-reader> 2 <limited-stream>
[ contents contents ] throws-on-eof
] [ stream-exhausted? ] must-fail-with
[ "as" "df" ] [
"asdf" [ [ 2 read ] throw-on-eof 3 read ] with-string-reader
] unit-test
[ "as" "df\n" ] [
"vocab:io/streams/throwing/asdf.txt" utf8 [
[ 2 read ] throw-on-eof 20 read
] with-file-reader
] unit-test
[ "asdf" "asdf" ] [
"asdf" [
[ 4 read 0 seek-absolute seek-input 4 read ] throw-on-eof
] with-string-reader
] unit-test
[
"asdf" <string-reader> 2 <limited-stream>
[ 1 seek-absolute seek-input 4 read drop ] throws-on-eof
"asdf" [ [ 1 seek-absolute seek-input 4 read drop ] throw-on-eof ] with-string-reader
] [ stream-exhausted? ] must-fail-with
[ "asd" CHAR: f ] [
"asdf" <string-reader>
[ "f" read-until ] throws-on-eof
"asdf" [ [ "f" read-until ] throw-on-eof ] with-string-reader
] unit-test
[
"asdf" <string-reader>
[ "g" read-until ] throws-on-eof
"asdf" [ [ "g" read-until ] throw-on-eof ] with-string-reader
] [ stream-exhausted? ] must-fail-with
[ 1 ] [
"asdf" <string-reader> 2 <limited-stream>
[ 1 seek-absolute seek-input tell-input ] throws-on-eof
"asdf" [ [ 1 seek-absolute seek-input tell-input ] throw-on-eof ] with-string-reader
] unit-test

28
basis/io/streams/throwing/throwing.factor
View File

@ -8,40 +8,40 @@ ERROR: stream-exhausted n stream word ;
<PRIVATE
TUPLE: throws-on-eof stream ;
TUPLE: throws-on-eof-stream stream ;
C: <throws-on-eof> throws-on-eof
C: <throws-on-eof-stream> throws-on-eof-stream
M: throws-on-eof stream-element-type stream>> stream-element-type ;
M: throws-on-eof-stream stream-element-type stream>> stream-element-type ;
M: throws-on-eof dispose stream>> dispose ;
M: throws-on-eof-stream dispose stream>> dispose ;
M:: throws-on-eof stream-read1 ( stream -- obj )
M:: throws-on-eof-stream stream-read1 ( stream -- obj )
stream stream>> stream-read1
[ 1 stream \ read1 stream-exhausted ] unless* ;
M:: throws-on-eof stream-read ( n stream -- seq )
M:: throws-on-eof-stream 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 )
M:: throws-on-eof-stream stream-read-partial ( n stream -- seq )
n stream stream>> stream-read-partial
[ n stream \ read-partial stream-exhausted ] unless* ;
M: throws-on-eof stream-tell
M: throws-on-eof-stream stream-tell
stream>> stream-tell ;
M: throws-on-eof stream-seek
M: throws-on-eof-stream stream-seek
stream>> stream-seek ;
M: throws-on-eof stream-read-until
M: throws-on-eof-stream stream-read-until
[ stream>> stream-read-until ]
[ '[ length _ \ read-until stream-exhausted ] unless* ] bi ;
PRIVATE>
: throws-on-eof ( stream quot -- )
[ <throws-on-eof> ] dip with-input-stream ; inline
: stream-throw-on-eof ( ..a stream quot: ( ..a stream' -- ..b ) -- ..b )
[ <throws-on-eof-stream> ] dip call ; inline
: input-throws-on-eof ( quot -- )
[ input-stream get <throws-on-eof> ] dip with-input-stream ; inline
: throw-on-eof ( ..a quot: ( ..a -- ..b ) -- ..b )
[ input-stream get <throws-on-eof-stream> ] dip with-input-stream* ; inline