diff options
| -rw-r--r-- | stream.c | 38 | ||||
| -rw-r--r-- | tests/018/streams.tl | 15 |
2 files changed, 51 insertions, 2 deletions
@@ -2264,6 +2264,40 @@ static ucnum byte_in_fill_buf(val stream, mem_t *ptr, ucnum len, ucnum pos) } } +static val byte_in_seek(val stream, val off, enum strm_whence whence) +{ + val self = lit("seek-stream"); + struct byte_input *bi = coerce(struct byte_input *, stream->co.handle); + val pos, len = nil; + + if (off == zero && whence == strm_cur) { + return unum(bi->index); + } else switch (whence) { + case strm_start: default: + pos = off; + break; + case strm_cur: + pos = plus(unum(bi->index), off); + break; + case strm_end: + pos = plus(len = unum(bi->size), off); + break; + } + + if (minusp(pos)) + uw_throwf(file_error_s, + lit("~a: ~s: negative position ~s disallowed"), + self, stream, pos, nao); + + if (gt(pos, len ? len : (len = unum(bi->size)))) + uw_throwf(file_error_s, + lit("~a: ~s: position ~s lies beyond buffer length ~s"), + self, stream, pos, len, nao); + + bi->index = c_unum(pos, self); + return t; +} + static val byte_in_get_error(val stream) { struct byte_input *bi = coerce(struct byte_input *, stream->co.handle); @@ -2290,7 +2324,9 @@ static struct strm_ops byte_in_ops = byte_in_unget_byte, 0, byte_in_fill_buf, - 0, 0, 0, 0, 0, 0, + 0, 0, + byte_in_seek, + 0, 0, 0, byte_in_get_error, byte_in_get_error_str, 0, 0); diff --git a/tests/018/streams.tl b/tests/018/streams.tl index 4c4bde7d..3bdab5bd 100644 --- a/tests/018/streams.tl +++ b/tests/018/streams.tl @@ -66,12 +66,25 @@ (get-char s) #\A (get-byte s) 66 (get-char s) #\C + (seek-stream s 0 :from-current) 3 (unget-char #\x3042 s) #\x3042 + (seek-stream s 0 :from-current) 0 (get-char s) #\x3042 (unget-char #\x3042 s) #\x3042 (get-byte s) #xe3 (get-char s) #\xdc81 - (unget-char #\x3042 s) :error)) + (seek-stream s 0 :from-current) 2 + (unget-char #\x3042 s) :error + (seek-stream s -1 :from-start) :error + (seek-stream s 0 :from-start) t + (seek-stream s 0 :from-end) t + (seek-stream s 0 :from-current) 4 + (seek-stream s 1 :from-end) :error + (seek-stream s -1 :from-end) t + (seek-stream s 0 :from-current) 3 + (seek-stream s -4 :from-end) t + (seek-stream s 0 :from-current) 0 + (seek-stream s -5 :from-end) :error)) (with-in-string-byte-stream (s "[1][foo]") (mtest |