buf: fix seek and truncate operations.

* buf.c (buf_strm_seek): fix incorrect from-end calculation
which must be an addition, not subtraction.
Throw a file-error, not generic error.
When the seek size exceeds the buffer size, extend it with
zeros.
(buf_strm_truncate): Completely revised. When the requested
length lies beyond the current position, the buffer's
length is set to that position, which may truncate or
extend it. When the requested length lies below the current
position, the buffer is truncated only to the current
position, not below. The byes below the position, down to
the truncation position, are obliterated to zero.
Added missing check for negative offset.

* tests/018/streams.tl: New tests.

* txr.1: Documentation added.

3 files changed, 66 insertions, 3 deletions

diff --git a/buf.c b/buf.c
index a3f63d41..c14f68b3 100644
--- a/buf.c
+++ b/buf.c
@@ -1213,24 +1213,42 @@ static val buf_strm_seek(val stream, val offset, enum strm_whence whence)
     npos = plus(s->pos, offset);
     break;
   case strm_end:
-    npos = minus(b->len, offset);
+    npos = plus(b->len, offset);
     break;
   default:
     internal_error("invalid whence value");
   }
 
+
   if (minusp(npos))
-    uw_throwf(error_s, lit("~a: cannot seek to negative position ~s"),
+    uw_throwf(file_error_s, lit("~a: cannot seek to negative position ~s"),
               self, npos, nao);
 
+  if (gt(npos, b->len))
+    buf_set_length(s->buf, npos, zero);
+
   s->pos = npos;
   return t;
 }
 
 static val buf_strm_truncate(val stream, val len)
 {
+  val self = lit("truncate-stream");
   struct buf_strm *s = coerce(struct buf_strm *, stream->co.handle);
-  buf_set_length(s->buf, len, zero);
+  struct buf *b = us_buf_handle(s->buf);
+
+  if (ge(len, s->pos)) {
+    buf_set_length(s->buf, len, zero);
+  } else if (minusp(len)) {
+    uw_throwf(file_error_s, lit("~a: negative length~s specified"),
+              self, len, nao);
+  } else {
+    cnum p = c_num(s->pos, self);
+    cnum l = c_num(len, self);
+    buf_set_length(s->buf, s->pos, zero);
+    memset(b->data + l, 0, p - l);
+  }
+
   return t;
 }
 
diff --git a/tests/018/streams.tl b/tests/018/streams.tl
index 9475d4f7..4c4bde7d 100644
--- a/tests/018/streams.tl
+++ b/tests/018/streams.tl
@@ -194,3 +194,32 @@
     (truncate-stream s 2) :error
     (seek-stream s 0 :from-current) :error
     (put-string "X" s) :error))
+
+(with-in-buf-stream (s (make-buf 16))
+  (mtest
+    (put-char #\A s) t
+    (get-buf-from-stream s) #b'41000000000000000000000000000000'
+    (put-string "BCD" s) t
+    (get-buf-from-stream s) #b'41424344000000000000000000000000'
+    (truncate-stream s -1) :error
+    (seek-stream s -1 :from-start) :error
+    (seek-stream s 0 :from-start) t
+    (put-char #\X s) t
+    (get-buf-from-stream s) #b'58424344000000000000000000000000'
+    (put-buf #b'AABBCCDDEEFF11' 0 s) 7
+    (get-buf-from-stream s) #b'58AABBCCDDEEFF110000000000000000'
+    (put-buf #b'AABBCCDDEEFF1122' 0 s) 8
+    (get-buf-from-stream s) #b'58AABBCCDDEEFF11AABBCCDDEEFF1122'
+    (truncate-stream s 16) t
+    (get-buf-from-stream s) #b'58AABBCCDDEEFF11AABBCCDDEEFF1122'
+    (truncate-stream s 18) t
+    (get-buf-from-stream s) #b'58AABBCCDDEEFF11AABBCCDDEEFF11220000'
+    (truncate-stream s 8) t
+    (get-buf-from-stream s) #b'58AABBCCDDEEFF110000000000000000'
+    (seek-stream s 0 :from-current) 16
+    (truncate-stream s 0) t
+    (get-buf-from-stream s) #b'00000000000000000000000000000000'
+    (seek-stream s -16 :from-end) t
+    (seek-stream s 0 :from-current) 0
+    (truncate-stream s 0) t
+    (get-buf-from-stream s) #b''))
diff --git a/txr.1 b/txr.1
index 0f9ff70b..1dfdfff0 100644
--- a/txr.1
+++ b/txr.1
@@ -70441,6 +70441,22 @@ object. The stream is then associated with this object.
 If the argument is omitted, a buffer of length zero is created and associated
 with the stream.
 
+Buffer streams support byte and character input and output.
+
+They support the
+.code seek-stream
+and
+.code truncate-stream
+operations. The latter may make be used to make the buffer
+larger or smaller. Enlargement causes the newly created space to be
+filled with zero bytes.
+When
+.code truncate-stream
+is used to specify a length which is below the current position,
+the buffer is not truncated to that length, but rather to the
+current position. The interval between the truncation length
+and the current position is then obliterated with zeros.
+
 .coNP Function @ get-buf-from-stream
 .synb
 .mets (get-buf-from-stream << buf-stream )