klisp

commit ed2cf7898c47a0b8ca47df0dc103bad99e815542
parent 6283d55edd30579b0851420ec5d208d7fc46c3a0
Author: Oto Havle <havleoto@gmail.com>
Date:   Fri, 28 Oct 2011 12:18:24 +0200

Added tests of keyed variables.

Diffstat:
A
src/tests/keyed-variables.k
 | 
87
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
src/tests/test-all.k
 | 
2
+-

2 files changed, 88 insertions(+), 1 deletion(-)
diff --git a/src/tests/keyed-variables.k b/src/tests/keyed-variables.k
@@ -0,0 +1,87 @@
+;; check.k & test-helpers.k should be loaded
+;;
+;; Tests of features related to keyed variables.
+;;
+
+;; 10.1.1 make-keyed-dynamic-variable
+
+($check-error (make-keyed-dynamic-variable #f))
+
+($let*
+  ( ((b1 a1) (make-keyed-dynamic-variable))
+    ((b2 a2) (make-keyed-dynamic-variable))
+    (r1 ($lambda () (a1)))
+    (r2 ($lambda () (a2))))
+  ($check-predicate (applicative? b1))
+  ($check-predicate (applicative? a1))
+  ($check-error (b1 1 "not-a-combiner"))
+  ($check-error (b1 1 ($lambda ()) "extra-argument"))
+  ($check-error (b1 1))
+  ($check-error (a1 "extra-argument"))
+
+  ($check-not-predicate (equal? b1 b2))
+  ($check-not-predicate (equal? a1 a2))
+  ($check-predicate
+    (b1 1 ($vau () denv (not? ($binds? denv +)))))
+  ($check-not-predicate
+    (b1 1 ($vau () e1 (b2 2 ($vau () e2 (equal? e1 e2))))))
+
+  ($check equal? (b1 "value" ($lambda () "result")) "result")
+  ($check equal? (b1 0 r1) 0)
+  ($check equal? (b1 1 ($lambda () (b1 2 r1))) 2)
+  ($check equal? (b1 1 ($lambda () (b2 2 r1))) 1)
+  ($check equal? (b1 1 ($lambda () (b2 2 r2))) 2)
+
+  ($check-error (a1))
+  ($check-error (b1 0 r2)))
+
+;; 11.1.1 make-keyed-static-variable
+
+($check-error (make-keyed-static-variable #f))
+
+($let*
+  ( ((b1 a1) (make-keyed-static-variable))
+    ((b2 a2) (make-keyed-static-variable))
+    (e11 (b1 1 (get-current-environment)))
+    (e12 (b1 2 (get-current-environment)))
+    (e21 (b2 1 (get-current-environment)))
+    (e22 (b2 2 (get-current-environment)))
+    (e11* (b1 1 (get-current-environment)))
+    (r11 (eval ($quote ($lambda (a) (a))) e11))
+    (r12 (eval ($quote ($lambda (a) (a))) e12))
+    (r11_13
+      (eval
+        ($quote
+          ($let ((e13 (b1 3 (get-current-environment))))
+            (eval ($quote ($lambda (a) (a))) e13)))
+        e11))
+    (r11_22
+      (eval
+        ($quote
+          ($let ((e22 (b2 2 (get-current-environment))))
+            (eval ($quote ($lambda (a) (a))) e22)))
+        e11)))
+  ($check-predicate (applicative? b1))
+  ($check-predicate (applicative? a1))
+  ($check-error (b1 1 "not-an-environment"))
+  ($check-error (b1 1 (get-current-environment) "extra"))
+  ($check-error (b1 1))
+  ($check-error (a1 "extra-argument"))
+
+  ($check-not-predicate (equal? b1 b2))
+  ($check-not-predicate (equal? a1 a2))
+  ($check-predicate (environment? e11))
+  ($check-not-predicate (equal? e11 e12))
+  ($check-not-predicate (equal? e11 e21))
+  ($check-not-predicate (equal? e11 e11*))
+
+  ($check equal? (eval (list a1) e11) 1)
+  ($check equal? (eval (list a1) e12) 2)
+  ($check equal? (r11 a1) 1)
+  ($check equal? (r12 a1) 2)
+  ($check equal? (r11_13 a1) 3)
+  ($check equal? (r11_22 a1) 1)
+  ($check equal? (r11_22 a2) 2)
+
+  ($check-error (a1))
+  ($check-error (r11_13 a2)))
diff --git a/src/tests/test-all.k b/src/tests/test-all.k
@@ -14,8 +14,8 @@
 (load "tests/environments.k")
 (load "tests/environment-mutation.k")
 (load "tests/combiners.k")
-;; XXX Oto, you forgot to add tests/encapsulations.k to the repo!
 (load "tests/encapsulations.k")
+(load "tests/keyed-variables.k")
 (load "tests/numbers.k")
 (load "tests/strings.k")
 (load "tests/characters.k")