Add bytestruct module.

1 files changed, 276 insertions, 0 deletions

diff --git a/tests/bytestruct.scm b/tests/bytestruct.scm
new file mode 100644
index 0000000..093acdb
--- /dev/null
+++ b/tests/bytestruct.scm
@@ -0,0 +1,276 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2024 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;    http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-module (tests bytestruct)
+  #:use-module (chickadee data bytestruct)
+  #:use-module (srfi srfi-64)
+  #:use-module (system foreign)
+  #:use-module (tests utils))
+
+;; For testing basic structs.
+(define-bytestruct <vec2>
+  (struct (x f32) (y f32)))
+
+(define-bytestruct <vertex>
+  (struct (xy <vec2>) (uv <vec2>)))
+
+;; For testing arrays.
+(define-bytestruct <matrix4>
+  (array 16 f32))
+
+;; For testing variable length arrays.
+(define-bytestruct <floats>
+  (struct (items (* f32))))
+
+;; For testing unions.
+(define-bytestruct <mouse-move-event>
+  (struct (type u8) (x s32) (y s32)))
+
+(define-bytestruct <mouse-button-event>
+  (struct (type u8) (button u8) (state u8) (x s32) (y s32)))
+
+(define-bytestruct <event>
+  (union (type u8)
+         (mouse-move <mouse-move-event>)
+         (mouse-button <mouse-button-event>)))
+
+;; For testing recursive types.
+(define-bytestruct <node>
+  (struct (item int) (next (* <node>))))
+
+(with-tests "bytestruct"
+  (test-group "bytestruct?"
+    (test-assert (bytestruct? (bytestruct-alloc <vec2>)))
+    (test-assert (not (bytestruct? 'vec2)))
+    (test-assert (bytestruct? <vec2> (bytestruct-alloc <vec2>)))
+    (test-assert (not (bytestruct? <vec2> (bytestruct-alloc <vertex>)))))
+
+  (test-group "bytestruct=?"
+    (test-assert (bytestruct=? <vec2>
+                               (bytestruct-alloc <vec2> ((x) 42) ((y) 69))
+                               (bytestruct-alloc <vec2> ((x) 42) ((y) 69))))
+    (test-assert (not (bytestruct=? <vec2>
+                                    (bytestruct-alloc <vec2> ((x) 42) ((y) 69))
+                                    (bytestruct-alloc <vec2> ((x) 77) ((y) 89))))))
+
+  (test-group "bytestruct->sexp"
+    (test-equal '(struct (x 42.0) (y 69.0))
+      (bytestruct->sexp (bytestruct-alloc <vec2> ((x) 42) ((y) 69))))
+    (test-equal '(struct (xy (struct (x 42.0) (y 69.0)))
+                         (uv (struct (x 77.0) (y 89.0))))
+      (bytestruct->sexp (bytestruct-alloc <vertex>
+                                          ((xy x) 42) ((xy y) 69)
+                                          ((uv x) 77) ((uv y) 89))))
+    (test-equal '(union
+                  (type 1)
+                  (mouse-move (struct
+                               (type 1)
+                               (x 0)
+                               (y 0)))
+                  (mouse-button (struct
+                                 (type 1)
+                                 (button 0)
+                                 (state 0)
+                                 (x 0)
+                                 (y 0))))
+      (bytestruct->sexp (bytestruct-alloc <event> ((type) 1))))
+    (test-equal '(struct (item 42) (next null))
+      (bytestruct->sexp (bytestruct-alloc <node> ((item) 42)))))
+
+  (test-group "bytestruct->pointer"
+    (test-equal #vu8(0 0 40 66 0 0 138 66)
+                (let ((v (bytestruct-alloc <vec2> ((x) 42) ((y) 69))))
+                  (pointer->bytevector (bytestruct->pointer <vec2> v)
+                                       (bytestruct-sizeof <vec2>)))))
+
+  (test-group "pointer->bytestruct"
+    (test-equal 69.0
+      (let ((v (bytestruct-alloc <vec2> ((x) 42) ((y) 69))))
+        (bytestruct-ref <vec2> (y)
+                        (pointer->bytestruct <vec2>
+                                             (bytestruct->pointer <vec2> v))))))
+
+  (test-group "bytestruct-wrap"
+    (test-equal 69.0
+      (bytestruct-ref <vec2> (y) (bytestruct-wrap <vec2> (f32vector 13 42 69) 4))))
+
+  (test-group "bytestruct-unwrap"
+    (test-equal '(#vu8(0 0 40 66 0 0 138 66) 0)
+      (call-with-values (lambda ()
+                          (bytestruct-unwrap <vec2>
+                                             (bytestruct-alloc <vec2>
+                                                               ((x) 42)
+                                                               ((y) 69))))
+        list)))
+
+  (test-group "bytestruct-alignof"
+    (test-equal (alignof (list float float))
+      (bytestruct-alignof <vec2>))
+    (test-equal (alignof (list (list float float) (list float float)))
+      (bytestruct-alignof <vertex>))
+    (test-equal (alignof (make-list 16 float))
+      (bytestruct-alignof <matrix4>))
+    (test-equal (alignof (list uint8 int32 int32))
+      (bytestruct-alignof <mouse-move-event>))
+    (test-equal (alignof (list uint8 uint8 uint8 int32 int32))
+      (bytestruct-alignof <mouse-button-event>))
+    (test-equal (max (alignof (list uint8))
+                     (alignof (list uint8 int32 int32))
+                     (alignof (list uint8 uint8 uint8 int32 int32)))
+      (bytestruct-alignof <event>)))
+
+  (test-group "bytestruct-sizeof"
+    (test-equal (sizeof (list float float))
+      (bytestruct-sizeof <vec2>))
+    (test-equal (sizeof (list (list float float) (list float float)))
+      (bytestruct-sizeof <vertex>))
+    (test-equal (sizeof (make-list 16 float))
+      (bytestruct-sizeof <matrix4>))
+    (test-equal (sizeof (list uint8 int32 int32))
+      (bytestruct-sizeof <mouse-move-event>))
+    (test-equal (sizeof (list uint8 uint8 uint8 int32 int32))
+      (bytestruct-sizeof <mouse-button-event>))
+    (test-equal (max (sizeof (list uint8))
+                     (sizeof (list uint8 int32 int32))
+                     (sizeof (list uint8 uint8 uint8 int32 int32)))
+      (bytestruct-sizeof <event>)))
+
+  (test-group "bytestruct-ref"
+    (test-equal 69.0
+      (bytestruct-ref <vec2> (y) (bytestruct-alloc <vec2> ((x) 42) ((y) 69))))
+    (test-equal 42.0
+      (bytestruct-ref <vertex> (uv x) (bytestruct-alloc <vertex> ((uv x) 42))))
+    (test-equal 4.0
+      (let ((bv (f32vector 1 2 3 4)))
+        (bytestruct-ref <floats> (items (* 3))
+                        (bytestruct-alloc <floats>
+                                          ((items) (bytevector->pointer bv))))))
+    (test-equal %null-pointer
+      (bytestruct-ref <node> (next) (bytestruct-alloc <node>))))
+
+  (test-group "bytestruct-&ref"
+    (let ((bv (f32vector 42 69)))
+      (test-equal (bytevector->pointer bv 4)
+        (bytestruct-&ref <vec2> (y) (bytestruct-wrap <vec2> bv 0)))))
+
+  (test-group "bytestruct-set!"
+    (test-equal 42.0
+      (let ((v (bytestruct-alloc <vec2>)))
+        (bytestruct-set! <vec2> (y) v 42)
+        (bytestruct-ref <vec2> (y) v)))
+    (test-equal 42.0
+      (let ((a (bytestruct-alloc <matrix4>)))
+        (bytestruct-set! <matrix4> (7) a 42)
+        (bytestruct-ref <matrix4> (7) a)))
+    (test-equal 42.0
+      (let* ((bv (f32vector 0 0 0 0))
+             (f (bytestruct-alloc <floats>)))
+        (bytestruct-set! <floats> (items) f (bytevector->pointer bv))
+        (bytestruct-set! <floats> (items (* 3)) f 42)
+        (bytestruct-ref <floats> (items (* 3)) f)))
+    (test-equal 42
+      (let ((e (bytestruct-alloc <event>)))
+        (bytestruct-set! <event> (mouse-move y) e 42)
+        (bytestruct-ref <event> (mouse-move y) e)))
+    (test-equal 69
+      (let* ((a (bytestruct-alloc <node> ((item) 42)))
+             (b (bytestruct-alloc <node> ((item) 69))))
+        (bytestruct-set! <node> (next) a (bytestruct->pointer <node> b))
+        (bytestruct-ref <node> (next * item) a))))
+
+  (test-group "bytestruct-pack!"
+    (test-equal (f32vector 42 69)
+      (let ((bv (f32vector 0 0)))
+        (bytestruct-pack! <vec2> (((x) 42) ((y) 69)) bv 0)
+        bv))
+    (test-equal (f32vector 1 2 3 4)
+      (let ((bv (f32vector 0 0 0 0)))
+        (bytestruct-pack! <vertex>
+                          (((xy) (bytestruct-alloc <vec2> ((x) 1) ((y) 2)))
+                           ((uv x) 3)
+                           ((uv y) 4))
+                          bv 0)
+        bv))
+    (test-equal (f32vector 1 0 0 0
+                           0 1 0 0
+                           0 0 1 0
+                           0 0 0 1)
+      (let ((bv (f32vector 0 0 0 0
+                           0 0 0 0
+                           0 0 0 0
+                           0 0 0 0)))
+        (bytestruct-pack! <matrix4>
+                          (((0) 1) ((5) 1) ((10) 1) ((15) 1))
+                          bv 0)
+        bv))
+    (test-equal (u8vector 1 2 0 0 3 0 0 0 4 0 0 0)
+      (let ((bv (make-u8vector (bytestruct-sizeof <event>) 0)))
+        (bytestruct-pack! <event>
+                          (((mouse-button type) 1)
+                           ((mouse-button button) 2)
+                           ((mouse-button state) 0)
+                           ((mouse-button x) 3)
+                           ((mouse-button y) 4))
+                          bv 0)
+        bv)))
+
+  (test-group "bytestruct-unpack"
+    (test-equal '(42.0 69.0)
+      (let ((bv (f32vector 42 69)))
+        (call-with-values (lambda () (bytestruct-unpack <vec2> ((x) (y)) bv 0))
+          list)))
+    (test-equal (list 1.0 2.0 3.0 4.0)
+      (let ((bv (f32vector 1 2 3 4)))
+        (call-with-values (lambda ()
+                            (bytestruct-unpack <vertex>
+                                               ((xy x) (xy y) (uv x) (uv y))
+                                               bv 0))
+          list)))
+    (test-equal '(1.0 1.0 1.0 1.0)
+      (let ((bv (f32vector 1 0 0 0
+                           0 1 0 0
+                           0 0 1 0
+                           0 0 0 1)))
+        (call-with-values (lambda ()
+                            (bytestruct-unpack <matrix4>
+                                               ((0) (5) (10) (15))
+                                               bv 0))
+          list)))
+    (test-equal '(1 2 0 3 4)
+      (let ((bv (u8vector 1 2 0 0 3 0 0 0 4 0 0 0)))
+        (call-with-values (lambda ()
+                            (bytestruct-unpack <event>
+                                               ((mouse-button type)
+                                                (mouse-button button)
+                                                (mouse-button state)
+                                                (mouse-button x)
+                                                (mouse-button y))
+                                               bv 0))
+          list))))
+
+  (test-group "bytestruct-copy"
+    (test-equal '(42.0 69.0)
+      (let* ((v (bytestruct-alloc <vec2> ((x) 42) ((y) 69)))
+             (v* (bytestruct-copy <vec2> v)))
+        (list (bytestruct-ref <vec2> (x) v*)
+              (bytestruct-ref <vec2> (y) v*)))))
+
+  (test-group "bytestruct-copy!"
+    (test-equal '(42.0 69.0)
+      (let* ((v (bytestruct-alloc <vec2> ((x) 42) ((y) 69)))
+             (v* (bytestruct-alloc <vec2>)))
+        (bytestruct-copy! <vec2> v v*)
+        (list (bytestruct-ref <vec2> (x) v*)
+              (bytestruct-ref <vec2> (y) v*))))))