summaryrefslogtreecommitdiff
path: root/tests/records.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-05-20 15:40:55 +0200
committerLudovic Courtès <ludo@gnu.org>2021-07-11 00:49:14 +0200
commit8be1632199483bdbb77cc48d6f3196230dceed90 (patch)
treef530f12b4aa06cb7b9a9e72129b2eff5b7de02e4 /tests/records.scm
parent2a3cd4ee3557fbbdca42b5ec2f3ec4546c270203 (diff)
records: Support field sanitizers.
* guix/records.scm (make-syntactic-constructor): Add #:sanitizers. [field-sanitizer]: New procedure. [wrap-field-value]: Honor F's sanitizer. (define-record-type*)[field-sanitizer]: New procedure. Pass #:sanitizer to 'make-syntactic-constructor'. * tests/records.scm ("define-record-type* & sanitize") ("define-record-type* & sanitize & thunked"): New tests.
Diffstat (limited to 'tests/records.scm')
-rw-r--r--tests/records.scm38
1 files changed, 38 insertions, 0 deletions
diff --git a/tests/records.scm b/tests/records.scm
index 706bb3dbfd..d014e7a995 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -283,6 +283,44 @@
(equal? (foo-bar y) 1)) ;promise was already forced
(eq? (foo-baz y) 'b)))))
+(test-assert "define-record-type* & sanitize"
+ (begin
+ (define-record-type* <foo> foo make-foo
+ foo?
+ (bar foo-bar
+ (default "bar")
+ (sanitize (lambda (x) (string-append x "!")))))
+
+ (let* ((p (foo))
+ (q (foo (inherit p)))
+ (r (foo (inherit p) (bar "baz")))
+ (s (foo (bar "baz"))))
+ (and (string=? (foo-bar p) "bar!")
+ (equal? q p)
+ (string=? (foo-bar r) "baz!")
+ (equal? s r)))))
+
+(test-assert "define-record-type* & sanitize & thunked"
+ (let ((sanitized 0))
+ (define-record-type* <foo> foo make-foo
+ foo?
+ (bar foo-bar
+ (default "bar")
+ (sanitize (lambda (x)
+ (set! sanitized (+ 1 sanitized))
+ (string-append x "!")))))
+
+ (let ((p (foo)))
+ (and (string=? (foo-bar p) "bar!")
+ (string=? (foo-bar p) "bar!") ;twice
+ (= sanitized 1) ;sanitizer was called at init time only
+ (let ((q (foo (bar "baz"))))
+ (and (string=? (foo-bar q) "baz!")
+ (string=? (foo-bar q) "baz!") ;twice
+ (= sanitized 2)
+ (let ((r (foo (inherit q))))
+ (and (string=? (foo-bar r) "baz!")
+ (= sanitized 2))))))))) ;no re-sanitization
(test-assert "define-record-type* & wrong field specifier"
(let ((exp '(begin
(define-record-type* <foo> foo make-foo