diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-03-22 14:02:00 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-03-25 23:37:06 +0100 |
| commit | abd4d6b33dba4de228e90ad15a8efb456fcf7b6e (patch) | |
| tree | 82851cffc3953f138df72fee42a2f5d801dde005 /tests/records.scm | |
| parent | 3191b5f6ba5ebbb59a7448facd999ad7f7aeae79 (diff) | |
| download | guix-abd4d6b33dba4de228e90ad15a8efb456fcf7b6e.tar guix-abd4d6b33dba4de228e90ad15a8efb456fcf7b6e.tar.gz | |
records: Allow thunked fields to refer to 'this-record'.
* guix/records.scm (this-record): New syntax parameter.
(make-syntactic-constructor)[wrap-field-value]: When F is thunked,
return a one-argument lambda instead of a thunk, and parameterize
THIS-RECORD.
(define-record-type*)[thunked-field-accessor-definition]: Pass X
to (real-get X).
* tests/records.scm ("define-record-type* & thunked & this-record")
("define-record-type* & thunked & default & this-record")
("define-record-type* & thunked & inherit & this-record"): New tests.
Diffstat (limited to 'tests/records.scm')
| -rw-r--r-- | tests/records.scm | 40 |
1 files changed, 40 insertions, 0 deletions
diff --git a/tests/records.scm b/tests/records.scm index d9469a78bd..45614093a0 100644 --- a/tests/records.scm +++ b/tests/records.scm @@ -170,6 +170,46 @@ (parameterize ((mark (cons 'a 'b))) (eq? (foo-bar y) (mark))))))) +(test-assert "define-record-type* & thunked & this-record" + (begin + (define-record-type* <foo> foo make-foo + foo? + (bar foo-bar) + (baz foo-baz (thunked))) + + (let ((x (foo (bar 40) + (baz (+ (foo-bar this-record) 2))))) + (and (= 40 (foo-bar x)) + (= 42 (foo-baz x)))))) + +(test-assert "define-record-type* & thunked & default & this-record" + (begin + (define-record-type* <foo> foo make-foo + foo? + (bar foo-bar) + (baz foo-baz (thunked) + (default (+ (foo-bar this-record) 2)))) + + (let ((x (foo (bar 40)))) + (and (= 40 (foo-bar x)) + (= 42 (foo-baz x)))))) + +(test-assert "define-record-type* & thunked & inherit & this-record" + (begin + (define-record-type* <foo> foo make-foo + foo? + (bar foo-bar) + (baz foo-baz (thunked) + (default (+ (foo-bar this-record) 2)))) + + (let* ((x (foo (bar 40))) + (y (foo (inherit x) (bar -2))) + (z (foo (inherit x) (baz -2)))) + (and (= -2 (foo-bar y)) + (= 0 (foo-baz y)) + (= 40 (foo-bar z)) + (= -2 (foo-baz z)))))) + (test-assert "define-record-type* & delayed" (begin (define-record-type* <foo> foo make-foo |