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

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

*-test runner, style, remove primitive-inlines, separate srfi-111 module, added make-box-mutable & make-box-immutable, no strict-types since has box "generic"

File size: 2.0 KB
Line 
1;;;; box-test.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3
4(import test)
5
6(test-begin "Box")
7
8;;;
9
10(import box)
11(import (chicken base))
12(import (only (chicken port) with-output-to-string))
13
14;;
15
16(test-group "Box Mutable"
17        (let ((tbox (make-box (void))))
18    (test-assert (box? tbox))
19    (test "#&#<unspecified>" (with-output-to-string (cut display tbox)))
20    (box-set! tbox #t)
21    (test-assert (box-ref tbox))
22    (test-assert (not (box? 3))) )
23)
24
25(test-group "Box Immutable"
26        (let ((tbox (make-box #f #t)))
27    (test-assert (box? tbox))
28    (test "#&#f" (with-output-to-string (cut display tbox)))
29    (test-assert (not (box-ref tbox)))
30    (test-error (box-set! tbox #t)) )
31)
32
33(import (only (chicken memory representation) procedure-data))
34
35(test-group "Box References"
36        (let* ((var (void))
37               (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 (make-box 0)))
50    (test-assert (box? tbox))
51    (test 1 (box-swap! tbox + 1))
52    (test 1 (box-ref tbox))
53    (test 2 (box-swap! tbox add1))
54    (test 2 (box-ref tbox)) )
55)
56
57;;;
58
59(test-begin "SRFI-111")
60
61(import (only (chicken platform) features))
62(import (srfi 111))
63
64(test-group "Feature"
65  (test-assert "SRFI 111"
66    (let loop ((rem (features)))
67      (cond
68        ((null? rem)
69          #f )
70        ((eq? #:srfi-111 (car rem))
71          #t )
72        (else
73          (loop (cdr rem)) ) ) ) )
74)
75
76(test-group "Box"
77        (let ((tbox (box (void))))
78    (test-assert (box? tbox))
79    (box-set! tbox #t)
80    (test-assert (unbox tbox))
81    (test-assert (not (box? 3))) )
82)
83
84(test-group "Immutable Box"
85        (let ((tbox (immutable-box #f)))
86    (test-assert (box? tbox))
87    (test-assert (not (unbox tbox)))
88    (test-error (box-set! tbox #t)) )
89)
90
91(test-end "SRFI-111")
92
93;;;
94
95(test-end "Box")
96
97(test-exit)
Note: See TracBrowser for help on using the repository browser.