Initial commit.

1 files changed, 206 insertions, 0 deletions

diff --git a/tests/decode-tests.lisp b/tests/decode-tests.lisp
new file mode 100644
index 0000000..2cd359a
--- /dev/null
+++ b/tests/decode-tests.lisp
@@ -0,0 +1,206 @@
+;; This file is part of eris-cl.
+;; Copyright (C) 2022 Piotr Szarmański
+
+;; eris-cl is free software: you can redistribute it and/or modify it under the
+;; terms of the GNU Lesser General Public License as published by the Free
+;; Software Foundation, either version 3 of the License, or (at your option) any
+;; later versqion.
+
+;; eris-cl is distributed in the hope that it will be useful, but WITHOUT ANY
+;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+;; A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License along with
+;; eris-cl. If not, see <https://www.gnu.org/licenses/>.
+
+
+(in-package :eris/test)
+
+(def-suite* decoding-tests :in eris-tests)
+
+(defvar *table* nil)
+(defvar *stream* nil)
+
+(defun hashtable-encode (block ref)
+  (setf (gethash ref *table*) block))
+
+(defun hashtable-decode (ref)
+  (copy-seq (gethash ref *table*)))
+
+(defmacro assert-array-decode (array block-size)
+  `(let* ((*table* (make-hash-table :test #'equalp))
+          (array ,array)
+          (read-capability (eris-encode array ,block-size #'hashtable-encode))
+          (decoded-array (make-array (length array) :element-type '(unsigned-byte 8)))
+          (stream (eris-decode read-capability #'hashtable-decode)))
+     (stream-read-sequence stream decoded-array)
+     (is (equalp decoded-array array))
+     (file-position stream 0)
+     (is (equalp array
+                 (alexandria:read-stream-content-into-byte-vector stream)))))
+
+(defmacro assert-bytes-read (array block-size bytes-read-list)
+  `(let* ((*table* (make-hash-table :test #'equalp))
+          (array ,array)
+          (read-capability (eris-encode array ,block-size #'hashtable-encode))
+          
+          (decoded-array (make-array (length array) :element-type '(unsigned-byte 8)))
+          (stream (eris-decode read-capability #'hashtable-decode)))
+     (is (equalp
+          ',bytes-read-list
+          (loop with buf = (make-array 1024 :element-type '(unsigned-byte 8))
+                with s = (length buf)
+                for i = 0 then (incf i)
+                for bytes = (read-sequence buf stream)
+                collect bytes
+                if (< bytes s)
+                  do (if (zerop bytes)
+                         (loop-finish)
+                         (progn (replace decoded-array buf :start1 (* i s) :end1 (length decoded-array))
+                                (loop-finish)))
+                else
+                  do (replace decoded-array buf :start1 (* i s)))))))
+
+(defmacro assert-bytes-read-4096 (array block-size bytes-read-list)
+  `(let* ((*table* (make-hash-table :test #'equalp))
+          (array ,array)
+          (read-capability (eris-encode array ,block-size #'hashtable-encode))
+          
+          (decoded-array (make-array (length array) :element-type '(unsigned-byte 8)))
+          (stream (eris-decode read-capability #'hashtable-decode)))
+     (is (equalp
+          ',bytes-read-list
+          (loop with buf = (make-array 4096 :element-type '(unsigned-byte 8))
+                with s = (length buf)
+                for i = 0 then (incf i)
+                for bytes = (read-sequence buf stream)
+                collect bytes
+                if (< bytes s)
+                  do (if (zerop bytes)
+                         (loop-finish)
+                         (progn (replace decoded-array buf :start1 (* i s) :end1 (length decoded-array))
+                                (loop-finish)))
+                else
+                  do (replace decoded-array buf :start1 (* i s)))))))
+
+(assert-bytes-read-4096 (make-octets 16383 :element 1) 1024 (4096 4096 4096 4095))
+
+(test simple-decoding-1kib
+  (assert-array-decode (make-octets 1 :element 1) 1024)
+  (assert-array-decode (make-octets 1023 :element 2) 1024)
+  (assert-array-decode (make-octets 1024 :element 3) 1024)
+  (assert-array-decode (make-octets 1025 :element 4) 1024)
+  (assert-array-decode (make-octets 2049 :element 5) 1024)
+  (assert-array-decode (make-octets 4097 :element 5) 1024)
+  (assert-array-decode (make-octets 16383 :element 6) 1024)
+  (assert-array-decode (make-octets 16384 :element 7) 1024)
+  (assert-array-decode (make-octets 16385 :element 8) 1024)
+  (assert-array-decode (make-octets 32767 :element 9) 1024)
+  (assert-array-decode (make-octets 32768 :element 10) 1024)
+  (assert-array-decode (make-octets 131072 :element 11) 1024))
+
+(test simple-decoding-32kib
+  (assert-array-decode (make-octets 1 :element 2) 32kib)
+  (assert-array-decode (make-octets 32767 :element 2) 32kib)
+  (assert-array-decode (make-octets 32768 :element 2) 32kib)
+  (assert-array-decode (make-octets 32769 :element 2) 32kib)
+  (assert-array-decode (make-octets 32768 :element 2) 32kib)
+  (assert-array-decode (make-octets 16777216 :element 2) 32kib))
+
+(test proper-return-values
+  (assert-bytes-read (make-octets 1 :element 3) 1024 (1))
+  (assert-bytes-read (make-octets 1025 :element 3) 1024 (1024 1))
+  (assert-bytes-read (make-octets 16381 :element 3) 1024 (1024 1024 1024 1024 1024
+                                                               1024 1024 1024 1024
+                                                               1024 1024 1024 1024
+                                                               1024 1024 1021))
+  (assert-bytes-read (make-octets 16383 :element 3) 1024 (1024 1024 1024 1024 1024
+                                                               1024 1024 1024 1024
+                                                               1024 1024 1024 1024
+                                                               1024 1024 1023)))
+
+;; random access tests 
+(defmacro assert-random-access (array block-size buffer-pos pos array-at-pos)
+  `(let* ((*table* (make-hash-table :test #'equalp))
+          (array ,array)
+          (read-capability (eris-encode array ,block-size #'hashtable-encode))
+          (buf (make-array 24 :element-type '(unsigned-byte 8)))
+          (stream (eris-decode read-capability #'hashtable-decode)))
+     (stream-file-position stream ,pos)
+     (stream-read-sequence stream buf)
+     ;; (print (pos (buffer stream)))
+     ;; (print (+ 24 ,buffer-pos))
+     ;; (print (pos stream))
+     ;; (print (+ 24 ,pos))
+     ;; (print buf)
+     ;; (print ,array-at-pos)
+     (is (and
+          (eql (eris::pos (eris::buffer stream))
+               (+ 24 ,buffer-pos))
+          (eql (file-position stream)
+               (+ 24 ,pos))
+          (equalp buf
+                  ,array-at-pos)))))
+
+(defmacro assert-random-access-condition (array block-size pos condition)
+  `(let* ((*table* (make-hash-table :test #'equalp))
+          (array ,array)
+          (read-capability (eris-encode array ,block-size #'hashtable-encode))
+          (stream (eris-decode read-capability #'hashtable-decode)))
+     (signals ,condition
+      (stream-file-position stream ,pos))))
+
+(test random-access-eof-1kib
+  (assert-random-access-condition (make-octets 512 :element 1) 1024 512 eof)
+  (assert-random-access-condition (make-octets 512 :element 1) 1024 513 eof)
+  (assert-random-access-condition (make-octets 512 :element 1) 1024 1025 eof)
+  (assert-random-access-condition (make-octets 512 :element 1) 1024 2047 eof)
+  (assert-random-access-condition (make-octets 512 :element 1) 1024 2048 eof)
+  (assert-random-access-condition (make-octets 1024 :element 1) 1024 1024 eof)
+  (assert-random-access-condition (make-octets 1024 :element 1) 1024 1512 eof)
+  (assert-random-access-condition (make-octets 1024 :element 1) 1024 2048 eof)
+  (assert-random-access-condition (make-octets 1024 :element 1) 1024 200000 eof))
+
+(test random-access-eof-32kib
+  (assert-random-access-condition (make-octets 10000 :element 1) 32kib 10000 eof)
+  (assert-random-access-condition (make-octets 10000 :element 1) 32kib 10001 eof)
+  (assert-random-access-condition (make-octets 10000 :element 1) 32kib (* 1024 128) eof)
+  (assert-random-access-condition (make-octets 40000 :element 1) 32kib (* 1024 128) eof))
+
+(test random-access-1kib
+  (assert-random-access (make-octet-array-with-loop (loop for i from 0 to 1022 collect (mod i 256)))
+                        1024 0 0
+                        (make-octet-array-with-loop (loop for i from 0 to 23 collect i)))
+
+  (assert-random-access (make-octet-array-with-loop (loop for i from 0 to 1022 collect (mod i 256)))
+                        1024 513 513
+                        (make-octet-array-with-loop (loop for i from 1 to 24 collect i)))
+
+
+  (assert-random-access (make-octet-array-with-loop (loop for i from 0 to 2048 collect (mod i 256)))
+                        1024 513 513
+                        (make-octet-array-with-loop (loop for i from 1 to 24 collect i)))
+
+  (assert-random-access (make-octet-array-with-loop (loop for i from 0 to 2048 collect (mod i 256)))
+                        1024 24 1048
+                       (make-octet-array-with-loop (loop for i from 24 to 47 collect i))))
+
+(defmacro assert-length (array block-size)
+  `(let* ((*table* (make-hash-table :test #'equalp))
+          (array ,array)
+          (read-capability (eris-encode array ,block-size #'hashtable-encode))
+          (decoded-array (make-array (length array) :element-type '(unsigned-byte 8)))
+          (stream (eris-decode read-capability #'hashtable-decode)))
+     (stream-read-sequence stream decoded-array)
+     (is (equalp (length array)
+                 (eof stream)))))
+
+(test check-eof-length
+  (assert-length (make-array 512 :element-type '(unsigned-byte 8) :initial-element 2) 1024)
+  (assert-length (make-array 1023 :element-type '(unsigned-byte 8) :initial-element 2) 1024)
+  (assert-length (make-array 1024 :element-type '(unsigned-byte 8) :initial-element 2) 1024)
+  (assert-length (make-array 2048 :element-type '(unsigned-byte 8) :initial-element 2) 1024)
+  (assert-length (make-array 16383 :element-type '(unsigned-byte 8) :initial-element 2) 1024)
+  (assert-length (make-array 16384 :element-type '(unsigned-byte 8) :initial-element 2) 1024))
+
+