Fix a bug and write a test for the :include option.

Author: j3pic

simple-bit-stream.lisp

@@ -57,7 +57,10 @@ can be discarded if BYTE-ALIGNED-P returns T."))
     (cond
       ((= (slot-value stream 'bits-left) 0)
        (setf (slot-value stream 'last-byte)
-	     (read-byte (slot-value stream 'real-stream)))
+	     (restart-case (read-byte (slot-value stream 'real-stream))
+	       (continue ()
+		 :report "Pretend the read returned a 0 byte."
+		 0)))
        (setf (slot-value stream 'bits-left)
 	     (slot-value stream 'element-bits))
        (read-partial-byte/big-endian bits stream))
@@ -80,7 +83,10 @@ can be discarded if BYTE-ALIGNED-P returns T."))
     (cond
       ((= (slot-value stream 'bits-left) 0)
        (setf (slot-value stream 'last-byte)
-	     (read-byte (slot-value stream 'real-stream)))
+	     (restart-case (read-byte (slot-value stream 'real-stream))
+	       (continue ()
+		 :report "Pretend the read returned a 0 byte."
+		 0)))
        (setf (slot-value stream 'bits-left)
 	     (slot-value stream 'element-bits))
        (read-partial-byte/little-endian bits stream))

test/basic-test.lisp

@@ -25,6 +25,14 @@
 	 (or (= ,x* ,y*)
 	     (error "~S != ~S" ,x* ,y*)))))    
 
+  (defmacro assert-eq (x y)
+    (let ((x* (gensym "X"))
+	  (y* (gensym "Y")))
+      `(let ((,x* ,x)
+	     (,y* ,y))
+	 (or (eq ,x* ,y*)
+	     (error "~S is not EQ to ~S" ,x* ,y*)))))
+  
   (defmacro assert-equal (x y)
     (let ((x* (gensym "X"))
 	  (y* (gensym "Y")))
@@ -319,6 +327,38 @@
 					   (read-binary 'implicit-bit-stream
 							*standard-input*)))))))
 
+
+(defbinary example (:untyped-struct t)
+  (a 0 :type (unsigned-byte 24))
+  (b 0 :type (magic :actual-type (unsigned-byte 4)
+		    :value 5))
+  (c 0 :type (unsigned-byte 20)))
+
+
+(unit-test 'untyped-struct-test
+    (flexi-streams:with-input-from-sequence (in '(0 0 0))
+      (handler-bind
+	  (((or end-of-file bad-magic-value)
+	    (lambda (cond)
+	      (declare (ignore cond))
+	      (invoke-restart 'continue))))
+	(let ((obj (read-binary 'example in)))
+	  (assert= (slot-value obj 'a) 0)
+	  (assert= (slot-value obj 'b) 0)
+	  (assert= (slot-value obj 'c) 0)))))
+
+(defbinary example-2 (:include example)
+  (d 0 :type (unsigned-byte 8)))
+
+(unit-test 'include-test
+    (let ((obj (make-example-2 :a #xbedead
+			       :b 4
+			       :c #xbefed
+			       :d #xff)))
+    (test-round-trip ":INCLUDE test"
+	(write-binary obj *standard-output*)
+	(assert-equalp obj (read-binary 'example-2 *standard-input*)))))	     
+
 (defun run-test ()
   (let ((test-results (do-tests)))
     (format t ">>>>>>>>>>>>>>>>>>>>>>>> TEST RESULTS: ~S~%" test-results)