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

[kzk at freedesktop.org]

Author: kzk
Date: 2005-07-19 14:30:49 -0700 (Tue, 19 Jul 2005)
New Revision: 985

Removed:
   branches/r5rs/sigscheme/test/test-case.scm
   branches/r5rs/sigscheme/test/test-do.scm
   branches/r5rs/sigscheme/test/test-let.scm
Modified:
   branches/r5rs/sigscheme/test/test-exp.scm
   branches/r5rs/sigscheme/test/unittest.scm
Log:
* test/test-let.scm
* test/test-do.scm
* test/test-case.scm
  - contents moved to test/test-exp.scm

* test/test-exp.scm
  - add let, case, do, begin testcase

* test/unittest.scm
  - add debug message


Deleted: branches/r5rs/sigscheme/test/test-case.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-case.scm	2005-07-19 20:23:57 UTC (rev 984)
+++ branches/r5rs/sigscheme/test/test-case.scm	2005-07-19 21:30:49 UTC (rev 985)
@@ -1,17 +0,0 @@
-(load "test/unittest.scm")
-
-(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 else check"  'caseelse (case 3
-					((1) 'case1)
-					((2) 'case2)
-					(else
-					 'caseelse)))
-
-(total-report)

Deleted: branches/r5rs/sigscheme/test/test-do.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-do.scm	2005-07-19 20:23:57 UTC (rev 984)
+++ branches/r5rs/sigscheme/test/test-do.scm	2005-07-19 21:30:49 UTC (rev 985)
@@ -1,11 +0,0 @@
-(load "test/unittest.scm")
-
-(define (expt-do x n)
-  (do ((i 0 (+ i 1))
-       (y 1))
-      ((= i n) y)
-    (set! y (* x y))))
-
-(assert-eq? "expt-do test" 1024 (expt-do 2 10))
-
-(total-report)

Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm	2005-07-19 20:23:57 UTC (rev 984)
+++ branches/r5rs/sigscheme/test/test-exp.scm	2005-07-19 21:30:49 UTC (rev 985)
@@ -1,14 +1,80 @@
 (load "test/unittest.scm")
 
+;; let
+(assert-eq? "basic let test1" 0 (let ((n 0))
+				 n))
+(assert-eq? "basic let test2" 1 (let ((n 0))
+				  (set! n 1)))
+(assert-eq? "basic let test3" 1 (let ((n 0))
+				  (set! n (+ n 1))))
+(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 ()
+      (set! n (+ n 1)))))
+
+(assert-eq? "lexical scope test1" 1 (count))
+(assert-eq? "lexical scope test2" 2 (count))
+
+;; begin
+(assert-eq? "basic begin test1" 0 (begin
+				    0))
+(assert-eq? "basic begin test1" 1 (begin
+				    0
+				    1))
+(assert-eq? "basic begin test1" 1 (begin
+				    (define n 0)
+				    (set! n 1)))
+
+
+
+
 ;; case
-(assert-eq? "case check" #t (case (* 2 3)
+(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? "case else check" 'elseworks (case 1
-					   ((3) 'a)
-					   ((4) 'b)
+(assert-eq? "basic case else"  'caseelse (case 3
+					   ((1) 'case1)
+					   ((2) 'case2)
 					   (else
-					    'elseworks)))
+					    'caseelse)))
 
+
+
+;; do
+(define (expt-do x n)
+  (do ((i 0 (+ i 1))
+       (y 1))
+      ((= i n) y)
+    (set! y (* x y))))
+
+(assert-eq? "expt-do test" 1024 (expt-do 2 10))
+
+
 (total-report)

Deleted: branches/r5rs/sigscheme/test/test-let.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-let.scm	2005-07-19 20:23:57 UTC (rev 984)
+++ branches/r5rs/sigscheme/test/test-let.scm	2005-07-19 21:30:49 UTC (rev 985)
@@ -1,42 +0,0 @@
-(load "test/unittest.scm")
-
-(assert-eq? "basic let test1" 0 (let ((n 0))
-				 n))
-
-(assert-eq? "basic let test2" 1 (let ((n 0))
-				  (set! n 1)))
-
-(assert-eq? "basic let test3" 1 (let ((n 0))
-				  (set! n (+ n 1))))
-
-(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 ()
-      (set! n (+ n 1)))))
-
-(assert-eq? "lexical scope test1" 1 (count))
-(assert-eq? "lexical scope test2" 2 (count))
-
-(total-report)

Modified: branches/r5rs/sigscheme/test/unittest.scm
===================================================================
--- branches/r5rs/sigscheme/test/unittest.scm	2005-07-19 20:23:57 UTC (rev 984)
+++ branches/r5rs/sigscheme/test/unittest.scm	2005-07-19 21:30:49 UTC (rev 985)
@@ -34,8 +34,20 @@
 
 (define assert-eq?
   (lambda (msg a b)
-    (assert msg (eq? a b))))
+    (if (not (assert msg (eq? a b)))
+	(begin
+	  (print "assert-eq? : we expect ")
+	  (print a)
+	  (print " but got ")
+	  (print b)
+	  (print "\n")))))
 
 (define assert-equal?
   (lambda (msg a b)
-    (assert msg (equal? a b))))
+    (if (not (assert msg (equal? a b)))
+	(begin
+	  (print "assert-equal? : we expect ")
+	  (print a)
+	  (print " but got ")
+	  (print b)
+	  (print "\n")))))