[uim-commit] r1284 - in branches/r5rs/sigscheme: . test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-08-22 11:27:02 -0700 (Mon, 22 Aug 2005)
New Revision: 1284

Modified:
   branches/r5rs/sigscheme/sigscheme.h
   branches/r5rs/sigscheme/test/test-equation.scm
   branches/r5rs/sigscheme/test/test-num.scm
   branches/r5rs/sigscheme/test/unittest.scm
Log:
* sigscheme/test/unittest.scm
  - (assert-true, assert-false): New procedure
* sigscheme/test/test-equation.scm
  - Add some tests for eq?, eqv? and equal?. Some tests failed. Please
    fix it
* sigscheme/test/test-num.scm
  - Add some tests and passed

* sigscheme/sigscheme.h
  - (SCM_COMPAT_SIOD_BUGS): Modify the comment about it


Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-08-22 18:24:24 UTC (rev 1283)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-08-22 18:27:02 UTC (rev 1284)
@@ -70,7 +70,7 @@
 #define SCM_USE_SRFI8           1  /* use SRFI-8 receive procedure writtein in C */
 #define SCM_USE_NONSTD_FEATURES 1  /* use Non-R5RS standard features */
 #define SCM_COMPAT_SIOD         1  /* use SIOD compatible features */
-#define SCM_COMPAT_SIOD_BUGS    1  /* enable SIOD buggy features */
+#define SCM_COMPAT_SIOD_BUGS    1  /* emulate the buggy behaviors of SIOD */
 #define SCM_STRICT_R5RS         0  /* use strict R5RS check */
 #define SCM_STRICT_ARGCHECK     0  /* enable strict argument check */
 

Modified: branches/r5rs/sigscheme/test/test-equation.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-equation.scm	2005-08-22 18:24:24 UTC (rev 1283)
+++ branches/r5rs/sigscheme/test/test-equation.scm	2005-08-22 18:27:02 UTC (rev 1284)
@@ -1,5 +1,8 @@
 (load "test/unittest.scm")
 
+(define closure1 (lambda (x) x))
+(define closure2 (lambda (x) x))
+
 ;; check eqv?
 (assert "eqv? #1" (eqv? #t #t))
 (assert "eqv? #2" (eqv? #f #f))
@@ -30,7 +33,16 @@
 (assert "eqv? #7" (not (eqv? '() '(())
 			          )))
 
+(assert-true  "eqv? #8 procedures" (eqv? + +))
+(assert-false "eqv? #8 procedures" (eqv? + -))
+(assert-false "eqv? #8 procedures" (eqv? + closure1))
+(assert-true  "eqv? #8 procedures" (eqv? closure1 closure1))
+(assert-false "eqv? #8 procedures" (eqv? closure1 closure2))
+
+;; TODO: add tests for port and continuation
+
 ;; check eq?
+;; FIXME: rewrite assert-equal? with assert
 (assert-equal? "eq? check empty list" '() '())
 
 (define pair1 (cons 'a 'b))
@@ -43,6 +55,14 @@
 
 (assert-equal? "eq? check func" + +)
 
+(assert-true  "eq? #5 procedures" (eq? + +))
+(assert-false "eq? #5 procedures" (eq? + -))
+(assert-false "eq? #5 procedures" (eq? + closure1))
+(assert-true  "eq? #5 procedures" (eq? closure1 closure1))
+(assert-false "eq? #5 procedures" (eq? closure1 closure2))
+
+;; TODO: add tests for port and continuation
+
 ;; check equal?
 (assert "basic equal? test1" (equal? 'a 'a))
 (assert "basic equal? test2" (equal? '(a) '(a)))
@@ -53,4 +73,12 @@
 (assert "basic equal? test6" (equal? (make-vector 5 'a)
 				     (make-vector 5 'a)))
 
+(assert-true  "equal? #3 procedures" (equal? + +))
+(assert-false "equal? #3 procedures" (equal? + -))
+(assert-false "equal? #3 procedures" (equal? + closure1))
+(assert-true  "equal? #3 procedures" (equal? closure1 closure1))
+(assert-false "equal? #3 procedures" (equal? closure1 closure2))
+
+;; TODO: add tests for port and continuation
+
 (total-report)

Modified: branches/r5rs/sigscheme/test/test-num.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-num.scm	2005-08-22 18:24:24 UTC (rev 1283)
+++ branches/r5rs/sigscheme/test/test-num.scm	2005-08-22 18:27:02 UTC (rev 1284)
@@ -1,6 +1,27 @@
 (load "test/unittest.scm")
 
-(assert-equal? "= test" #t (= 1 1))
+;; TODO: add minus number comparisons
+(assert-true  "= #1" (= 1 1))
+(assert-false "= #2" (= 1 2))
+(assert-true  "= #3" (= 1 1 1))
+(assert-false "= #4" (= 1 2 1))
+(assert-false "= #5" (= 1 1 2))
+
+;; TODO: add minus number comparisons
+(assert-true  "> #1"  (> 1 0))
+(assert-false "> #2"  (> 1 1))
+(assert-false "> #3"  (> 1 2))
+(assert-false "> #4"  (> 1 0 0))
+(assert-true  "> #5"  (> 1 0 -1))
+(assert-true  "> #6"  (> 1 0 -1))
+(assert-false "> #7"  (> 1 0 1))
+(assert-false "> #8"  (> 1 1 0))
+(assert-false "> #9"  (> 1 1 1))
+(assert-false "> #10" (> 1 2 1))
+(assert-false "> #11" (> 1 2 0))
+
+;; TODO: add tests for <, >=, <=
+
 (assert-equal? "+ test1" 0  (+))
 (assert-equal? "+ test2" 3  (+ 3))
 (assert-equal? "+ test3" 3  (+ 1 2))

Modified: branches/r5rs/sigscheme/test/unittest.scm
===================================================================
--- branches/r5rs/sigscheme/test/unittest.scm	2005-08-22 18:24:24 UTC (rev 1283)
+++ branches/r5rs/sigscheme/test/unittest.scm	2005-08-22 18:27:02 UTC (rev 1284)
@@ -29,6 +29,12 @@
 	  (report-error msg)
 	  #f))))
 
+(define assert-true assert)
+
+(define assert-false
+  (lambda (msg exp)
+    (assert msg (not exp))))
+
 (define assert-eq?
   (lambda (msg a b)
     (if (not (assert msg (eq? a b)))