;;;; box-test.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18

(import test)

(test-begin "Box")

;;;

(import box)
(import (chicken base))
(import (only (chicken port) with-output-to-string))

;;

(test-group "Box Mutable"
	(let ((tbox (make-box (void))))
    (test-assert (box? tbox))
    (test "#&#<unspecified>" (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)) )
)

(import (only (chicken memory representation) procedure-data))

(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-begin "SRFI-111")

(import (only (chicken platform) features))
(import (srfi 111))

(test-group "Feature"
  (test-assert "SRFI 111"
    (let loop ((rem (features)))
      (cond
        ((null? rem)
          #f )
        ((eq? #:srfi-111 (car rem))
          #t )
        (else
          (loop (cdr rem)) ) ) ) )
)

(test-group "Box"
	(let ((tbox (box (void))))
    (test-assert (box? tbox))
    (box-set! tbox #t)
    (test-assert (unbox tbox))
    (test-assert (not (box? 3))) )
)

(test-group "Immutable Box"
	(let ((tbox (immutable-box #f)))
    (test-assert (box? tbox))
    (test-assert (not (unbox tbox)))
    (test-error (box-set! tbox #t)) )
)

(test-end "SRFI-111")

;;;

(test-end "Box")

(test-exit)