diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-05-20 15:40:55 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-08-12 12:34:13 +0200 |
| commit | 5291fd7a4205394b863a8705b32fbb447321dc60 (patch) | |
| tree | 6ccbfe1bab6a4a995082e2f9df659816ddb2f6dd /tests/records.scm | |
| parent | 1ad0da60d81f4ba59f5f97af930e9b09f561d277 (diff) | |
| download | guix-5291fd7a4205394b863a8705b32fbb447321dc60.tar guix-5291fd7a4205394b863a8705b32fbb447321dc60.tar.gz | |
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.scm | 38 |
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 |