summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-06-11 22:57:33 +0200
committerLudovic Courtès <ludo@gnu.org>2015-06-11 23:33:32 +0200
commit8a16d064fa265c449d136ff6c3d3267e314cde8d (patch)
treeb564649d1a1e3fd704a5a9efe0cfa5f421252df6 /tests
parent792798f48647ef664cfe6fdd7ff313901e383f6c (diff)
downloadguix-8a16d064fa265c449d136ff6c3d3267e314cde8d.tar.gz
records: Add support for 'innate' fields.
* guix/records.scm (make-syntactic-constructor): Add #:innate parameter.
  [record-inheritance]: Honor it.
  [innate-field?]: New procedure.
  (define-record-type*)[innate-field?]: New procedure.
  Pass #:innate to 'make-syntactic-constructor'.
* tests/records.scm ("define-record-type* & inherit & innate",
  "define-record-type* & thunked & innate"): New tests.
Diffstat (limited to 'tests')
-rw-r--r--tests/records.scm30
1 files changed, 30 insertions, 0 deletions
diff --git a/tests/records.scm b/tests/records.scm
index a00e38db7d..6346c154cd 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -90,6 +90,20 @@
           (match b (($ <foo> 1 2) #t))
           (equal? b c)))))
 
+(test-assert "define-record-type* & inherit & innate"
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar (innate) (default 42)))
+    (let* ((a (foo (bar 1)))
+           (b (foo (inherit a)))
+           (c (foo (inherit a) (bar 3)))
+           (d (foo)))
+      (and (match a (($ <foo> 1) #t))
+           (match b (($ <foo> 42) #t))
+           (match c (($ <foo> 3) #t))
+           (match d (($ <foo> 42) #t))))))
+
 (test-assert "define-record-type* & thunked"
   (begin
     (define-record-type* <foo> foo make-foo
@@ -139,6 +153,22 @@
              (parameterize ((mark (cons 'a 'b)))
                (eq? (foo-baz y) (mark))))))))
 
+(test-assert "define-record-type* & thunked & innate"
+  (let ((mark (make-parameter #f)))
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar (thunked) (innate) (default (mark)))
+      (baz foo-baz (default #f)))
+
+    (let* ((x (foo (bar 42)))
+           (y (foo (inherit x) (baz 'unused))))
+      (and (procedure? (struct-ref x 0))
+           (equal? (foo-bar x) 42)
+           (parameterize ((mark (cons 'a 'b)))
+             (eq? (foo-bar y) (mark)))
+           (parameterize ((mark (cons 'a 'b)))
+             (eq? (foo-bar y) (mark)))))))
+
 (test-assert "define-record-type* & delayed"
   (begin
     (define-record-type* <foo> foo make-foo