tests: add sequence stream tests for new functionality

- ensure that all byte element types are handled by binary sequence streams
- ensure that the vector fill pointer is followed by the input sequence
This commit is contained in:
Daniel Kochmański 2025-07-24 10:07:47 +02:00
parent c7f534771a
commit 5fe96b8339

View file

@ -111,3 +111,49 @@
(stream (make-sequence-io-stream vector :ascii)))
(test-bivalent-input-stream stream vector)))
;;; Ensure that MAKE-SEQUENCE-INPUT-STREAM and MAKE-SEQUENCE-OUTPUT-STREAM can
;;; take bytes that are larger than any character.
(deftest stream.binary-sequence ()
(loop with values = (loop for i from 0 below 16 collect i)
for (elt-type . format) in '(((unsigned-byte 8) . nil)
((unsigned-byte 16) . nil)
((unsigned-byte 32) . nil)
((unsigned-byte 64) . nil)
((unsigned-byte 16) . :ucs-2)
((unsigned-byte 32) . :ucs-4))
for vector = (make-array 16 :element-type elt-type :initial-contents values)
for stream = (finishes (make-sequence-io-stream vector format))
when (and stream (null format))
do (finishes (test-byte-input-stream stream vector))))
(deftest stream.invalid-sequence ()
(loop with values = (loop for i from 0 below 16 collect i)
for (elt-type . format) in '((t . nil)
(single-float . nil)
(double-float . nil)
(long-float . nil)
(si:complex-single-float . nil)
(si:complex-double-float . nil)
(si:complex-long-float . nil))
for vector = (make-array 16 :element-type elt-type :initial-contents values)
do (signals error (make-sequence-io-stream vector format))))
(deftest stream.bidirectional-vector-with-fill-pointer ()
(let* ((values (map 'vector #'char-code "ABCDEFGHIJKLMNOP"))
(vector (make-array 16 :element-type '(unsigned-byte 8)
:initial-contents values
:fill-pointer 8))
(stream (make-sequence-io-stream vector :ascii)))
(dotimes (v 8)
(finishes (read-char stream)))
(signals error (read-char stream))
(dotimes (v 4) (write-char #\x stream))
(dotimes (v 2) (write-char #\y stream))
(dotimes (v 4) (eql #\x (read-char stream)))
(dotimes (v 2) (eql #\y (read-char stream)))
(signals error (read-char stream))
(dotimes (v 2) (finishes (write-char #\z stream)))
(signals error (write-char #\z stream))
(dotimes (v 2) (eql #\z (read-char stream)))
(signals error (read-char stream))))