~ chicken-core (chicken-5) /tests/record-printer-test.scm

 1;;;; record-printer-test.scm
 2
 3(import (chicken format)
 4	(chicken string))
 5
 6(define-record kons x y)
 7
 8;; no printer to start out
 9
10(assert (not (record-printer kons)))
11(assert (equal? "#<kons>" (conc (make-kons 1 2))))
12
13;; custom printer
14
15(set-record-printer! kons
16 (lambda (k p)
17   (fprintf p "#<kons ~a ~a>" (kons-x k) (kons-y k))))
18
19(assert (equal? "#<kons 1 2>" (conc (make-kons 1 2))))
20
21;; srfi-17 style assignment
22
23(assert (procedure? (setter record-printer)))
24
25(set! (record-printer kons)
26  (lambda (k p)
27    (fprintf p "#[~a . ~a]" (kons-x k) (kons-y k))))
28
29(assert (equal? "#[1 . 2]" (conc (make-kons 1 2))))