diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index 4b7ef4b40f..3245d80d4e 100644 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -49,6 +49,9 @@ M: fd cancel-operation ( fd -- ) 2bi ] if ; +M: unix tell-handle ( handle -- n ) + fd>> SEEK_SET 0 lseek [ io-error ] [ ] bi ; + M: unix seek-handle ( n seek-type handle -- ) swap { { io:seek-absolute [ SEEK_SET ] } diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 49f6166e00..e225bed32f 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -124,8 +124,13 @@ M: output-port stream-write HOOK: (wait-to-write) io-backend ( port -- ) +HOOK: tell-handle os ( handle -- n ) HOOK: seek-handle os ( n seek-type handle -- ) +M: buffered-port stream-tell ( stream -- n ) + [ check-disposed ] + [ handle>> tell-handle ] bi ; + M: input-port stream-seek ( n seek-type stream -- ) [ check-disposed ] [ buffer>> 0 swap buffer-reset ] diff --git a/basis/io/streams/duplex/duplex.factor b/basis/io/streams/duplex/duplex.factor index 4903195abc..0e4d1fd195 100644 --- a/basis/io/streams/duplex/duplex.factor +++ b/basis/io/streams/duplex/duplex.factor @@ -44,4 +44,3 @@ M: duplex-stream underlying-handle >duplex-stream< [ underlying-handle ] bi@ [ = [ invalid-duplex-stream ] when ] keep ; - diff --git a/basis/io/streams/limited/limited-tests.factor b/basis/io/streams/limited/limited-tests.factor index f052be3b74..bc9125dd62 100644 --- a/basis/io/streams/limited/limited-tests.factor +++ b/basis/io/streams/limited/limited-tests.factor @@ -1,7 +1,8 @@ -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 io.streams.string accessors -io.encodings.utf8 io.files destructors ; +USING: accessors continuations destructors io io.encodings +io.encodings.8-bit io.encodings.ascii io.encodings.binary +io.encodings.string io.encodings.utf8 io.files io.pipes +io.streams.byte-array io.streams.limited io.streams.string +kernel namespaces strings tools.test ; IN: io.streams.limited.tests [ ] [ @@ -89,3 +90,113 @@ IN: io.streams.limited.tests unlimited-input contents ] with-input-stream ] unit-test + +[ 4 ] [ + "abcdefgh" 4 stream-throws [ + 4 seek-relative seek-input tell-input + ] with-input-stream +] unit-test + +[ + "abcdefgh" 4 stream-throws [ + 4 seek-relative seek-input + 4 read + ] with-input-stream +] [ + limit-exceeded? +] must-fail-with + +[ + "abcdefgh" 4 stream-throws [ + 4 seek-relative seek-input + -2 seek-relative + 2 read + ] with-input-stream +] [ + limit-exceeded? +] must-fail-with + +[ + "abcdefgh" [ + 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" [ + 4 seek-relative seek-input + 2 stream-throws limit-input + 4 seek-absolute seek-input + 2 read + ] with-input-stream +] unit-test + +[ "ef" ] [ + "abcdefgh" [ + 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 +[ "as" ] [ + latin1 [ 2 stream-throws ] change-in + "asdf" over stream-write dup stream-flush + 2 swap stream-read +] unit-test + +[ + latin1 [ 2 stream-throws ] 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 [ 2 stream-eofs ] change-in + "asdf" over stream-write dup stream-flush + 2 swap stream-read +] unit-test + +[ "as" ] [ + latin1 [ 2 stream-eofs ] change-in + "asdf" over stream-write dup stream-flush + 3 swap stream-read +] unit-test + +! test seeking on limited unseekable streams +[ "as" ] [ + latin1 [ 2 stream-eofs ] change-in + "asdf" over stream-write dup stream-flush + 2 swap stream-read +] unit-test + +[ "as" ] [ + latin1 [ 2 stream-eofs ] change-in + "asdf" over stream-write dup stream-flush + 3 swap stream-read +] unit-test + +[ + latin1 [ 2 stream-throws ] change-in + 2 seek-absolute rot in>> stream-seek +] must-fail + +[ + "as" +] [ + latin1 [ 2 stream-throws ] change-in + "asdf" over stream-write dup stream-flush + [ 2 seek-absolute rot in>> stream-seek ] [ drop ] recover + 2 swap stream-read +] unit-test diff --git a/basis/io/streams/limited/limited.factor b/basis/io/streams/limited/limited.factor index c71e99ab91..403643ed73 100755 --- a/basis/io/streams/limited/limited.factor +++ b/basis/io/streams/limited/limited.factor @@ -2,11 +2,14 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors byte-vectors combinators destructors fry io -io.encodings io.files io.files.info kernel math namespaces -sequences ; +io.encodings io.files io.files.info kernel locals math +namespaces sequences ; IN: io.streams.limited -TUPLE: limited-stream stream count limit mode stack ; +TUPLE: limited-stream + stream mode + count limit + current start stop ; SINGLETONS: stream-throws stream-eofs ; @@ -51,13 +54,27 @@ M: object unlimited ( stream -- stream' ) : with-limited-stream ( stream limit mode quot -- ) [ limit ] dip call ; inline -ERROR: limit-exceeded ; +ERROR: limit-exceeded n stream ; ERROR: bad-stream-mode mode ; > ] [ stop>> ] bi > + [ + dup mode>> { + { stream-throws [ limit-exceeded ] } + { stream-eofs [ + dup [ current>> ] [ stop>> ] bi - + '[ _ - ] dip + ] } + [ bad-stream-mode ] + } case + ] when ; inline + +: adjust-count-limit ( n stream -- n' stream ) 2dup [ + ] change-count [ count>> ] [ limit>> ] bi > [ @@ -66,13 +83,29 @@ ERROR: bad-stream-mode mode ; { stream-eofs [ dup [ count>> ] [ limit>> ] bi - '[ _ - ] dip + dup limit>> >>count ] } [ bad-stream-mode ] } case ] when ; inline +: check-count-bounds ( n stream -- n stream ) + dup [ count>> ] [ limit>> ] bi > + [ limit-exceeded ] when ; + +: check-current-bounds ( n stream -- n stream ) + dup [ current>> ] [ start>> ] bi < + [ limit-exceeded ] when ; + +: adjust-limited-read ( n stream -- n stream ) + dup start>> [ + check-current-bounds adjust-current-limit + ] [ + check-count-bounds adjust-count-limit + ] if ; + : maybe-read ( n limited-stream quot: ( n stream -- seq/f ) -- seq/f ) - [ adjust-limit ] dip + [ adjust-limited-read ] dip pick 0 <= [ 3drop f ] [ [ stream>> ] dip call ] if ; inline PRIVATE> @@ -93,16 +126,35 @@ M: limited-stream stream-read-partial 3dup [ [ stream-read1 dup ] dip memq? ] dip swap [ drop ] [ push (read-until) ] if ; +:: limited-stream-seek ( n seek-type stream -- ) + seek-type { + { seek-absolute [ n stream (>>current) ] } + { seek-relative [ stream [ n + ] change-current drop ] } + { seek-end [ stream stop>> n - stream (>>current) ] } + [ bad-seek-type ] + } case ; + +: >limited-seek ( stream -- stream' ) + dup start>> [ + dup stream-tell >>current + dup [ current>> ] [ count>> ] bi - >>start + dup [ start>> ] [ limit>> ] bi + >>stop + ] unless ; + PRIVATE> M: limited-stream stream-read-until swap BV{ } clone (read-until) [ 2nip B{ } like ] dip ; -M: limited-stream stream-seek - stream>> stream-seek ; +M: limited-stream stream-tell + stream>> stream-tell ; -M: limited-stream dispose - stream>> dispose ; +M: limited-stream stream-seek + >limited-seek + [ stream>> stream-seek ] + [ limited-stream-seek ] 3bi ; + +M: limited-stream dispose stream>> dispose ; M: limited-stream stream-element-type stream>> stream-element-type ; diff --git a/basis/io/streams/string/string.factor b/basis/io/streams/string/string.factor index 85cb3022f5..be9016d1f2 100644 --- a/basis/io/streams/string/string.factor +++ b/basis/io/streams/string/string.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors io kernel math namespaces sequences sbufs strings generic splitting continuations destructors sequences.private -io.streams.plain io.encodings math.order growable io.streams.sequence ; +io.streams.plain io.encodings math.order growable io.streams.sequence +io.private ; IN: io.streams.string ! Readers @@ -13,6 +14,8 @@ M: string-reader stream-read-partial stream-read ; M: string-reader stream-read sequence-read ; M: string-reader stream-read1 sequence-read1 ; M: string-reader stream-read-until sequence-read-until ; +M: string-reader stream-tell i>> ; +M: string-reader stream-seek (stream-seek) ; M: string-reader dispose drop ; [ swap with-output-stream* - ] keep >string ; inline \ No newline at end of file + ] keep >string ; inline diff --git a/core/io/encodings/encodings-tests.factor b/core/io/encodings/encodings-tests.factor index fa8832deab..9b88db5136 100644 --- a/core/io/encodings/encodings-tests.factor +++ b/core/io/encodings/encodings-tests.factor @@ -1,6 +1,6 @@ USING: io.files io.streams.string io io.streams.byte-array tools.test kernel io.encodings.ascii io.encodings.utf8 -namespaces accessors io.encodings ; +namespaces accessors io.encodings io.streams.limited ; IN: io.streams.encodings.tests [ { } ] diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 174816dd34..03e8723d20 100644 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -50,6 +50,10 @@ M: object f decoder boa ; M: decoder stream-element-type drop +character+ ; +M: decoder stream-tell stream>> stream-tell ; + +M: decoder stream-seek stream>> stream-seek ; + M: decoder stream-read1 dup >decoder< decode-char fix-read1 ; diff --git a/core/io/io.factor b/core/io/io.factor index 669f104a5f..e240467c07 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2003, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: hashtables generic kernel math namespaces make sequences -continuations destructors assocs combinators ; +USING: accessors combinators continuations destructors kernel +math namespaces sequences ; IN: io SYMBOLS: +byte+ +character+ ; @@ -23,9 +23,24 @@ ERROR: bad-seek-type type ; SINGLETONS: seek-absolute seek-relative seek-end ; +GENERIC: stream-tell ( stream -- n ) GENERIC: stream-seek ( n seek-type stream -- ) -: stream-print ( str stream -- ) [ stream-write ] keep stream-nl ; +>i) ] } + { seek-relative [ [ + ] change-i drop ] } + { seek-end [ [ underlying>> length + ] [ (>>i) ] bi ] } + [ bad-seek-type ] + } case ; + +PRIVATE> + +: stream-print ( str stream -- ) [ stream-write ] [ stream-nl ] bi ; ! Default streams SYMBOL: input-stream @@ -37,6 +52,8 @@ SYMBOL: error-stream : read ( n -- seq ) input-stream get stream-read ; : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ; : read-partial ( n -- seq ) input-stream get stream-read-partial ; +: tell-input ( -- n ) input-stream get stream-tell ; +: tell-output ( -- n ) output-stream get stream-tell ; : seek-input ( n seek-type -- ) input-stream get stream-seek ; : seek-output ( n seek-type -- ) output-stream get stream-seek ; diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor index 3a08dd10d9..96b122549d 100644 --- a/core/io/streams/byte-array/byte-array-tests.factor +++ b/core/io/streams/byte-array/byte-array-tests.factor @@ -29,7 +29,11 @@ io.encodings.utf8 io kernel arrays strings namespaces math ; ] with-byte-reader ] unit-test +[ 0 ] [ + B{ 1 2 3 4 5 6 7 8 9 10 11 12 } binary [ tell-input ] with-byte-reader +] unit-test + ! Overly aggressive compiler optimizations [ B{ 123 } ] [ binary [ 123 >bignum write1 ] with-byte-writer -] unit-test \ No newline at end of file +] unit-test diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor index 4cb50dfbc1..6f9b05cf18 100644 --- a/core/io/streams/byte-array/byte-array.factor +++ b/core/io/streams/byte-array/byte-array.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008, 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: byte-arrays byte-vectors kernel io.encodings sequences io -namespaces io.encodings.private accessors sequences.private -io.streams.sequence destructors math combinators ; +USING: accessors byte-arrays byte-vectors destructors io +io.encodings io.private io.streams.sequence kernel namespaces +sequences sequences.private ; IN: io.streams.byte-array M: byte-vector stream-element-type drop +byte+ ; @@ -24,13 +24,8 @@ M: byte-reader stream-read1 sequence-read1 ; M: byte-reader stream-read-until sequence-read-until ; M: byte-reader dispose drop ; -M: byte-reader stream-seek ( n seek-type stream -- ) - swap { - { seek-absolute [ (>>i) ] } - { seek-relative [ [ + ] change-i drop ] } - { seek-end [ [ underlying>> length + ] keep (>>i) ] } - [ bad-seek-type ] - } case ; +M: byte-reader stream-tell i>> ; +M: byte-reader stream-seek (stream-seek) ; : ( byte-array encoding -- stream ) [ B{ } like 0 byte-reader boa ] dip ; diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index aebc709a9e..6ff1a4b35c 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -13,6 +13,8 @@ TUPLE: c-stream < disposable handle ; M: c-stream dispose* handle>> fclose ; +M: c-stream stream-tell handle>> ftell ; + M: c-stream stream-seek handle>> swap { { seek-absolute [ 0 ] }