From a2a343e6c9fa2888b71f1526ab0791ef7ade5940 Mon Sep 17 00:00:00 2001
From: Theodor Thornhill <theo@thornhill.no>
Date: Thu, 27 Aug 2020 20:11:41 +0200
Subject: [PATCH] Add arbitrary length array

---
 src/bare.lisp         | 22 ++++++++++++++++++++--
 src/package.lisp      |  2 ++
 tests/bare-tests.lisp | 27 ++++++++++++++++++++++-----
 3 files changed, 44 insertions(+), 7 deletions(-)

diff --git a/src/bare.lisp b/src/bare.lisp
index 07c7fe8..714d0e8 100644
--- a/src/bare.lisp
+++ b/src/bare.lisp
@@ -160,12 +160,30 @@ Set this dynamically in the function calling the DATA defbinary.")
         (write-byte 1 stream)
         (write-binary object stream))))
 
-(defun read-array (type length stream)
+(defun read-array (type stream)
+  (let ((size (read-binary 'uint stream))
+        res)
+    (with-slots (value) size
+      (dotimes (i value)
+        (push (read-binary type stream) res)))
+    (nreverse res)))
+
+(defun write-array (objects stream)
+  (let ((size (length objects)))
+    (write-binary (read-binary
+                   'uint
+                   (flex:make-in-memory-input-stream
+                    (vector size)))
+                  stream)
+    (dotimes (i size)
+      (write-binary (nth i objects) stream))))
+
+(defun read-array-fixed (type length stream)
   (let (res)
     (dotimes (i length)
       (push (read-binary type stream) res))
     (nreverse res)))
 
-(defun write-array (objects stream)
+(defun write-array-fixed (objects stream)
   (dolist (object objects)
     (write-binary object stream)))
diff --git a/src/package.lisp b/src/package.lisp
index 6925c71..a60d84b 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -24,4 +24,6 @@
    :write-optional-type
    :read-array
    :write-array
+   :read-array-fixed
+   :write-array-fixed
    :value))
diff --git a/tests/bare-tests.lisp b/tests/bare-tests.lisp
index d9dd308..2a264a2 100644
--- a/tests/bare-tests.lisp
+++ b/tests/bare-tests.lisp
@@ -190,15 +190,32 @@
         (with-slots (value) object
           (ok (equalp value 112)))))))
 
-(deftest array-type-test
-  (testing "reading and writing array type when not set"
+(deftest array-test
+  (testing "reading and writing array"
     (with-input-from-sequence
         (in
          (with-output-to-sequence (out)
-           (write-array
-            (read-array 'u8 4 (buf #(#x11 #x22 #x33 #x44)))
+           (write-array (read-array 'u8 (buf #(#x04 #x11 #x22 #x33 #x44)))
             out)))
-      (let ((objects (read-array 'u8 4 in)))
+      (let ((objects (read-array 'u8 in)))
+        (with-slots (value) (first objects)
+          (ok (= value 17)))
+        (with-slots (value) (second objects)
+          (ok (= value 34)))
+        (with-slots (value) (third objects)
+          (ok (= value 51)))
+        (with-slots (value) (fourth objects)
+          (ok (= value 68)))))))
+
+(deftest array-fixed-test
+  (testing "reading and writing array-fixed"
+    (with-input-from-sequence
+        (in
+         (with-output-to-sequence (out)
+           (write-array-fixed
+            (read-array-fixed 'u8 4 (buf #(#x11 #x22 #x33 #x44)))
+            out)))
+      (let ((objects (read-array-fixed 'u8 4 in)))
         (with-slots (value) (first objects)
           (ok (= value 17)))
         (with-slots (value) (second objects)
-- 
2.45.2