/[clazy]/clazy/clazy-test.lisp
ViewVC logotype

Contents of /clazy/clazy-test.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Fri Dec 17 13:13:35 2010 UTC (3 years, 3 months ago) by mantoniotti
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +25 -8 lines
Test suite expanded and fixed.
1 ;;;; -*- Mode: Lisp -*-
2
3 ;;;; clazy-test.lisp --
4
5 (use-package "UTIL.TEST")
6 (use-package "CLAZY")
7
8 (deflazy lazy-if (test then else) (if test then else))
9
10 (defun integers-starting-from (n)
11 (lazy:call 'cons n (integers-starting-from (1+ n))))
12
13 (defparameter naturals (integers-starting-from 0))
14
15 (let ((lazy::*warn-if-non-lazy-call-p* t))
16
17 (with-tests (:name "strict calls")
18 (test 42
19 (lazy-if t 42 -42))
20 (test -42
21 (lazy-if nil 42 -42))
22 )
23
24 (with-tests (:name "lazy indicator")
25 (test-error (lazy 'lazy-if)
26 :condition-type 'invalid-lazy-argument
27 :catch-breaks t)
28 (test-no-error (lazy lazy-if)
29 :catch-breaks t)
30 (test-no-error (lazy #'lazy-if)
31 :catch-breaks t)
32 (test-no-error (lazy (lambda (test then else) (if test then else)))
33 :catch-breaks t)
34 (test-no-error (lazy #'(lambda (test then else) (if test then else)))
35 :catch-breaks t)
36 (test-error (lazy '(lambda (test then else) (if test then else)))
37 :condition-type 'invalid-lazy-argument
38 :catch-breaks t)
39 )
40
41 (with-tests (:name "lazy turning strict")
42 (test 42
43 (lazy:call '+ 40 (+ 1 1)))
44 (test #(1 2 3)
45 (lazy:call 'vector 1 2 3)
46 :test #'equalp))
47
48 (with-tests (:name "lazy terminating calls")
49 (test 42
50 (lazy:call 'lazy-if t 42 -42))
51 (test -42
52 (lazy:call 'lazy-if nil 42 -42))
53 )
54
55 (with-tests (:name "lazy potentially non-terminating calls")
56 (test 42 (lazy:call 'lazy-if t 42 (loop))))
57
58
59 (with-tests (:name "lazy lambda")
60 (test 42 (lazy:call (lazy (lambda (test then else) (if test then else)))
61 t
62 42
63 -42))
64 (test 42 (lazy:call (lazy (lambda (test then else) (if test then else)))
65 t
66 42
67 (loop)))
68 )
69
70
71 (with-tests (:name "lambda list")
72 ;; &optional
73 (test 42 (lazy:call (lazy (lambda (x &optional y)
74 (+ x y)))
75 21 21))
76 (test 42 (lazy:call (lazy (lambda (x &optional (y 21))
77 (+ x y)))
78 21))
79
80 (test 42 (lazy:call (lazy (lambda (x &optional (y (+ 10 10 1)))
81 (+ x y)))
82 21))
83
84 (test 42 (lazy:call (lazy (lambda (x &optional (y (loop)))
85 (if x (+ x 21) y)))
86 21))
87
88 (test 42 (lazy:call (lazy (lambda (x &optional (y (loop)))
89 (if x (+ x 21) y)))
90 nil 42))
91
92 (test 42 (lazy:call (lazy (lambda (x &optional (y (loop) y-supplied-p))
93 (if y-supplied-p y (+ x 21))))
94 21))
95
96 (test 42 (lazy:call (lazy (lambda (x &optional (y (+ x 2)))
97 (+ x y)))
98 20))
99
100 ;; &key
101 (test 42 (lazy:call (lazy (lambda (x &key y)
102 (+ x y)))
103 21 :y 21))
104 (test 42 (lazy:call (lazy (lambda (x &key (y 21))
105 (+ x y)))
106 21))
107
108 (test 42 (lazy:call (lazy (lambda (x &key (y (+ 10 10 1)))
109 (+ x y)))
110 21))
111
112 (test 42 (lazy:call (lazy (lambda (x &key (y (loop)))
113 (if x (+ x 21) y)))
114 21))
115
116 (test 42 (lazy:call (lazy (lambda (x &key (y (loop)))
117 (if x (+ x 21) y)))
118 nil :y 42))
119
120 (test 42 (lazy:call (lazy (lambda (x &key (y (loop) y-supplied-p))
121 (if y-supplied-p y (+ x 21))))
122 21))
123
124 (test 42 (lazy:call (lazy (lambda (x &key ((:y yy)))
125 (+ x yy)))
126 21 :y 21))
127 (test 42 (lazy:call (lazy (lambda (x &key ((:y yy) 21))
128 (+ x yy)))
129 21))
130
131 (test 42 (lazy:call (lazy (lambda (x &key ((:y yy) (+ 10 10 1)))
132 (+ x yy)))
133 21))
134
135 (test 42 (lazy:call (lazy (lambda (x &key ((:y yy) (loop)))
136 (if x (+ x 21) yy)))
137 21))
138
139 (test 42 (lazy:call (lazy (lambda (x &key ((:y yy) (loop)))
140 (if x (+ x 21) yy)))
141 nil :y 42))
142
143 (test 42 (lazy:call (lazy (lambda (x &key ((:y yy) (loop) y-supplied-p))
144 (if y-supplied-p y (+ x 21))))
145 21))
146
147 )
148
149 (with-tests (:name "lazy data structures")
150 (test 42 (lazy:call 'car (lazy:call 'cons 42 '(1 2 3))))
151 (test '(1 2 3) (lazy:call 'cdr (lazy:call 'cons 42 '(1 2 3)))
152 :test #'equal)
153
154 (test 42 (lazy:call #'car (lazy:call 'cons 42 '(1 2 3))))
155 (test '(1 2 3) (lazy:call #'cdr (lazy:call 'cons 42 '(1 2 3)))
156 :test #'equal)
157
158
159 (test 0 (head naturals))
160 (test 4 (head (tail (tail (tail (tail naturals))))))
161 (test 1 (head (tail (lazy-seqs:take 10 naturals))))
162 )
163
164 ) ; let...
165
166 ;;;; end of file -- clazy-test.lisp --

  ViewVC Help
Powered by ViewVC 1.1.5