source: project/release/5/box/trunk/tests/box-test.scm @ 38529

Last change on this file since 38529 was 38529, checked in by Kon Lovett, 15 months ago

*-test runner, fix strict-types exposed test variable type rebinding, cannot use type predicates as "trait" predicates

File size: 1.8 KB
Line 
1;;;; box-test.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3
4(import test)
5
6(test-begin "Box")
7
8(import box)
9
10;;;
11
12;;
13
14(test-group "Box Mutable"
15        (let ((tbox (make-box (void))))
16    (test-assert (box? tbox))
17    (box-set! tbox #t)
18    (test-assert (box-ref tbox))
19    (test-assert (not (box? 3))) )
20)
21
22(test-group "Box Immutable"
23        (let ((tbox (make-box #f #t)))
24    (test-assert (box? tbox))
25    (test-assert (not (box-ref tbox)))
26    (test-error (box-set! tbox #t)) )
27)
28
29(import (only (chicken memory representation) procedure-data))
30
31(test-group "Box References"
32        (let* ((var (void))
33               (tbox (make-box-variable var)))
34    (test-assert (box? tbox))
35    (test-assert (box-variable? tbox))
36    (test-assert (not (box-location? tbox)))
37    (test "Unbound Box" (void) (box-ref tbox))
38    (set! (box-ref tbox) #t)
39    (test-assert "Bound Box" (box-ref tbox))
40    (test-assert "Bound Var" var)
41    (test-assert (not (box? 3))) )
42)
43
44(test-group "Box Swap"
45        (let ((tbox (make-box 0)))
46    (test-assert (box? tbox))
47    (test 1 (box-swap! tbox + 1))
48    (test 1 (box-ref tbox))
49    (test 2 (box-swap! tbox add1))
50    (test 2 (box-ref tbox)) )
51)
52
53;;;
54
55(test-begin "SRFI-111")
56
57(import (only (chicken platform) features))
58
59(test-group "Feature"
60  (test-assert "SRFI 111"
61    (let loop ((rem (features)))
62      (cond
63        ((null? rem)
64          #f )
65        ((eq? #:srfi-111 (car rem))
66          #t )
67        (else
68          (loop (cdr rem)) ) ) ) )
69)
70
71(test-group "Box"
72        (let ((tbox (box (void))))
73    (test-assert (box? tbox))
74    (box-set! tbox #t)
75    (test-assert (unbox tbox))
76    (test-assert (not (box? 3))) )
77)
78
79(test-group "Immutable-Box"
80        (let ((tbox (immutable-box #f)))
81    (test-assert (box? tbox))
82    (test-assert (not (unbox tbox)))
83    (test-error (box-set! tbox #t)) )
84)
85
86(test-end "SRFI-111")
87
88;;;
89
90(test-end "Box")
91
92(test-exit)
Note: See TracBrowser for help on using the repository browser.