summaryrefslogtreecommitdiff
path: root/tests/utils.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-05-12 15:46:16 +0200
committerLudovic Courtès <ludo@gnu.org>2013-05-12 15:46:16 +0200
commitc0cd1b3ea7753fe2826f7a336019000df9dea96f (patch)
treea7e376f68216dcd26eab06aea5ff529b483fea00 /tests/utils.scm
parent9b1ef2f3232e7af111ba05353008ebd2f8955f02 (diff)
Move record utilities to (guix records).
* guix/utils.scm (define-record-type*): Move to... * guix/records.scm: ... here. New file. * guix/build-system.scm, guix/packages.scm: Use it. * guix/gnu-maintenance.scm: Likewise. (official-gnu-packages)[alist->record]: Remove. * guix/scripts/substitute-binary.scm: Likewise. (alist->record, object->fields): Remove. * tests/utils.scm ("define-record-type*", "define-record-type* with letrec* behavior", "define-record-type* & inherit", "define-record-type* & inherit & letrec* behavior", "define-record-type* & thunked", "define-record-type* & thunked & default", "define-record-type* & thunked & inherited"): Move to... * tests/records.scm: ... here. New file.
Diffstat (limited to 'tests/utils.scm')
-rw-r--r--tests/utils.scm108
1 files changed, 0 insertions, 108 deletions
diff --git a/tests/utils.scm b/tests/utils.scm
index f14412e61ea..c2fb2741930 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -126,114 +126,6 @@
126 (append pids1 pids2))) 126 (append pids1 pids2)))
127 (equal? (get-bytevector-all decompressed) data))))) 127 (equal? (get-bytevector-all decompressed) data)))))
128 128
129(test-assert "define-record-type*"
130 (begin
131 (define-record-type* <foo> foo make-foo
132 foo?
133 (bar foo-bar)
134 (baz foo-baz (default (+ 40 2))))
135 (and (match (foo (bar 1) (baz 2))
136 (($ <foo> 1 2) #t))
137 (match (foo (baz 2) (bar 1))
138 (($ <foo> 1 2) #t))
139 (match (foo (bar 1))
140 (($ <foo> 1 42) #t)))))
141
142(test-assert "define-record-type* with letrec* behavior"
143 ;; Make sure field initializers can refer to each other as if they were in
144 ;; a `letrec*'.
145 (begin
146 (define-record-type* <bar> bar make-bar
147 foo?
148 (x bar-x)
149 (y bar-y (default (+ 40 2)))
150 (z bar-z))
151 (and (match (bar (x 1) (y (+ x 1)) (z (* y 2)))
152 (($ <bar> 1 2 4) #t))
153 (match (bar (x 7) (z (* x 3)))
154 (($ <bar> 7 42 21)))
155 (match (bar (z 21) (x (/ z 3)))
156 (($ <bar> 7 42 21))))))
157
158(test-assert "define-record-type* & inherit"
159 (begin
160 (define-record-type* <foo> foo make-foo
161 foo?
162 (bar foo-bar)
163 (baz foo-baz (default (+ 40 2))))
164 (let* ((a (foo (bar 1)))
165 (b (foo (inherit a) (baz 2)))
166 (c (foo (inherit b) (bar -2)))
167 (d (foo (inherit c)))
168 (e (foo (inherit (foo (bar 42))) (baz 77))))
169 (and (match a (($ <foo> 1 42) #t))
170 (match b (($ <foo> 1 2) #t))
171 (match c (($ <foo> -2 2) #t))
172 (equal? c d)
173 (match e (($ <foo> 42 77) #t))))))
174
175(test-assert "define-record-type* & inherit & letrec* behavior"
176 (begin
177 (define-record-type* <foo> foo make-foo
178 foo?
179 (bar foo-bar)
180 (baz foo-baz (default (+ 40 2))))
181 (let* ((a (foo (bar 77)))
182 (b (foo (inherit a) (bar 1) (baz (+ bar 1))))
183 (c (foo (inherit b) (baz 2) (bar (- baz 1)))))
184 (and (match a (($ <foo> 77 42) #t))
185 (match b (($ <foo> 1 2) #t))
186 (equal? b c)))))
187
188(test-assert "define-record-type* & thunked"
189 (begin
190 (define-record-type* <foo> foo make-foo
191 foo?
192 (bar foo-bar)
193 (baz foo-baz (thunked)))
194
195 (let* ((calls 0)
196 (x (foo (bar 2)
197 (baz (begin (set! calls (1+ calls)) 3)))))
198 (and (zero? calls)
199 (equal? (foo-bar x) 2)
200 (equal? (foo-baz x) 3) (= 1 calls)
201 (equal? (foo-baz x) 3) (= 2 calls)))))
202
203(test-assert "define-record-type* & thunked & default"
204 (begin
205 (define-record-type* <foo> foo make-foo
206 foo?
207 (bar foo-bar)
208 (baz foo-baz (thunked) (default 42)))
209
210 (let ((mark (make-parameter #f)))
211 (let ((x (foo (bar 2) (baz (mark))))
212 (y (foo (bar 2))))
213 (and (equal? (foo-bar x) 2)
214 (parameterize ((mark (cons 'a 'b)))
215 (eq? (foo-baz x) (mark)))
216 (equal? (foo-bar y) 2)
217 (equal? (foo-baz y) 42))))))
218
219(test-assert "define-record-type* & thunked & inherited"
220 (begin
221 (define-record-type* <foo> foo make-foo
222 foo?
223 (bar foo-bar (thunked))
224 (baz foo-baz (thunked) (default 42)))
225
226 (let ((mark (make-parameter #f)))
227 (let* ((x (foo (bar 2) (baz (mark))))
228 (y (foo (inherit x) (bar (mark)))))
229 (and (equal? (foo-bar x) 2)
230 (parameterize ((mark (cons 'a 'b)))
231 (eq? (foo-baz x) (mark)))
232 (parameterize ((mark (cons 'a 'b)))
233 (eq? (foo-bar y) (mark)))
234 (parameterize ((mark (cons 'a 'b)))
235 (eq? (foo-baz y) (mark))))))))
236
237;; This is actually in (guix store). 129;; This is actually in (guix store).
238(test-equal "store-path-package-name" 130(test-equal "store-path-package-name"
239 "bash-4.2-p24" 131 "bash-4.2-p24"