projects/guix·blob master · refs

726 lines · 22.7 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012-2016, 2018-2022, 2026 Ludovic Courtès <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (test-records)
20 #:use-module (srfi srfi-1)
21 #:use-module (srfi srfi-64)
22 #:use-module (ice-9 format)
23 #:use-module (ice-9 match)
24 #:use-module (ice-9 regex)
25 #:use-module (guix records))
26
27(define (test-module)
28 ;; A module in which to evaluate things that are known to fail.
29 (let ((module (make-fresh-user-module)))
30 (module-use! module (resolve-interface '(guix records)))
31 module))
32
33(define (location-alist loc)
34 ;; Return a location alist. In Guile < 3.0.6, LOC is always an alist, but
35 ;; starting with 3.0.6, LOC is a vector (at least when it comes from
36 ;; 'syntax-error' exceptions), hence this conversion.
37 (match loc
38 (#(file line column)
39 `((line . ,line) (column . ,column)
40 (filename . ,file)))
41 (_ loc)))
42
43
44(test-begin "records")
45
46(test-assert "define-record-type*"
47 (begin
48 (define-record-type* <foo> foo make-foo
49 foo?
50 (bar foo-bar)
51 (baz foo-baz (default (+ 40 2))))
52 (and (match (foo (bar 1) (baz 2))
53 (($ <foo> 1 2) #t))
54 (match (foo (baz 2) (bar 1))
55 (($ <foo> 1 2) #t))
56 (match (foo (bar 1))
57 (($ <foo> 1 42) #t)))))
58
59(test-equal "define-record-type* with 20 fields"
60 '(0 9 19 0 42 19)
61 ;; This record has enough fields for its constructor to use a rest argument.
62 (eval
63 `(begin
64 (define-record-type* <wide-record> wide-record make-wide-record
65 wide-record?
66 ,@(map
67 (lambda (n)
68 (let ((name (string->symbol (format #f "field-~a" n))))
69 `(,name ,name (default ,n))))
70 (iota 20)))
71
72 (let* ((record (wide-record))
73 (inherited (wide-record (inherit record) (field-9 42))))
74 (list (field-0 record)
75 (field-9 record)
76 (field-19 record)
77 (field-0 inherited)
78 (field-9 inherited)
79 (field-19 inherited))))
80 (test-module)))
81
82(test-assert "define-record-type* with let* behavior"
83 ;; Make sure field initializers can refer to each other as if they were in
84 ;; a 'let*'.
85 (begin
86 (define-record-type* <bar> bar make-bar
87 foo?
88 (x bar-x)
89 (y bar-y (default (+ 40 2)))
90 (z bar-z))
91 (and (match (bar (x 1) (y (+ x 1)) (z (* y 2)))
92 (($ <bar> 1 2 4) #t))
93 (match (bar (x 7) (z (* x 3)))
94 (($ <bar> 7 42 21) #t))
95 (match (bar (z 21) (x (/ z 3)))
96 (($ <bar> 7 42 21) #t)))))
97
98(test-assert "define-record-type* & inherit"
99 (begin
100 (define-record-type* <foo> foo make-foo
101 foo?
102 (bar foo-bar)
103 (baz foo-baz (default (+ 40 2))))
104 (let* ((a (foo (bar 1)))
105 (b (foo (inherit a) (baz 2)))
106 (c (foo (inherit b) (bar -2)))
107 (d (foo (inherit c)))
108 (e (foo (inherit (foo (bar 42))) (baz 77))))
109 (and (match a (($ <foo> 1 42) #t))
110 (match b (($ <foo> 1 2) #t))
111 (match c (($ <foo> -2 2) #t))
112 (equal? c d)
113 (match e (($ <foo> 42 77) #t))))))
114
115(test-assert "define-record-type* & inherit & let* behavior"
116 (begin
117 (define-record-type* <foo> foo make-foo
118 foo?
119 (bar foo-bar)
120 (baz foo-baz (default (+ 40 2))))
121 (let* ((a (foo (bar 77)))
122 (b (foo (inherit a) (bar 1) (baz (+ bar 1))))
123 (c (foo (inherit b) (baz 2) (bar (- baz 1)))))
124 (and (match a (($ <foo> 77 42) #t))
125 (match b (($ <foo> 1 2) #t))
126 (equal? b c)))))
127
128(test-assert "define-record-type* & inherit & innate"
129 (begin
130 (define-record-type* <foo> foo make-foo
131 foo?
132 (bar foo-bar (innate) (default 42)))
133 (let* ((a (foo (bar 1)))
134 (b (foo (inherit a)))
135 (c (foo (inherit a) (bar 3)))
136 (d (foo)))
137 (and (match a (($ <foo> 1) #t))
138 (match b (($ <foo> 42) #t))
139 (match c (($ <foo> 3) #t))
140 (match d (($ <foo> 42) #t))))))
141
142(test-assert "define-record-type* & thunked"
143 (begin
144 (define-record-type* <foo> foo make-foo
145 foo?
146 (bar foo-bar)
147 (baz foo-baz (thunked)))
148
149 (let* ((calls 0)
150 (x (foo (bar 2)
151 (baz (begin (set! calls (1+ calls)) 3)))))
152 (and (zero? calls)
153 (equal? (foo-bar x) 2)
154 (equal? (foo-baz x) 3) (= 1 calls)
155 (equal? (foo-baz x) 3) (= 2 calls)))))
156
157(test-assert "define-record-type* & thunked & default"
158 (begin
159 (define-record-type* <foo> foo make-foo
160 foo?
161 (bar foo-bar)
162 (baz foo-baz (thunked) (default 42)))
163
164 (let ((mark (make-parameter #f)))
165 (let ((x (foo (bar 2) (baz (mark))))
166 (y (foo (bar 2))))
167 (and (equal? (foo-bar x) 2)
168 (parameterize ((mark (cons 'a 'b)))
169 (eq? (foo-baz x) (mark)))
170 (equal? (foo-bar y) 2)
171 (equal? (foo-baz y) 42))))))
172
173(test-assert "define-record-type* & thunked & inherited"
174 (begin
175 (define-record-type* <foo> foo make-foo
176 foo?
177 (bar foo-bar (thunked))
178 (baz foo-baz (thunked) (default 42)))
179
180 (let ((mark (make-parameter #f)))
181 (let* ((x (foo (bar 2) (baz (mark))))
182 (y (foo (inherit x) (bar (mark)))))
183 (and (equal? (foo-bar x) 2)
184 (parameterize ((mark (cons 'a 'b)))
185 (eq? (foo-baz x) (mark)))
186 (parameterize ((mark (cons 'a 'b)))
187 (eq? (foo-bar y) (mark)))
188 (parameterize ((mark (cons 'a 'b)))
189 (eq? (foo-baz y) (mark))))))))
190
191(test-assert "define-record-type* & thunked & innate"
192 (let ((mark (make-parameter #f)))
193 (define-record-type* <foo> foo make-foo
194 foo?
195 (bar foo-bar (thunked) (innate) (default (mark)))
196 (baz foo-baz (default #f)))
197
198 (let* ((x (foo (bar 42)))
199 (y (foo (inherit x) (baz 'unused))))
200 (and (procedure? (struct-ref x 0))
201 (equal? (foo-bar x) 42)
202 (parameterize ((mark (cons 'a 'b)))
203 (eq? (foo-bar y) (mark)))
204 (parameterize ((mark (cons 'a 'b)))
205 (eq? (foo-bar y) (mark)))))))
206
207(test-assert "define-record-type* & thunked & this-record"
208 (begin
209 (define-record-type* <foo> foo make-foo
210 foo?
211 (bar foo-bar)
212 (baz foo-baz (thunked)))
213
214 (let ((x (foo (bar 40)
215 (baz (+ (foo-bar this-record) 2)))))
216 (and (= 40 (foo-bar x))
217 (= 42 (foo-baz x))))))
218
219(test-assert "define-record-type* & thunked & default & this-record"
220 (begin
221 (define-record-type* <foo> foo make-foo
222 foo?
223 (bar foo-bar)
224 (baz foo-baz (thunked)
225 (default (+ (foo-bar this-record) 2))))
226
227 (let ((x (foo (bar 40))))
228 (and (= 40 (foo-bar x))
229 (= 42 (foo-baz x))))))
230
231(test-assert "define-record-type* & thunked & inherit & this-record"
232 (begin
233 (define-record-type* <foo> foo make-foo
234 foo?
235 (bar foo-bar)
236 (baz foo-baz (thunked)
237 (default (+ (foo-bar this-record) 2))))
238
239 (let* ((x (foo (bar 40)))
240 (y (foo (inherit x) (bar -2)))
241 (z (foo (inherit x) (baz -2))))
242 (and (= -2 (foo-bar y))
243 (= 0 (foo-baz y))
244 (= 40 (foo-bar z))
245 (= -2 (foo-baz z))))))
246
247(test-assert "define-record-type* & thunked & inherit & custom this"
248 (let ()
249 (define-record-type* <foo> foo make-foo
250 foo? this-foo
251 (thing foo-thing (thunked)))
252 (define-record-type* <bar> bar make-bar
253 bar? this-bar
254 (baz bar-baz (thunked)))
255
256 ;; Nest records and test the two self references.
257 (let* ((x (foo (thing (bar (baz (list this-bar this-foo))))))
258 (y (foo-thing x)))
259 (match (bar-baz y)
260 ((first second)
261 (and (eq? second x)
262 (bar? first)
263 (eq? first y)))))))
264
265(test-equal "define-record-type* & thunked & no inherited value"
266 '(baz) ;the unbound variable
267 (catch 'unbound-variable
268 (lambda ()
269 (eval '(begin
270 (define-record-type* <foo> foo make-foo
271 foo?
272 (bar foo-bar)
273 (baz foo-baz (thunked)))
274
275 ;; There's no inheritance here so 'baz' is unbound in the field
276 ;; body. Call 'foo-baz' to trigger to unbound variable error.
277 (foo-baz (foo (bar 1) (baz baz))))
278 (test-module)))
279 (lambda (key proc message arguments . rest)
280 arguments)))
281
282(test-equal "define-record-type* & thunked & inherited value"
283 '(1 22)
284 (begin
285 (define-record-type* <foo> foo make-foo
286 foo?
287 (bar foo-bar)
288 (baz foo-baz (thunked)))
289
290 (let* ((parent (foo (bar 1) (baz 2)))
291 (child (foo (inherit parent)
292 (baz (* baz 11)))))
293 (list (foo-bar child) (foo-baz child)))))
294
295(test-equal "define-record-type* & thunked & inherited value & this-record"
296 '((1 2) => (21 (inherited . 42)))
297 (begin
298 (define-record-type* <foo> foo make-foo
299 foo?
300 (bar foo-bar)
301 (baz foo-baz (thunked)))
302
303 (let* ((parent (foo (bar 1)
304 (baz (* 2 (foo-bar this-record)))))
305 (child (foo (inherit parent)
306 (bar 21)
307 (baz (cons 'inherited baz)))))
308 `((,(foo-bar parent) ,(foo-baz parent))
309 =>
310 (,(foo-bar child) ,(foo-baz child))))))
311
312(test-equal "define-record-type* & thunked & inherited value & sanitizer"
313 '((1 "2") => (4 "88"))
314 (begin
315 (define-record-type* <foo> foo make-foo
316 foo?
317 (bar foo-bar)
318 (baz foo-baz (thunked) (sanitize number->string)))
319
320 (let* ((parent (foo (bar 1)
321 (baz (* 2 (foo-bar this-record)))))
322 (child (foo (inherit parent)
323 (bar 4)
324 (baz (+ 80 (string->number baz))))))
325 `((,(foo-bar parent) ,(foo-baz parent))
326 =>
327 (,(foo-bar child) ,(foo-baz child))))))
328
329(test-assert "define-record-type* & inherited value shadowing"
330 (let ((exp '(begin
331 (define-record-type* <foo> foo make-foo
332 foo?
333 (bar foo-bar)
334 (baz foo-baz (thunked)))
335
336 (let ((x (foo (bar 1) (baz 2)))
337 (baz 123))
338 ;; Below, the 'baz' binding for the inherited field value
339 ;; shadows the 'baz' above, which should trigger a warning.
340 (foo (inherit x)
341 (baz (* baz 2)))))))
342 (string-contains
343 (call-with-output-string
344 (lambda (port)
345 (parameterize ((current-warning-port port))
346 (eval exp (test-module)))))
347 "shadows local variable")))
348
349(test-assert "define-record-type* & delayed"
350 (begin
351 (define-record-type* <foo> foo make-foo
352 foo?
353 (bar foo-bar (delayed)))
354
355 (let* ((calls 0)
356 (x (foo (bar (begin (set! calls (1+ calls)) 3)))))
357 (and (zero? calls)
358 (equal? (foo-bar x) 3) (= 1 calls)
359 (equal? (foo-bar x) 3) (= 1 calls)
360 (equal? (foo-bar x) 3) (= 1 calls)))))
361
362(test-assert "define-record-type* & delayed & default"
363 (let ((mark #f))
364 (define-record-type* <foo> foo make-foo
365 foo?
366 (bar foo-bar (delayed) (default mark)))
367
368 (let ((x (foo)))
369 (set! mark 42)
370 (and (equal? (foo-bar x) 42)
371 (begin
372 (set! mark 7)
373 (equal? (foo-bar x) 42))))))
374
375(test-assert "define-record-type* & delayed & inherited"
376 (begin
377 (define-record-type* <foo> foo make-foo
378 foo?
379 (bar foo-bar (delayed))
380 (baz foo-baz (delayed)))
381
382 (let* ((m 1)
383 (n #f)
384 (x (foo (bar m) (baz n)))
385 (y (foo (inherit x) (baz 'b))))
386 (set! n 'a)
387 (and (equal? (foo-bar x) 1)
388 (eq? (foo-baz x) 'a)
389 (begin
390 (set! m 777)
391 (equal? (foo-bar y) 1)) ;promise was already forced
392 (eq? (foo-baz y) 'b)))))
393
394(test-assert "define-record-type* & sanitize"
395 (begin
396 (define-record-type* <foo> foo make-foo
397 foo?
398 (bar foo-bar
399 (default "bar")
400 (sanitize (lambda (x) (string-append x "!")))))
401
402 (let* ((p (foo))
403 (q (foo (inherit p)))
404 (r (foo (inherit p) (bar "baz")))
405 (s (foo (bar "baz"))))
406 (and (string=? (foo-bar p) "bar!")
407 (equal? q p)
408 (string=? (foo-bar r) "baz!")
409 (equal? s r)))))
410
411(test-equal "define-record-type* & sanitize without default value"
412 42
413 (begin
414 (define-record-type* <foo> foo make-foo
415 foo?
416 (bar foo-bar (sanitize 1+)))
417
418 (foo-bar (foo (bar 41)))))
419
420(test-assert "define-record-type* & sanitize & thunked"
421 (let ((sanitized 0))
422 (define-record-type* <foo> foo make-foo
423 foo?
424 (bar foo-bar
425 (default "bar")
426 (sanitize (lambda (x)
427 (set! sanitized (+ 1 sanitized))
428 (string-append x "!")))))
429
430 (let ((p (foo)))
431 (and (string=? (foo-bar p) "bar!")
432 (string=? (foo-bar p) "bar!") ;twice
433 (= sanitized 1) ;sanitizer was called at init time only
434 (let ((q (foo (bar "baz"))))
435 (and (string=? (foo-bar q) "baz!")
436 (string=? (foo-bar q) "baz!") ;twice
437 (= sanitized 2)
438 (let ((r (foo (inherit q))))
439 (and (string=? (foo-bar r) "baz!")
440 (= sanitized 2))))))))) ;no re-sanitization
441
442(test-assert "define-record-type* & wrong field specifier"
443 (let ((exp '(begin
444 (define-record-type* <foo> foo make-foo
445 foo?
446 (bar foo-bar (default 42))
447 (baz foo-baz))
448
449 (foo (baz 1 2 3 4 5)))) ;syntax error
450 (loc (current-source-location))) ;keep this alignment!
451 (catch 'syntax-error
452 (lambda ()
453 (eval exp (test-module))
454 #f)
455 (lambda (key proc message location form subform . _)
456 (and (eq? proc 'foo)
457 (string-match "invalid field" message)
458 (equal? subform '(baz 1 2 3 4 5))
459 (equal? form '(foo (baz 1 2 3 4 5)))
460
461 ;; Make sure the location is that of the field specifier.
462 ;; See <http://bugs.gnu.org/23969>.
463 (lset= equal?
464 (pk 'expected-loc
465 `((line . ,(- (assq-ref loc 'line) 1))
466 ,@(alist-delete 'line loc)))
467 (pk 'actual-loc (location-alist location))))))))
468
469(test-assert "define-record-type* & wrong field specifier, identifier"
470 (let ((exp '(begin
471 (define-record-type* <foo> foo make-foo
472 foo?
473 (bar foo-bar (default 42))
474 (baz foo-baz))
475
476 (foo
477 baz))) ;syntax error
478 (loc (current-source-location))) ;keep this alignment!
479 (catch 'syntax-error
480 (lambda ()
481 (eval exp (test-module))
482 #f)
483 (lambda (key proc message location form subform . _)
484 (and (eq? proc 'foo)
485 (string-match "invalid field" message)
486 (equal? subform 'baz)
487 (equal? form '(foo baz))
488
489 ;; Here the location is that of the parent form.
490 (lset= equal?
491 (pk 'expected-loc
492 `((line . ,(- (assq-ref loc 'line) 2))
493 ,@(alist-delete 'line loc)))
494 (pk 'actual-loc (location-alist location))))))))
495
496(test-assert "define-record-type* & missing initializers"
497 (catch 'syntax-error
498 (lambda ()
499 (eval '(begin
500 (define-record-type* <foo> foo make-foo
501 foo?
502 (bar foo-bar (default 42))
503 (baz foo-baz))
504
505 (foo))
506 (test-module))
507 #f)
508 (lambda (key proc message location form . args)
509 (and (eq? proc 'foo)
510 (string-match "missing .*initialize.*baz" message)
511 (equal? form '(foo))))))
512
513(test-assert "define-record-type* & extra initializers"
514 (catch 'syntax-error
515 (lambda ()
516 (eval '(begin
517 (define-record-type* <foo> foo make-foo
518 foo?
519 (bar foo-bar (default 42)))
520
521 (foo (baz 'what?)))
522 (test-module))
523 #f)
524 (lambda (key proc message location form . args)
525 (and (string-match "extra.*initializer.*baz" message)
526 (eq? proc 'foo)))))
527
528(test-assert "define-record-type* & inherit & extra initializers"
529 (catch 'syntax-error
530 (lambda ()
531 (eval '(begin
532 (define-record-type* <foo> foo make-foo
533 foo?
534 (bar foo-bar (default 42)))
535
536 (foo (inherit (foo)) (baz 'what?)))
537 (test-module))
538 #f)
539 (lambda (key proc message location form . args)
540 (and (string-match "extra.*initializer.*baz" message)
541 (eq? proc 'foo)))))
542
543(test-assert "define-record-type* & duplicate initializers"
544 (let ((exp '(begin
545 (define-record-type* <foo> foo make-foo
546 foo?
547 (bar foo-bar (default 42)))
548
549 (foo (bar 1)
550 (bar 2))))
551 (loc (current-source-location))) ;keep this alignment!
552 (catch 'syntax-error
553 (lambda ()
554 (eval exp (test-module))
555 #f)
556 (lambda (key proc message location form . args)
557 (and (string-match "duplicate.*initializer" message)
558 (eq? proc 'foo)
559
560 ;; Make sure the location is that of the field specifier.
561 (lset= equal?
562 (pk 'expected-loc
563 `((line . ,(- (assq-ref loc 'line) 1))
564 ,@(alist-delete 'line loc)))
565 (pk 'actual-loc (location-alist location))))))))
566
567(test-assert "ABI checks"
568 (let ((module (test-module)))
569 (eval '(begin
570 (define-record-type* <foo> foo make-foo
571 foo?
572 (bar foo-bar (default 42)))
573
574 (define (make-me-a-record) (foo)))
575 module)
576 (unless (eval '(foo? (make-me-a-record)) module)
577 (error "what?" (eval '(make-me-a-record) module)))
578
579 ;; Redefine <foo> with an additional field.
580 (eval '(define-record-type* <foo> foo make-foo
581 foo?
582 (baz foo-baz)
583 (bar foo-bar (default 42)))
584 module)
585
586 ;; Now 'make-me-a-record' is out of sync because it does an
587 ;; 'allocate-struct' that corresponds to the previous definition of <foo>.
588 (catch 'record-abi-mismatch-error
589 (lambda ()
590 (eval '(foo? (make-me-a-record)) module)
591 #f)
592 (match-lambda*
593 ((key 'abi-check (? string? message) (rtd) . _)
594 (eq? rtd (eval '<foo> module)))))))
595
596(test-equal "recutils->alist"
597 '((("Name" . "foo")
598 ("Version" . "0.1")
599 ("Synopsis" . "foo bar")
600 ("Something_else" . "chbouib"))
601 (("Name" . "bar")
602 ("Version" . "1.5")))
603 (let ((p (open-input-string "
604# Comment following an empty line, and
605# preceding a couple of empty lines, all of
606# which should be silently consumed.
607
608
609Name: foo
610Version: 0.1
611# Comment right in the middle,
612# spanning two lines.
613Synopsis: foo bar
614Something_else: chbouib
615
616# Comment right before.
617Name: bar
618Version: 1.5
619# Comment at the end.")))
620 (list (recutils->alist p)
621 (recutils->alist p))))
622
623(test-equal "recutils->alist with + lines"
624 '(("Name" . "foo")
625 ("Description" . "1st line,\n2nd line,\n 3rd line with extra space,\n4th line without space."))
626 (recutils->alist (open-input-string "
627Name: foo
628Description: 1st line,
629+ 2nd line,
630+ 3rd line with extra space,
631+4th line without space.")))
632
633(test-equal "alist->record" '((1 2) b c)
634 (alist->record '(("a" . 1) ("b" . b) ("c" . c) ("a" . 2))
635 list
636 '("a" "b" "c")
637 '("a")))
638
639(test-equal "match-record, simple"
640 '((1 2) (a b))
641 (let ()
642 (define-record-type* <foo> foo make-foo
643 foo?
644 (first foo-first (default 1))
645 (second foo-second))
646
647 (list (match-record (foo (second 2)) <foo>
648 (first second)
649 (list first second))
650 (match-record (foo (first 'a) (second 'b)) <foo>
651 (second (first first/new-var))
652 (list first/new-var second)))))
653
654(test-equal "match-record, unknown field"
655 'syntax-error
656 (catch 'syntax-error
657 (lambda ()
658 (eval '(begin
659 (use-modules (guix records))
660
661 (define-record-type* <foo> foo make-foo
662 foo?
663 (first foo-first (default 1))
664 (second foo-second))
665
666 (match-record (foo (second 2)) <foo>
667 (one two)
668 #f))
669 (make-fresh-user-module)))
670 (lambda (key . args) key)))
671
672(test-equal "match-record, delayed field"
673 "foo bar bar foo"
674 (begin
675 (define-record-type* <with-delayed> with-delayed make-with-delayed
676 with-delayed?
677 (delayed with-delayed-delayed
678 (delayed)))
679
680 (let ((rec (with-delayed
681 (delayed "foo bar bar foo"))))
682 (match-record rec <with-delayed> (delayed)
683 delayed))))
684
685(test-equal "match-record, thunked field"
686 '("foo" "foobar")
687 (begin
688 (define-record-type* <with-thunked> with-thunked make-with-thunked
689 with-thunked?
690 (normal with-thunked-normal)
691 (thunked with-thunked-thunked
692 (thunked)))
693
694 (let ((rec (with-thunked
695 (normal "foo")
696 (thunked (string-append (with-thunked-normal this-record)
697 "bar")))))
698 (match-record rec <with-thunked> (normal thunked)
699 (list normal thunked)))))
700
701(test-equal "match-record, ellipsis in body"
702 #t
703 (begin
704 (define-record-type* <foo> foo make-foo foo?
705 (value foo-value))
706 (define bar (foo (value '(1 2 3))))
707 (match-record bar <foo> (value)
708 (match value
709 ((one two ...)
710 #t)
711 (_
712 #f)))))
713
714(test-equal "match-record-lambda"
715 '("thing: foo" "thing: bar")
716 (begin
717 (define-record-type* <with-text> with-text make-with-text
718 with-text?
719 (text with-text-text))
720
721 (map (match-record-lambda <with-text> (text)
722 (string-append "thing: " text))
723 (list (with-text (text "foo"))
724 (with-text (text "bar"))))))
725
726(test-end)