diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/bytestruct.scm | 276 |
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*)))))) |