From dcd60f439830ba58f7b89f028973e77ed414cb86 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 30 Aug 2012 00:18:50 +0200
Subject: define-record-type*: Add the `inherit' syntactic constructor keyword.

* guix/utils.scm (define-record-type*)[make-syntactic-constructor]: New
  `type' parameter.  Add the `inherit' keyword and corresponding support
  code.

* tests/utils.scm ("define-record-type* & inherit", "define-record-type*
  & inherit & letrec* behavior"): New tests.
---
 tests/utils.scm | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

(limited to 'tests')

diff --git a/tests/utils.scm b/tests/utils.scm
index 6a90817ec3..a0b42052ad 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -132,6 +132,36 @@ (define-record-type* <bar> bar make-bar
          (match (bar (z 21) (x (/ z 3)))
            (($ <bar> 7 42 21))))))
 
+(test-assert "define-record-type* & inherit"
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar)
+      (baz foo-baz (default (+ 40 2))))
+    (let* ((a (foo (bar 1)))
+           (b (foo (inherit a) (baz 2)))
+           (c (foo (inherit b) (bar -2)))
+           (d (foo (inherit c)))
+           (e (foo (inherit (foo (bar 42))) (baz 77))))
+     (and (match a (($ <foo> 1 42) #t))
+          (match b (($ <foo> 1 2) #t))
+          (match c (($ <foo> -2 2) #t))
+          (equal? c d)
+          (match e (($ <foo> 42 77) #t))))))
+
+(test-assert "define-record-type* & inherit & letrec* behavior"
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar)
+      (baz foo-baz (default (+ 40 2))))
+    (let* ((a (foo (bar 77)))
+           (b (foo (inherit a) (bar 1) (baz (+ bar 1))))
+           (c (foo (inherit b) (baz 2) (bar (- baz 1)))))
+     (and (match a (($ <foo> 77 42) #t))
+          (match b (($ <foo> 1 2) #t))
+          (equal? b c)))))
+
 (test-end)
 
 
-- 
cgit v1.2.3