aboutsummaryrefslogtreecommitdiff
path: root/tests/records.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/records.scm')
-rw-r--r--tests/records.scm58
1 files changed, 58 insertions, 0 deletions
diff --git a/tests/records.scm b/tests/records.scm
index d9469a78bd..16b7a9c35e 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -170,6 +170,64 @@
(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* & thunked & inherit & custom this"
+ (let ()
+ (define-record-type* <foo> foo make-foo
+ foo? this-foo
+ (thing foo-thing (thunked)))
+ (define-record-type* <bar> bar make-bar
+ bar? this-bar
+ (baz bar-baz (thunked)))
+
+ ;; Nest records and test the two self references.
+ (let* ((x (foo (thing (bar (baz (list this-bar this-foo))))))
+ (y (foo-thing x)))
+ (match (bar-baz y)
+ ((first second)
+ (and (eq? second x)
+ (bar? first)
+ (eq? first y)))))))
+
(test-assert "define-record-type* & delayed"
(begin
(define-record-type* <foo> foo make-foo