;;;; box-test.scm -*- Scheme -*- ;;;; Kon Lovett, Apr '20 ;;;; Kon Lovett, Jul '18 (import test) (test-begin "Box") ;;; (import box) (import (chicken base)) (import (only (chicken port) with-output-to-string)) (import (only (chicken memory representation) procedure-data)) ;should be there #; ;BUG incl file w/ dest override (include "box.types") ;; (test-group "Box Mutable" (let ((tbox (make-box (void)))) (test-assert (box? tbox)) (test "#&#" (with-output-to-string (cut display tbox))) (box-set! tbox #t) (test-assert (box-ref tbox)) (test-assert (not (box? 3))) ) ) (test-group "Box Immutable" (let ((tbox (make-box #f #t))) (test-assert (box? tbox)) (test "#&#f" (with-output-to-string (cut display tbox))) (test-assert (not (box-ref tbox))) (test-error (box-set! tbox #t)) ) ) (test-group "Box References" (let* ((var (void)) (tbox (make-box-variable var))) (test-assert (box? tbox)) (test-assert (box-variable? tbox)) (test-assert (not (box-location? tbox))) (test "Unbound Box" (void) (box-ref tbox)) (set! (box-ref tbox) #t) (test-assert "Bound Box" (box-ref tbox)) (test-assert "Bound Var" var) (test-assert (not (box? 3))) ) ) (test-group "Box Swap" (let ((tbox (make-box 0))) (test-assert (box? tbox)) (test 1 (box-swap! tbox + 1)) (test 1 (box-ref tbox)) (test 2 (box-swap! tbox add1)) (test 2 (box-ref tbox)) ) ) ;;; (test-end "Box") (test-exit)