summaryrefslogtreecommitdiff
path: root/tests/test-bstruct.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/test-bstruct.scm')
-rw-r--r--tests/test-bstruct.scm283
1 files changed, 283 insertions, 0 deletions
diff --git a/tests/test-bstruct.scm b/tests/test-bstruct.scm
new file mode 100644
index 0000000..1e303c0
--- /dev/null
+++ b/tests/test-bstruct.scm
@@ -0,0 +1,283 @@
+;;; guile-bstruct -- Binary structures for Guile
+;;; 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 test-bstruct)
+ #:use-module (bstruct)
+ #:use-module (srfi srfi-64)
+ #:use-module (system foreign)
+ #:use-module (tests utils))
+
+;; For testing basic structs.
+(define-bstruct <vec2>
+ (struct (x f32) (y f32)))
+
+(define-bstruct <vertex>
+ (struct (xy <vec2>) (uv <vec2>)))
+
+;; For testing arrays.
+(define-bstruct <matrix4>
+ (array 16 f32))
+
+;; For testing variable length arrays.
+(define-bstruct <floats>
+ (struct (items (* f32))))
+
+;; For testing unions.
+(define-bstruct <mouse-move-event>
+ (struct (type u8) (x s32) (y s32)))
+
+(define-bstruct <mouse-button-event>
+ (struct (type u8) (button u8) (state u8) (x s32) (y s32)))
+
+(define-bstruct <event>
+ (union (type u8)
+ (mouse-move <mouse-move-event>)
+ (mouse-button <mouse-button-event>)))
+
+;; For testing recursive types.
+(define-bstruct <node>
+ (struct (item int) (next (* <node>))))
+
+;; For testing proper sizing.
+(define-bstruct <right-sized>
+ (struct
+ (a u64)
+ (b u32)
+ (c u64)
+ (d u32)))
+
+(test-suite "bstruct"
+ (test-group "bstruct?"
+ (test-assert (bstruct? (bstruct-alloc <vec2>)))
+ (test-assert (not (bstruct? 'vec2)))
+ (test-assert (bstruct? <vec2> (bstruct-alloc <vec2>)))
+ (test-assert (not (bstruct? <vec2> (bstruct-alloc <vertex>)))))
+
+ (test-group "bstruct=?"
+ (test-assert (bstruct=? <vec2>
+ (bstruct-alloc <vec2> (x 42) (y 69))
+ (bstruct-alloc <vec2> (x 42) (y 69))))
+ (test-assert (not (bstruct=? <vec2>
+ (bstruct-alloc <vec2> (x 42) (y 69))
+ (bstruct-alloc <vec2> (x 77) (y 89))))))
+
+ (test-group "bstruct->sexp"
+ (test-equal '(struct (x 42.0) (y 69.0))
+ (bstruct->sexp (bstruct-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))))
+ (bstruct->sexp (bstruct-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))))
+ (bstruct->sexp (bstruct-alloc <event> (type 1))))
+ (test-equal '(struct (item 42) (next null))
+ (bstruct->sexp (bstruct-alloc <node> (item 42)))))
+
+ (test-group "bstruct->pointer"
+ (test-equal #vu8(0 0 40 66 0 0 138 66)
+ (let ((v (bstruct-alloc <vec2> (x 42) (y 69))))
+ (pointer->bytevector (bstruct->pointer <vec2> v)
+ (bstruct-sizeof <vec2>)))))
+
+ (test-group "pointer->bstruct"
+ (test-equal 69.0
+ (let ((v (bstruct-alloc <vec2> (x 42) (y 69))))
+ (bstruct-ref <vec2> y
+ (pointer->bstruct <vec2>
+ (bstruct->pointer <vec2> v))))))
+
+ (test-group "bstruct-wrap"
+ (test-equal 69.0
+ (bstruct-ref <vec2> y (bstruct-wrap <vec2> (f32vector 13 42 69) 4))))
+
+ (test-group "bstruct-unwrap"
+ (test-equal '(#vu8(0 0 40 66 0 0 138 66) 0)
+ (call-with-values
+ (lambda ()
+ (bstruct-unwrap <vec2>
+ (bstruct-alloc <vec2> (x 42) (y 69))))
+ list)))
+
+ (test-group "bstruct-alignof"
+ (test-equal (alignof (list float float))
+ (bstruct-alignof <vec2>))
+ (test-equal (alignof (list (list float float) (list float float)))
+ (bstruct-alignof <vertex>))
+ (test-equal (alignof (make-list 16 float))
+ (bstruct-alignof <matrix4>))
+ (test-equal (alignof (list uint8 int32 int32))
+ (bstruct-alignof <mouse-move-event>))
+ (test-equal (alignof (list uint8 uint8 uint8 int32 int32))
+ (bstruct-alignof <mouse-button-event>))
+ (test-equal (max (alignof (list uint8))
+ (alignof (list uint8 int32 int32))
+ (alignof (list uint8 uint8 uint8 int32 int32)))
+ (bstruct-alignof <event>)))
+
+ (test-group "bstruct-sizeof"
+ (test-equal (sizeof (list float float))
+ (bstruct-sizeof <vec2>))
+ (test-equal (sizeof (list (list float float) (list float float)))
+ (bstruct-sizeof <vertex>))
+ (test-equal (sizeof (make-list 16 float))
+ (bstruct-sizeof <matrix4>))
+ (test-equal (sizeof (list uint8 int32 int32))
+ (bstruct-sizeof <mouse-move-event>))
+ (test-equal (sizeof (list uint8 uint8 uint8 int32 int32))
+ (bstruct-sizeof <mouse-button-event>))
+ (test-equal (max (sizeof (list uint8))
+ (sizeof (list uint8 int32 int32))
+ (sizeof (list uint8 uint8 uint8 int32 int32)))
+ (bstruct-sizeof <event>))
+ (test-equal (sizeof (list uint64 uint32 uint64 uint32))
+ (bstruct-sizeof <right-sized>)))
+
+ (test-group "bstruct-ref"
+ (test-equal 69.0
+ (bstruct-ref <vec2> y (bstruct-alloc <vec2> (x 42) (y 69))))
+ (test-equal 42.0
+ (bstruct-ref <vertex> (uv x) (bstruct-alloc <vertex> ((uv x) 42))))
+ (test-equal 4.0
+ (let ((bv (f32vector 1 2 3 4)))
+ (bstruct-ref <floats> (items (* 3))
+ (bstruct-alloc <floats>
+ (items (bytevector->pointer bv))))))
+ (test-equal %null-pointer
+ (bstruct-ref <node> next (bstruct-alloc <node>))))
+
+ (test-group "bstruct-&ref"
+ (let ((bv (f32vector 42 69)))
+ (test-equal (bytevector->pointer bv 4)
+ (bstruct-&ref <vec2> y (bstruct-wrap <vec2> bv 0)))))
+
+ (test-group "bstruct-set!"
+ (test-equal 42.0
+ (let ((v (bstruct-alloc <vec2>)))
+ (bstruct-set! <vec2> y v 42)
+ (bstruct-ref <vec2> y v)))
+ (test-equal 42.0
+ (let ((a (bstruct-alloc <matrix4>)))
+ (bstruct-set! <matrix4> 7 a 42)
+ (bstruct-ref <matrix4> 7 a)))
+ (test-equal 42.0
+ (let* ((bv (f32vector 0 0 0 0))
+ (f (bstruct-alloc <floats>)))
+ (bstruct-set! <floats> items f (bytevector->pointer bv))
+ (bstruct-set! <floats> (items (* 3)) f 42)
+ (bstruct-ref <floats> (items (* 3)) f)))
+ (test-equal 42
+ (let ((e (bstruct-alloc <event>)))
+ (bstruct-set! <event> (mouse-move y) e 42)
+ (bstruct-ref <event> (mouse-move y) e)))
+ (test-equal 69
+ (let* ((a (bstruct-alloc <node> (item 42)))
+ (b (bstruct-alloc <node> (item 69))))
+ (bstruct-set! <node> next a (bstruct->pointer <node> b))
+ (bstruct-ref <node> (next * item) a))))
+
+ (test-group "bstruct-pack!"
+ (test-equal (f32vector 42 69)
+ (let ((bv (f32vector 0 0)))
+ (bstruct-pack! (<vec2> (x 42) (y 69)) bv 0)
+ bv))
+ (test-equal (f32vector 1 2 3 4)
+ (let ((bv (f32vector 0 0 0 0)))
+ (bstruct-pack! (<vertex>
+ (xy (bstruct-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)))
+ (bstruct-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 (bstruct-sizeof <event>) 0)))
+ (bstruct-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 "bstruct-unpack"
+ (test-equal '(42.0 69.0)
+ (let ((bv (f32vector 42 69)))
+ (call-with-values (lambda () (bstruct-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 ()
+ (bstruct-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 ()
+ (bstruct-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 ()
+ (bstruct-unpack (<event>
+ (mouse-button type)
+ (mouse-button button)
+ (mouse-button state)
+ (mouse-button x)
+ (mouse-button y))
+ bv 0))
+ list))))
+
+ (test-group "bstruct-copy"
+ (test-equal '(42.0 69.0)
+ (let* ((v (bstruct-alloc <vec2> (x 42) (y 69)))
+ (v* (bstruct-copy <vec2> v)))
+ (list (bstruct-ref <vec2> x v*)
+ (bstruct-ref <vec2> y v*)))))
+
+ (test-group "bstruct-copy!"
+ (test-equal '(42.0 69.0)
+ (let* ((v (bstruct-alloc <vec2> (x 42) (y 69)))
+ (v* (bstruct-alloc <vec2>)))
+ (bstruct-copy! <vec2> v v*)
+ (list (bstruct-ref <vec2> x v*)
+ (bstruct-ref <vec2> y v*))))))
generated by cgit v1.2.3 (git 2.25.4) at 2024-10-16 10:35:27 +0000