Line | |
---|
1 | ;;;; box-test.scm -*- Scheme -*- |
---|
2 | ;;;; Kon Lovett, Jul '18 |
---|
3 | |
---|
4 | (import test) |
---|
5 | |
---|
6 | (test-begin "SRFI-111") |
---|
7 | |
---|
8 | ;;; |
---|
9 | |
---|
10 | #; ;Test API, not module |
---|
11 | (import (srfi 111)) |
---|
12 | (import (only box box box? unbox set-box! immutable-box)) |
---|
13 | |
---|
14 | (import (chicken base)) |
---|
15 | (import (only (chicken platform) features)) |
---|
16 | |
---|
17 | (test-group "Feature" |
---|
18 | (test-assert "SRFI 111" |
---|
19 | (let loop ((rem (features))) |
---|
20 | (cond |
---|
21 | ((null? rem) |
---|
22 | #f ) |
---|
23 | ((eq? #:srfi-111 (car rem)) |
---|
24 | #t ) |
---|
25 | (else |
---|
26 | (loop (cdr rem)) ) ) ) ) |
---|
27 | ) |
---|
28 | |
---|
29 | (test-group "Box" |
---|
30 | (let ((tbox (box (void)))) |
---|
31 | (test-assert (box? tbox)) |
---|
32 | (set-box! tbox #t) |
---|
33 | (test-assert (unbox tbox)) |
---|
34 | (test-assert (not (box? 3))) ) |
---|
35 | ) |
---|
36 | |
---|
37 | (test-group "Immutable Box" |
---|
38 | (let ((tbox (immutable-box #f))) |
---|
39 | (test-assert (box? tbox)) |
---|
40 | (test-assert (not (unbox tbox))) |
---|
41 | (test-error (set-box! tbox #t)) ) |
---|
42 | ) |
---|
43 | |
---|
44 | (test-end "SRFI-111") |
---|
45 | |
---|
46 | ;;; |
---|
47 | |
---|
48 | (test-end "Box") |
---|
49 | |
---|
50 | (test-exit) |
---|
Note: See
TracBrowser
for help on using the repository browser.