path: root/tests/test-bstruct.scm

;;; 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 (* 0)))
      (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>))))
    (let ((bv (f32vector 42 69)))
      (test-equal (bytevector->pointer bv 4)
        (bstruct->pointer <vec2> (bstruct-wrap <vec2> bv 0) y))))

  (test-group "pointer->bstruct"
    (test-equal 69.0
      (let ((v (bstruct-alloc <vec2> (x 42) (y 69))))
        (bstruct-ref <vec2>
                     (pointer->bstruct <vec2>
                                       (bstruct->pointer <vec2> v))
                     y))))

  (test-group "bstruct-wrap"
    (test-equal 69.0
      (bstruct-ref <vec2> (bstruct-wrap <vec2> (f32vector 13 42 69) 4) y)))

  (test-group "bstruct-unwrap"
    (test-equal '(#vu8(0 0 40 66 0 0 138 66) 0 1)
      (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> (bstruct-alloc <vec2> (x 42) (y 69)) y))
    (test-equal 42.0
      (bstruct-ref <vertex> (bstruct-alloc <vertex> ((uv x) 42)) (uv x)))
    (test-equal 4.0
      (let ((bv (f32vector 1 2 3 4)))
        (bstruct-ref <floats>
                     (bstruct-alloc <floats>
                                    (items (bytevector->pointer bv)))
                     (items (* 3)))))
    (test-equal %null-pointer
      (bstruct-ref <node> (bstruct-alloc <node>) next)))

  (test-group "bstruct-set!"
    (test-equal 42.0
      (let ((v (bstruct-alloc <vec2>)))
        (bstruct-set! <vec2> v (y 42))
        (bstruct-ref <vec2> v y)))
    (test-equal 42.0
      (let ((a (bstruct-alloc <matrix4>)))
        (bstruct-set! <matrix4> a (7 42))
        (bstruct-ref <matrix4> a 7)))
    (test-equal 42.0
      (let* ((bv (f32vector 0 0 0 0))
             (f (bstruct-alloc <floats>)))
        (bstruct-set! <floats> f (items (bytevector->pointer bv)))
        (bstruct-set! <floats> f ((items (* 3)) 42))
        (bstruct-ref <floats> f (items (* 3)))))
    (test-equal 42
      (let ((e (bstruct-alloc <event>)))
        (bstruct-set! <event> e ((mouse-move y) 42))
        (bstruct-ref <event> e (mouse-move y))))
    (test-equal 69
      (let* ((a (bstruct-alloc <node> (item 42)))
             (b (bstruct-alloc <node> (item 69))))
        (bstruct-set! <node> a (next (bstruct->pointer <node> b)))
        (bstruct-ref <node> a (next * item)))))

  (test-group "bstruct-pack!"
    (test-equal (f32vector 42 69)
      (let ((bv (f32vector 0 0)))
        (bstruct-pack! <vec2> bv 0 (x 42) (y 69))
        bv))
    (test-equal (f32vector 1 2 3 4)
      (let ((bv (f32vector 0 0 0 0)))
        (bstruct-pack! <vertex> bv 0
                       (xy (bstruct-alloc <vec2> (x 1) (y 2)))
                       ((uv x) 3)
                       ((uv y) 4))
        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> bv 0 (0 1) (5 1) (10 1) (15 1))
        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> bv 0
                       ((mouse-button type) 1)
                       ((mouse-button button) 2)
                       ((mouse-button state) 0)
                       ((mouse-button x) 3)
                       ((mouse-button y) 4))
        bv)))

  (test-group "bstruct-unpack"
    (test-equal '(42.0 69.0)
      (let ((bv (f32vector 42 69)))
        (call-with-values (lambda () (bstruct-unpack <vec2> bv 0 x y))
          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> bv 0
                                            (xy x) (xy y)
                                            (uv x) (uv y)))
          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> bv 0 0 5 10 15))
          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> bv 0
                                            (mouse-button type)
                                            (mouse-button button)
                                            (mouse-button state)
                                            (mouse-button x)
                                            (mouse-button y)))
          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> v* x)
              (bstruct-ref <vec2> v* y)))))

  (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> v* x)
              (bstruct-ref <vec2> v* y))))))