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