[uim-commit] r2010 - branches/r5rs/test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-11-05 10:23:07 -0800 (Sat, 05 Nov 2005)
New Revision: 2010

Modified:
   branches/r5rs/test/test-lazy-load.scm
   branches/r5rs/test/test-plugin.scm
   branches/r5rs/test/test-slib.scm
   branches/r5rs/test/test-util.scm
Log:
* test/test-slib.scm
  - (test precedure?): Rewrite SIOD-dependent test to SigScheme
* test/test-lazy-load.scm
  - (test stub-im-generate-init-handler, test register-stub-im, test
    stub-im-generate-stub-im-list): Ditto
* test/test-plugin.scm
  - (test require-module): Ditto
* test/test-util.scm
  - (test boolean?, test %%enclose-another-env): Ditto


Modified: branches/r5rs/test/test-lazy-load.scm
===================================================================
--- branches/r5rs/test/test-lazy-load.scm	2005-11-05 18:16:56 UTC (rev 2009)
+++ branches/r5rs/test/test-lazy-load.scm	2005-11-05 18:23:07 UTC (rev 2010)
@@ -44,6 +44,11 @@
    (uim '(set! im-list ()))
    (uim '(undefine *hangul.scm-loaded*))
    (assert-false (uim-bool '(symbol-bound? '*hangul.scm-loaded*)))
+
+   ;; SigScheme
+   (uim '(set! *features* (delete "*hangul.scm-loaded*" *features*)))
+   (assert-false (uim-bool '(provided? "*hangul.scm-loaded*")))
+
    (uim '(define init-handler (stub-im-generate-init-handler 'hangul2
 							     "hangul")))
    (assert-true  (uim-bool '(procedure? init-handler)))
@@ -62,6 +67,11 @@
    (uim '(set! im-list ()))
    (uim '(undefine *hangul.scm-loaded*))
    (assert-false (uim-bool '(symbol-bound? '*hangul.scm-loaded*)))
+
+   ;; SigScheme
+   (uim '(set! *features* (delete "*hangul.scm-loaded*" *features*)))
+   (assert-false (uim-bool '(provided? "*hangul.scm-loaded*")))
+
    (uim '(register-stub-im
 	  'hangul2
 	  "ko"
@@ -124,6 +134,13 @@
    (uim '(undefine *hangul.scm-loaded*))
    (assert-false (uim-bool '(symbol-bound? '*tcode.scm-loaded*)))
    (assert-false (uim-bool '(symbol-bound? '*hangul.scm-loaded*)))
+
+   ;; SigScheme
+   (uim '(set! *features* (delete "*tcode.scm-loaded*" *features*)))
+   (uim '(set! *features* (delete "*hangul.scm-loaded*" *features*)))
+   (assert-false (uim-bool '(provided? "*tcode.scm-loaded*")))
+   (assert-false (uim-bool '(provided? "*hangul.scm-loaded*")))
+
    (assert-false (uim-bool '(retrieve-im 'tcode)))
    (assert-false (uim-bool '(retrieve-im 'hangul2)))
    (assert-false (uim-bool '(retrieve-im 'hangul3)))

Modified: branches/r5rs/test/test-plugin.scm
===================================================================
--- branches/r5rs/test/test-plugin.scm	2005-11-05 18:16:56 UTC (rev 2009)
+++ branches/r5rs/test/test-plugin.scm	2005-11-05 18:23:07 UTC (rev 2010)
@@ -63,10 +63,20 @@
 		 (uim '(im-module-name (retrieve-im 'hangul2))))
    ;; raw require does not set im-module-name
    (uim '(set! im-list ()))
+
+   ;; SIOD
+   ;;(uim '(undefine *tcode.scm-loaded*))
+   ;;(assert-false (uim-bool '(symbol-bound? '*tcode.scm-loaded*)))
+   ;;(assert-false (uim-bool '(retrieve-im 'tcode)))
+   ;;(assert-true  (uim-bool '(require "tcode.scm")))
+   ;; SigScheme
    (uim '(undefine *tcode.scm-loaded*))
+   (uim '(set! *features* (delete "*tcode.scm-loaded*" *features*)))
    (assert-false (uim-bool '(symbol-bound? '*tcode.scm-loaded*)))
+   (assert-false (uim-bool '(provided? "*tcode.scm-loaded*")))
    (assert-false (uim-bool '(retrieve-im 'tcode)))
    (assert-true  (uim-bool '(require "tcode.scm")))
+
    (assert-equal 'tcode
 		 (uim '(im-name (retrieve-im 'tcode))))
    (assert-false (uim-bool '(im-module-name (retrieve-im 'tcode))))

Modified: branches/r5rs/test/test-slib.scm
===================================================================
--- branches/r5rs/test/test-slib.scm	2005-11-05 18:16:56 UTC (rev 2009)
+++ branches/r5rs/test/test-slib.scm	2005-11-05 18:23:07 UTC (rev 2010)
@@ -90,8 +90,14 @@
    (assert-true  (uim-bool '(procedure? dcngettext)))         ;; 5
    (assert-true  (uim-bool '(procedure? +)))                  ;; 2n
    (assert-true  (uim-bool '(procedure? append)))             ;; lsubr
-   (assert-true  (uim-bool '(procedure? define)))             ;; fsubr
-   (assert-true  (uim-bool '(procedure? cond)))               ;; msubr
+
+   ;; SIOD
+   ;;(assert-true  (uim-bool '(procedure? define)))             ;; fsubr
+   ;;(assert-true  (uim-bool '(procedure? cond)))               ;; msubr
+   ;; SigScheme
+   (assert-false (uim-bool '(procedure? define)))             ;; fsubr
+   (assert-false (uim-bool '(procedure? cond)))               ;; msubr
+
    (assert-true  (uim-bool '(procedure? (lambda (x) x))))     ;; closure
 
    (assert-false (uim-bool '(procedure? 0)))

Modified: branches/r5rs/test/test-util.scm
===================================================================
--- branches/r5rs/test/test-util.scm	2005-11-05 18:16:56 UTC (rev 2009)
+++ branches/r5rs/test/test-util.scm	2005-11-05 18:23:07 UTC (rev 2010)
@@ -673,7 +673,12 @@
    (assert-false (uim-bool '(boolean? 'foo)))
    (assert-false (uim-bool '(boolean? -1)))
    (assert-false (uim-bool '(boolean? 0)))
-   (assert-true  (uim-bool '(boolean? 1)))  ; Siod specific
+
+   ;; SIOD
+   ;;(assert-true  (uim-bool '(boolean? 1)))  ; Siod specific
+   ;; SigScheme
+   (assert-false (uim-bool '(boolean? 1)))
+
    (assert-false (uim-bool '(boolean? 10)))
    (assert-true  (uim-bool '(boolean? ()))) ; Siod specific
    (assert-false (uim-bool '(boolean? '(1 "2" 'three))))
@@ -1337,8 +1342,13 @@
 			      (y 2)
 			      (closure (lambda ()
 					 (+ x y)))
-			      (another-env '((x . 4)
-					     (y . 6))))
+			      ;; SIOD: broken frame for SigScheme
+;;			      (another-env '((x . 4)
+;;					     (y . 6)))
+			      ;; SigScheme: valid 2-frame env
+			      (another-env '(((x) . (4))
+					     ((y) . (6))))
+			      )
 			 (set! closure
 			       (%%enclose-another-env closure another-env))
 			 (closure))))
@@ -1349,8 +1359,13 @@
 				(z 3)
 				(closure (lambda ()
 					   (+ x y z)))
-				(another-env '((x . 4)
-					       (y . 6))))
+				;; SIOD: broken frame for SigScheme
+;;				(another-env '((x . 4)
+;;					       (y . 6)))
+				;; SigScheme: valid 2-frame env
+				(another-env '(((x) . (4))
+					       ((y) . (6))))
+				)
 			   (set! closure
 				 (%%enclose-another-env closure another-env))
 			   (closure)))))))