diff options
author | Mark H Weaver <mhw@netris.org> | 2015-06-14 08:49:42 -0400 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2015-06-14 08:49:42 -0400 |
commit | bcf2971f6ebc965aa94391b2a8d39e5005885806 (patch) | |
tree | c12187a787b934fb79d159046a4a5516e5d39f97 /tests/records.scm | |
parent | ec2990716005b4b41bab6b707ada0206c1655be8 (diff) | |
parent | 7871724df7218428fac53133496c474bac8c5ea8 (diff) | |
download | patches-bcf2971f6ebc965aa94391b2a8d39e5005885806.tar patches-bcf2971f6ebc965aa94391b2a8d39e5005885806.tar.gz |
Merge branch 'master' into core-updates
Conflicts:
gnu/packages/commencement.scm
gnu/packages/xml.scm
Diffstat (limited to 'tests/records.scm')
-rw-r--r-- | tests/records.scm | 32 |
1 files changed, 31 insertions, 1 deletions
diff --git a/tests/records.scm b/tests/records.scm index a00e38db7d..800ed03827 100644 --- a/tests/records.scm +++ b/tests/records.scm @@ -56,7 +56,7 @@ (and (match (bar (x 1) (y (+ x 1)) (z (* y 2))) (($ <bar> 1 2 4) #t)) (match (bar (x 7) (z (* x 3))) - (($ <bar> 7 42 21))) + (($ <bar> 7 42 21) #t)) (match (bar (z 21) (x (/ z 3))) (($ <bar> 7 42 21) #t))))) @@ -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 |