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

Last change on this file since 38415 was 38415, checked in by Kon Lovett, 16 months ago

update runner

File size: 2.1 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 #f))
16    (test-assert (make-box (void)))
17    (set! tbox (make-box (void)))
18    (test-assert (box? tbox))
19    (box-set! tbox #t)
20    (test-assert (box-ref tbox))
21    (test-assert (not (box? 3))) )
22)
23
24(test-group "Box Immutable"
25        (let ((tbox #f))
26    (test-assert (make-box #f #t))
27    (set! tbox (make-box #f #t))
28    (test-assert (box? tbox))
29    (test-assert (not (box-ref tbox)))
30    (test-error (box-set! tbox #t)) )
31)
32
33(test-group "Box References"
34        (let ((var (void))
35        (tbox #f))
36    (test-assert (make-box-variable var))
37    (set! tbox (make-box-variable var))
38    (test-assert (box? tbox))
39    (test-assert (box-variable? tbox))
40    (test-assert (not (box-location? tbox)))
41    (test "Unbound Box" (void) (box-ref tbox))
42    (set! (box-ref tbox) #t)
43    (test-assert "Bound Box" (box-ref tbox))
44    (test-assert "Bound Var" var)
45    (test-assert (not (box? 3))) )
46)
47
48(test-group "Box Swap"
49        (let ((tbox #f))
50    (test-assert (make-box (void)))
51    (set! tbox (make-box 0))
52    (test-assert (box? tbox))
53    (test 1 (box-swap! tbox + 1))
54    (test 1 (box-ref tbox))
55    (test 2 (box-swap! tbox add1))
56    (test 2 (box-ref tbox)) )
57)
58
59;;;
60
61(test-begin "SRFI-111")
62
63(import (only (chicken platform) features))
64
65(test-group "Feature"
66  (test-assert "SRFI 111"
67    (let loop ((rem (features)))
68      (cond
69        ((null? rem)
70          #f )
71        ((eq? #:srfi-111 (car rem))
72          #t )
73        (else
74          (loop (cdr rem)) ) ) ) )
75)
76
77(test-group "Box"
78        (let ((tbox #f))
79    (test-assert (box (void)))
80    (set! tbox (box (void)))
81    (test-assert (box? tbox))
82    (box-set! tbox #t)
83    (test-assert (unbox tbox))
84    (test-assert (not (box? 3))) )
85)
86
87(test-group "Immutable-Box"
88        (let ((tbox #f))
89    (test-assert (immutable-box #f))
90    (set! tbox (immutable-box #f))
91    (test-assert (box? tbox))
92    (test-assert (not (unbox tbox)))
93    (test-error (box-set! tbox #t)) )
94)
95
96(test-end "SRFI-111")
97
98;;;
99
100(test-end "Box")
101
102(test-exit)
Note: See TracBrowser for help on using the repository browser.