[uim-commit] r1052 - branches/r5rs/sigscheme/test

[kzk at freedesktop.org]

Author: kzk
Date: 2005-07-27 23:06:05 -0700 (Wed, 27 Jul 2005)
New Revision: 1052

Modified:
   branches/r5rs/sigscheme/test/test-exp.scm
Log:
* test/test-exp.scm
  - add testcases for "and", "or", "begin" and "do" from R5RS specification


Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm	2005-07-28 05:19:05 UTC (rev 1051)
+++ branches/r5rs/sigscheme/test/test-exp.scm	2005-07-28 06:06:05 UTC (rev 1052)
@@ -27,10 +27,41 @@
 (assert-equal? "basic cond test3" #t (cond ((> 3 2))
 					   ((< 3 4) 'less)
 					   (else 'equal)))
-(assert-equal? "basic cond test4" 2 (cond ((assv 'b '((a 1) (b 2))) => cadr)
-					  (else #f)))
+;(assert-equal? "basic cond test4" 2 (cond ((assv 'b '((a 1) (b 2))) => cadr)
+;					  (else #f)))
 
+;; case
+(assert-eq? "basic case check1" 'case1 (case 1
+					 ((1) 'case1)
+					 ((2) 'case2)))
 
+(assert-eq? "basic case check2" 'case2 (case 2
+					 ((1) 'case1)
+					 ((2) 'case2)))
+
+(assert-eq? "basic case check3" #t (case (* 2 3)
+			      ((2 3 4 7)   #f)
+			      ((1 4 6 8 9) #t)))
+
+(assert-eq? "basic case else"  'caseelse (case 3
+					   ((1) 'case1)
+					   ((2) 'case2)
+					   (else
+					    'caseelse)))
+
+;; and
+(assert-eq? "and test 1" #t (and (= 2 2) (> 2 1)))
+(assert-eq? "and test 2" #f (and (= 2 2) (< 2 1)))
+(assert-equal? "and test 3" '(f g) (and 1 2 'c '(f g)))
+(assert-equal? "and test 4" #t (and))
+
+;; or
+(assert-eq? "or test1" #t (or (= 2 2) (> 2 1)))
+(assert-eq? "or test2" #t (or (= 2 2) (< 2 1)))
+(assert-eq? "or test3" #f (or #f #f #f))
+(assert-equal? "or test4" '(b c) (or (memq 'b '(a b c))
+				     (/ 3 0)))
+
 ;; let
 (assert-eq? "basic let test1" 0 (let ((n 0))
 				 n))
@@ -41,21 +72,6 @@
 (assert-eq? "basic let test4" 3 (let ((n1 2)
 				      (n2 1))
 				  (+ n1 n2)))
-(assert-eq? "basic let* test1" 70 (let ((x 2) (y 3))
-				    (let* ((x 7)
-					   (z (+ x y)))
-				      (* z x))))
-(assert-eq? "basic letrec test1" #t (let ((even?
-					   (lambda (n)
-					     (if (zero? n)
-						 #t
-						 (odd? (- n 1)))))
-					  (odd?
-					   (lambda (n)
-					     (if (zero? n)
-						 #f
-						 (even? (- n 1))))))
-				      (even? 88)))
 (define count
   (let ((n 0))
     (lambda ()
@@ -73,48 +89,53 @@
     (assert-eq? "lexical scope test5" 1 a)))
 (lexical-test)
 
+;; let*
+(assert-eq? "basic let* test1" 70 (let ((x 2) (y 3))
+				    (let* ((x 7)
+					   (z (+ x y)))
+				      (* z x))))
+
+;; letrec
+(assert-eq? "basic letrec test1" #t (let ((even?
+					   (lambda (n)
+					     (if (zero? n)
+						 #t
+						 (odd? (- n 1)))))
+					  (odd?
+					   (lambda (n)
+					     (if (zero? n)
+						 #f
+						 (even? (- n 1))))))
+				      (even? 88)))
+
 ;; begin
-(assert-eq? "basic begin test1" 0 (begin
+(define x 0)
+(assert-eq? "basic begin test1" 6 (begin
+				    (set! x 5)
+				    (+ x 1)))
+(assert-eq? "basic begin test2" 0 (begin
 				    0))
-(assert-eq? "basic begin test1" 1 (begin
+(assert-eq? "basic begin test3" 1 (begin
 				    0
 				    1))
-(assert-eq? "basic begin test1" 1 (begin
+(assert-eq? "basic begin test4" 1 (begin
 				    (define n 0)
 				    (set! n 1)))
+;; do
+(assert-equal? "do test1" '#(0 1 2 3 4) (do ((vec (make-vector 5))
+					     (i 0 (+ i 1)))
+					    ((= i 5) vec)
+					  (vector-set! vec i i)))
+(assert-equal? "do test2" 25 (let ((x '(1 3 5 7 9)))
+			       (do ((x x (cdr x))
+				    (sum 0 (+ sum (car x))))
+				   ((null? x) sum))))
 
-
-
-
-;; case
-(assert-eq? "basic case check1" 'case1 (case 1
-					 ((1) 'case1)
-					 ((2) 'case2)))
-
-(assert-eq? "basic case check2" 'case2 (case 2
-					 ((1) 'case1)
-					 ((2) 'case2)))
-
-(assert-eq? "basic case check3" #t (case (* 2 3)
-			      ((2 3 4 7)   #f)
-			      ((1 4 6 8 9) #t)))
-
-(assert-eq? "basic case else"  'caseelse (case 3
-					   ((1) 'case1)
-					   ((2) 'case2)
-					   (else
-					    'caseelse)))
-
-
-
-;; do
 (define (expt-do x n)
   (do ((i 0 (+ i 1))
        (y 1))
       ((= i n) y)
     (set! y (* x y))))
+(assert-eq? "do test3" 1024 (expt-do 2 10))
 
-(assert-eq? "expt-do test" 1024 (expt-do 2 10))
-
-
 (total-report)