summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-03-22 14:02:00 +0100
committerLudovic Courtès <ludo@gnu.org>2019-03-25 23:37:06 +0100
commitabd4d6b33dba4de228e90ad15a8efb456fcf7b6e (patch)
tree82851cffc3953f138df72fee42a2f5d801dde005 /tests
parent3191b5f6ba5ebbb59a7448facd999ad7f7aeae79 (diff)
downloadpatches-abd4d6b33dba4de228e90ad15a8efb456fcf7b6e.tar
patches-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')
-rw-r--r--tests/records.scm40
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