klisp

commit 35bca54319ff0ab909426fa9f27b754f54ab78ca
parent 2d709d86555c0874c0aea1422b29a0645895f583
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Mon, 28 Nov 2011 21:27:40 -0300

Added tests for $and? and $or? tail recursiveness.

Diffstat:
M
src/tests/booleans.k
 | 
33
++++++++++++++++++++++++++++++++-
M
src/tests/control.k
 | 
8
++++----

2 files changed, 36 insertions(+), 5 deletions(-)
diff --git a/src/tests/booleans.k b/src/tests/booleans.k
@@ -74,7 +74,6 @@
 ($check-not-predicate (or? #f #f #f))
 
 ;; $and? & $or?
-;; TODO check tail call
 ($check-predicate (operative? $and?))
 ($check-predicate ($and?))
 ($check-predicate ($and? #t))
@@ -85,6 +84,15 @@
 ($check-not-predicate ($and? #t #t #f))
 ($check-not-predicate ($and? #f (/ 1 0))) ;; test conditional evaluation
 
+;; check tail recursiveness
+($let ((p (cons 1 2)))
+  ($check-predicate ($sequence ($and? ($let/cc cont1
+					(set-car! p cont1)
+					($and? ($let/cc cont2
+						(set-cdr! p cont2)
+						#t))))
+			       (eq? (car p) (cdr p)))))
+
 ($check-predicate (operative? $or?))
 ($check-predicate ($or? #t))
 ($check-predicate ($or? #f (eq? #t #t) #t)) ;; test some evaluation too!
@@ -94,6 +102,29 @@
 ($check-not-predicate ($or? #f))
 ($check-not-predicate ($or?))
 
+($let ((p (cons 1 2)))
+  ($check-predicate ($sequence ($or? ($let/cc cont1
+					(set-car! p cont1)
+					($or? ($let/cc cont2
+						(set-cdr! p cont2)
+						#t))))
+			       (eq? (car p) (cdr p)))))
+
+($let ((p (cons 1 2)))
+  ($check-predicate ($sequence ($and? ($let/cc cont1
+					(set-car! p cont1)
+					($or? ($let/cc cont2
+						(set-cdr! p cont2)
+						#t))))
+			       (eq? (car p) (cdr p)))))
+
+($let ((p (cons 1 2)))
+  ($check-predicate ($sequence ($or? ($let/cc cont1
+					(set-car! p cont1)
+					($and? ($let/cc cont2
+						(set-cdr! p cont2)
+						#t))))
+			       (eq? (car p) (cdr p)))))
 
 ;;;
 ;;; Error Checking and Robustness
diff --git a/src/tests/control.k b/src/tests/control.k
@@ -26,11 +26,11 @@
 				  (enc #inert))))
 ($check-not-predicate (inert? (memoize #inert)))
 ($check-not-predicate (inert? 1))
-;($check-not-predicate (inert? 1.0))
+($check-not-predicate (inert? 1.0))
 ($check-not-predicate (inert? #e+infinity))
-;($check-not-predicate (inert? #i+infinity))
-;($check-not-predicate (inert? #undefined))
-;($check-not-predicate (inert? #real-with-no-primary-value))
+($check-not-predicate (inert? #i+infinity))
+($check-not-predicate (inert? #undefined))
+($check-not-predicate (inert? #real))
 ($check-not-predicate (inert? "string"))
 ($check-not-predicate (inert? #\a))
 ($check-not-predicate (inert? (get-current-input-port)))