commit 94411bffa8f1226cb271fc9c708cb2f16d757b5e
parent 09d664966bad08a6df9848b23c8f5d0e37ab7d01
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sun, 29 May 2011 16:01:55 -0300
Added tests for eq? & equal?, revised tests for booleans.
Diffstat:
3 files changed, 183 insertions(+), 7 deletions(-)
diff --git a/src/tests/booleans.k b/src/tests/booleans.k
@@ -5,6 +5,7 @@
;;;
;; boolean?
+($check-predicate (applicative? boolean?))
($check-predicate (boolean?))
($check-predicate (boolean? #t))
($check-predicate (boolean? #f))
@@ -25,16 +26,19 @@
(enc #inert))))
($check-not-predicate (boolean? (memoize #inert)))
($check-not-predicate (boolean? 1))
-;XXX ($check-not-predicate (boolean? 1.0))
+($check-not-predicate (boolean? -1/2))
+($check-not-predicate (boolean? 1.0))
($check-not-predicate (boolean? #e+infinity))
-;XXX ($check-not-predicate (boolean? #i+infinity))
-;($check-not-predicate (boolean? #undefined))
-;($check-not-predicate (boolean? #real-with-no-primary-value))
+($check-not-predicate (boolean? #i+infinity))
+($check-not-predicate (boolean? #undefined))
+($check-not-predicate (boolean? #real))
($check-not-predicate (boolean? "string"))
($check-not-predicate (boolean? #\a))
($check-not-predicate (boolean? (get-current-input-port)))
;; basic eq?-ness and not?
+($check-predicate (applicative? not?))
+
($check eq? #t #t)
($check eq? #f #f)
($check not-eq? #t #f)
@@ -51,6 +55,7 @@
($check equal? (not? #f) #t)
;; and? & or?
+($check-predicate (applicative? and?))
($check-predicate (and?))
($check-predicate (and? #t))
($check-predicate (and? #t #t))
@@ -59,6 +64,7 @@
($check-not-predicate (and? #f))
($check-not-predicate (and? #t #t #f))
+($check-predicate (applicative? or?))
($check-predicate (or? #t))
($check-predicate (or? #f #t))
($check-predicate (or? #f #f #t))
@@ -69,6 +75,7 @@
;; $and? & $or?
;; TODO check tail call
+($check-predicate (operative? $and?))
($check-predicate ($and?))
($check-predicate ($and? #t))
($check-predicate ($and? (eq? #t #t) #t)) ;; test some evaluation too!
@@ -78,6 +85,7 @@
($check-not-predicate ($and? #t #t #f))
($check-not-predicate ($and? #f (/ 1 0))) ;; test conditional evaluation
+($check-predicate (operative? $or?))
($check-predicate ($or? #t))
($check-predicate ($or? #f (eq? #t #t) #t)) ;; test some evaluation too!
($check-predicate ($or? #f #f #t))
diff --git a/src/tests/eq-equal.k b/src/tests/eq-equal.k
@@ -1 +1,170 @@
-;; TODO
-\ No newline at end of file
+;;;
+;;; Basic Functionality
+;;;
+
+($check-predicate (applicative? eq?))
+($check-predicate (applicative? equal?))
+
+; no arguments
+($check-predicate (eq?))
+
+($check-predicate (equal?))
+
+; 1 arguments
+($check-predicate (eq? ((unwrap list) . symbol)))
+($check-predicate (eq? ()))
+($check-predicate (eq? (cons () ())))
+($check-predicate (eq? #ignore))
+($check-predicate (eq? (make-environment)))
+($check-predicate (eq? #inert))
+($check-predicate (eq? $vau))
+($check-predicate (eq? wrap))
+($check-predicate (eq? (call/cc ($lambda (c) c))))
+($check-predicate (eq? ($let (((enc . #ignore)
+ (make-encapsulation-type)))
+ (enc #inert))))
+($check-predicate (eq? (memoize #inert)))
+($check-predicate (eq? 1))
+($check-predicate (eq? -1/2))
+($check-predicate (eq? 1.0))
+($check-predicate (eq? #e+infinity))
+($check-predicate (eq? #i+infinity))
+($check-predicate (eq? #undefined))
+($check-predicate (eq? #real))
+($check-predicate (eq? "string"))
+($check-predicate (eq? #\a))
+($check-predicate (eq? (get-current-input-port)))
+
+
+($check-predicate (equal? ((unwrap list) . symbol)))
+($check-predicate (equal? ()))
+($check-predicate (equal? (cons () ())))
+($check-predicate (equal? #ignore))
+($check-predicate (equal? (make-environment)))
+($check-predicate (equal? #inert))
+($check-predicate (equal? $vau))
+($check-predicate (equal? wrap))
+($check-predicate (equal? (call/cc ($lambda (c) c))))
+($check-predicate (equal? ($let (((enc . #ignore)
+ (make-encapsulation-type)))
+ (enc #inert))))
+($check-predicate (equal? (memoize #inert)))
+($check-predicate (equal? 1))
+($check-predicate (equal? -1/2))
+($check-predicate (equal? 1.0))
+($check-predicate (equal? #e+infinity))
+($check-predicate (equal? #i+infinity))
+($check-predicate (equal? #undefined))
+($check-predicate (equal? #real))
+($check-predicate (equal? "string"))
+($check-predicate (equal? #\a))
+($check-predicate (equal? (get-current-input-port)))
+
+; 2 arguments
+($check-predicate (eq? ((unwrap list) . symbol) ((unwrap list) . symbol)))
+($check-predicate (eq? () ()))
+($let ((p (cons () ())))
+ ($check-predicate (eq? p p)))
+($check-not-predicate (eq? (cons () ()) (cons () ())))
+($check-predicate (eq? #ignore #ignore))
+($let ((e (make-environment)))
+ ($check-predicate (eq? e e)))
+($check-not-predicate (eq? (make-environment) (make-environment)))
+($check-predicate (eq? #inert #inert))
+($check-predicate (eq? $vau $vau))
+($check-predicate (eq? wrap wrap))
+($let/cc c
+ ($check-predicate (eq? c c)))
+($let* (((enc . #ignore)
+ (make-encapsulation-type))
+ (e (enc #inert)))
+ ($check-predicate (eq? e e))
+ ($check-not-predicate (eq? e (enc #inert))))
+($let ((p (memoize #inert)))
+ ($check-predicate (eq? p p))
+ ($check-not-predicate (eq? p #inert)))
+($check-predicate (eq? 1 1))
+($check-predicate (eq? -1/2 -1/2))
+($check-predicate (eq? 1.0 1.0))
+($check-not-predicate (eq? 1 1.0))
+($check-not-predicate (eq? 1/2 0.5))
+($check-predicate (eq? #e+infinity #e+infinity))
+($check-predicate (eq? #i+infinity #i+infinity))
+($check-not-predicate (eq? #e+infinity #i+infinity))
+($check-predicate (eq? #undefined #undefined))
+($check-predicate (eq? #real #real))
+($check-not-predicate (eq? #undefined #real))
+($let ((s "string"))
+ ($check-predicate (eq? s s)))
+($check-not-predicate (eq? (string #\c) (string #\c)))
+($check-predicate (eq? #\a #\a))
+($check-predicate (eq? (get-current-input-port) (get-current-input-port)))
+
+($check-predicate (equal? ((unwrap list) . symbol) ((unwrap list) . symbol)))
+($check-predicate (equal? () ()))
+($check-predicate (equal? (cons () ()) (cons () ())))
+($let ((p1 (list 1 2 1 2))
+ (p2 (list 1 2)))
+ (encycle! p1 2 2)
+ (encycle! p2 0 2)
+ ($check-predicate (equal? p1 p2)))
+($check-predicate (equal? #ignore #ignore))
+($let ((e (make-environment)))
+ ($check-predicate (equal? e e)))
+($check-not-predicate (equal? (make-environment) (make-environment)))
+($check-predicate (equal? #inert #inert))
+($check-predicate (equal? $vau $vau))
+($check-predicate (equal? wrap wrap))
+($let/cc c
+ ($check-predicate (equal? c c)))
+($let* (((enc . #ignore)
+ (make-encapsulation-type))
+ (e (enc #inert)))
+ ($check-predicate (equal? e e))
+ ($check-not-predicate (equal? e (enc #inert))))
+($let ((p (memoize #inert)))
+ ($check-predicate (equal? p p))
+ ($check-not-predicate (equal? p #inert)))
+($check-predicate (equal? 1 1))
+($check-predicate (equal? -1/2 -1/2))
+($check-predicate (equal? 1.0 1.0))
+($check-not-predicate (equal? 1 1.0))
+($check-not-predicate (equal? 1/2 0.5))
+($check-predicate (equal? #e+infinity #e+infinity))
+($check-predicate (equal? #i+infinity #i+infinity))
+($check-not-predicate (equal? #e+infinity #i+infinity))
+($check-predicate (equal? #undefined #undefined))
+($check-predicate (equal? #real #real))
+($check-not-predicate (equal? #undefined #real))
+($let ((s "string"))
+ ($check-predicate (equal? s s)))
+($check-predicate (equal? "string" "string"))
+($check-predicate (equal? (string #\c) (string #\c)))
+($check-predicate (equal? #\a #\a))
+($check-predicate (equal? (get-current-input-port) (get-current-input-port)))
+
+; 3 or more arguments
+($check-predicate (eq? 1 1 1))
+($check-not-predicate (eq? #t #t #f))
+($check-predicate (eq? #t #t . #0=(#t . #0#)))
+($check-not-predicate (eq? #t #t . #0=(#inert . #0#)))
+
+($check-predicate (equal? 1 1 1))
+($check-not-predicate (equal? #t #t #f))
+($check-predicate (equal? #t #t . #0=(#t . #0#)))
+($check-not-predicate (equal? #t #t . #0=(#inert . #0#)))
+
+($let ((p1 (list 1 2 1 2))
+ (p2 (list 1 2)))
+ (encycle! p1 2 2)
+ (encycle! p2 0 2)
+ ($check-predicate (equal? p1 p2 . #0=(p2 p1 . #0#))))
+
+;;;
+;;; Error Checking and Robustness
+;;;
+
+;; boolean?
+($check-error (eq? #t . #f))
+
+($check-error (equal? #t . #f))
diff --git a/src/tests/test-all.k b/src/tests/test-all.k
@@ -3,7 +3,7 @@
;(check-set-mode! check-mode-report)
-;; TODO add applicative?/operative? check in boolean, eq/equal, pairs and lists and pair-mutation
+;; TODO add applicative?/operative? check in pairs and lists and pair-mutation
(load "tests/booleans.k")
(load "tests/eq-equal.k")
