[uim-commit] r327 - in trunk: scm test
yamaken@freedesktop.org
yamaken@freedesktop.org
Tue Jan 18 10:46:34 PST 2005
Author: yamaken
Date: 2005-01-18 10:46:31 -0800 (Tue, 18 Jan 2005)
New Revision: 327
Added:
trunk/test/test-lazy-load.scm
trunk/test/test-plugin.scm
Modified:
trunk/scm/custom.scm
trunk/scm/im-custom.scm
trunk/scm/im.scm
trunk/scm/plugin.scm
trunk/test/test-custom.scm
trunk/test/test-im.scm
Log:
* scm/test-custom.scm
- (test define-custom (choice)): Add test for overwriting definition
- (test custom-value-as-literal, test custom-definition-as-literal):
Add test for #f and () as value
* test/test-im.scm
- (test normalize-im-list, test register-im (module-name)): New test
- (test register-im):
* Add test for module-name
* Add test for overwriting register
* Check result value of register-im (initial register or not)
- (testcase im im-custom): New testcase
- (test custom-im-list-as-choice-rec): New test
* test/test-plugin.scm
- New file
- (testcase module): New testcase
- (test require-module): New test
* test/test-lazy-load.scm
- New file
- (testcase stub-im): New testcase
- (test stub-im-generate-init-handler, test register-stub-im, test
stub-im-generate-stub-im-list, test
stub-im-generate-all-stub-im-list): New test
* scm/im-custom.scm
* scm/plugin.scm
* scm/custom.scm
* scm/im.scm
- Remove TODO mark
Modified: trunk/scm/custom.scm
===================================================================
--- trunk/scm/custom.scm 2005-01-18 13:24:58 UTC (rev 326)
+++ trunk/scm/custom.scm 2005-01-18 18:46:31 UTC (rev 327)
@@ -401,7 +401,6 @@
lst)))
(string-append "'(" (string-join " " canonicalized) ")"))))
-;; rewrite test for () as list
;; API
(define custom-value-as-literal
(lambda (sym)
Modified: trunk/scm/im-custom.scm
===================================================================
--- trunk/scm/im-custom.scm 2005-01-18 13:24:58 UTC (rev 326)
+++ trunk/scm/im-custom.scm 2005-01-18 18:46:31 UTC (rev 327)
@@ -31,7 +31,6 @@
(require "i18n.scm")
-;; TODO: write test
(define custom-im-list-as-choice-rec
(lambda (lst)
(map (lambda (im)
Modified: trunk/scm/im.scm
===================================================================
--- trunk/scm/im.scm 2005-01-18 13:24:58 UTC (rev 326)
+++ trunk/scm/im.scm 2005-01-18 18:46:31 UTC (rev 327)
@@ -58,7 +58,6 @@
;;
(define im-list ())
-;; TODO: rewrite test for module-name
(define-record 'im
(list
(list 'name #f) ;; must be first member
@@ -84,7 +83,6 @@
custom-prop-update-custom-handler
list)))
-;; TODO: write test
(define normalize-im-list
(lambda ()
(let ((ordinary-im-list (alist-delete 'direct im-list eq?))
@@ -93,8 +91,8 @@
(set! im-list (cons direct-im
ordinary-im-list))))))
-;; TODO: rewrite test
;; accepts overwrite register
+;; returns initial register or not
(define register-im
(lambda (name lang encoding label-name short-desc init-arg init release
mode key-press key-release reset
Modified: trunk/scm/plugin.scm
===================================================================
--- trunk/scm/plugin.scm 2005-01-18 13:24:58 UTC (rev 326)
+++ trunk/scm/plugin.scm 2005-01-18 18:46:31 UTC (rev 327)
@@ -99,7 +99,7 @@
(define currently-loading-module-name #f)
;;
-;; TODO: write test
+;; TODO: write test for load-plugin
;; returns whether initialization is succeeded
(define require-module
(lambda (module-name)
Modified: trunk/test/test-custom.scm
===================================================================
--- trunk/test/test-custom.scm 2005-01-18 13:24:58 UTC (rev 326)
+++ trunk/test/test-custom.scm 2005-01-18 18:46:31 UTC (rev 327)
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; This file is tested with revision 282 of new repository
+;; This file is tested with revision 327 of new repository
;; TODO:
;;
@@ -1439,8 +1439,33 @@
(assert-true (uim-bool '(symbol-bound? 'test-style)))
(assert-equal 'test-style-ddskk
- (uim 'test-style)))
+ (uim 'test-style))
+ (assert-equal '(global)
+ (uim '(custom-groups 'test-style)))
+ (assert-equal '(test-style-uim test-style-ddskk test-style-canna)
+ (uim '(custom-range 'test-style)))
+ (assert-equal "Test style"
+ (uim '(custom-label 'test-style)))
+ ;; overwriting definition
+ (uim '(define-custom 'test-style 'test-style-uim
+ '(global-keys)
+ '(choice
+ (test-style-canna "canna like" "Similar to canna")
+ (test-style-uim "uim" "uim native"))
+ "Test style (overwritten)"
+ "long description will be here."))
+
+ (assert-true (uim-bool '(symbol-bound? 'test-style)))
+ (assert-equal 'test-style-ddskk
+ (uim 'test-style))
+ (assert-equal '(global-keys)
+ (uim '(custom-groups 'test-style)))
+ (assert-equal '(test-style-canna test-style-uim)
+ (uim '(custom-range 'test-style)))
+ (assert-equal "Test style (overwritten)"
+ (uim '(custom-label 'test-style))))
+
("test define-custom (choice) #2"
(uim '(define test-style 'test-style-uim))
@@ -1529,6 +1554,14 @@
(skk "SKK" "SKK"))
"Test avalilable IMs"
"long description will be here."))
+ (uim '(define-custom 'test-null-ims ()
+ '(global)
+ '(ordered-list
+ (anthy "Anthy" "Anthy")
+ (canna "Cannd" "Canna")
+ (skk "SKK" "SKK"))
+ "Test avalilable IMs"
+ "long description will be here."))
(uim '(define-custom 'test-cancel-key '("<Control>g" "escape")
'(global)
'(key)
@@ -1544,11 +1577,21 @@
'(key)
"test bar key"
"long description will be here."))
+ (uim '(define-custom 'test-null-key ()
+ '(global)
+ '(key)
+ "test null key"
+ "long description will be here."))
(uim '(define-custom 'test-use-candidate-window? #t
'(test ui)
'(boolean)
"Use candidate window"
"long description will be here."))
+ (uim '(define-custom 'test-use-with-vi? #f
+ '(test ui)
+ '(boolean)
+ "Use with vi"
+ "long description will be here."))
(uim '(define-custom 'test-nr-candidate-max 10
'(test advanced ui)
'(integer 1 20)
@@ -2049,10 +2092,16 @@
(uim '(custom-value-as-literal 'test-style)))
(assert-equal "'(anthy canna skk)"
(uim '(custom-value-as-literal 'test-available-ims)))
+ (assert-equal "'()"
+ (uim '(custom-value-as-literal 'test-null-ims)))
(assert-equal "'(\"<Control>g\" \"escape\")"
(uim '(custom-value-as-literal 'test-cancel-key)))
+ (assert-equal "'()"
+ (uim '(custom-value-as-literal 'test-null-key)))
(assert-equal "#t"
(uim '(custom-value-as-literal 'test-use-candidate-window?)))
+ (assert-equal "#f"
+ (uim '(custom-value-as-literal 'test-use-with-vi?)))
(assert-equal "10"
(uim '(custom-value-as-literal 'test-nr-candidate-max)))
(assert-equal "\"a string\""
@@ -2065,10 +2114,16 @@
(uim '(custom-definition-as-literal 'test-style)))
(assert-equal "(define test-available-ims '(anthy canna skk))"
(uim '(custom-definition-as-literal 'test-available-ims)))
+ (assert-equal "(define test-null-ims '())"
+ (uim '(custom-definition-as-literal 'test-null-ims)))
(assert-equal "(define test-cancel-key '(\"<Control>g\" \"escape\"))\n(define-key test-cancel-key? '(\"<Control>g\" \"escape\"))"
(uim '(custom-definition-as-literal 'test-cancel-key)))
+ (assert-equal "(define test-null-key '())\n(define-key test-null-key? '())"
+ (uim '(custom-definition-as-literal 'test-null-key)))
(assert-equal "(define test-use-candidate-window? #t)"
(uim '(custom-definition-as-literal 'test-use-candidate-window?)))
+ (assert-equal "(define test-use-with-vi? #f)"
+ (uim '(custom-definition-as-literal 'test-use-with-vi?)))
(assert-equal "(define test-nr-candidate-max 10)"
(uim '(custom-definition-as-literal 'test-nr-candidate-max)))
(assert-equal "(define test-string \"a string\")"
Modified: trunk/test/test-im.scm
===================================================================
--- trunk/test/test-im.scm 2005-01-18 13:24:58 UTC (rev 326)
+++ trunk/test/test-im.scm 2005-01-18 18:46:31 UTC (rev 327)
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; This file is tested with revision 1648
+;; This file is tested with revision 327 of new repository
(use test.unit)
@@ -52,6 +52,7 @@
(uim '(define prev-im #f))
(uim '(define prev-nr-ims (length im-list)))
(uim '(define test-im-init-args #f))
+ (uim '(define test-im-alt-init-args #f))
(uim '(begin
(set! test-im-init-args (list 'test-im
"ja"
@@ -68,25 +69,122 @@
direct-get-candidate-handler
direct-set-candidate-index-handler
context-prop-activate-handler))
+ (set! test-im-alt-init-args (list 'test-im
+ "en"
+ "en_US.UTF-8"
+ "an alternative label"
+ "an alternative short desc"
+ 'alt-arg
+ 'alt-init-handler
+ 'alt-release-handler
+ 'alt-mode-handler
+ 'alt-key-press-handler
+ 'alt-key-release-handler
+ 'alt-reset-handler
+ 'alt-get-candidate-handler
+ 'alt-set-candidate-index-handler
+ 'alt-prop-activate-handler))
#t))))
+ ("test normalize-im-list"
+ (uim '(set! im-list (remove (lambda (im)
+ (not (eq? (im-name im)
+ 'direct)))
+ im-list)))
+ (assert-equal '(direct)
+ (uim '(map im-name im-list)))
+ ;; direct IM always remains at head
+ (assert-true (uim-bool '(apply register-im test-im-init-args)))
+ (assert-equal '(direct test-im)
+ (uim '(map im-name im-list)))
+ ;; other IMs are cons'ed at right of direct
+ (assert-true (uim-bool '(apply register-im (cons 'test-im2
+ (cdr test-im-init-args)))))
+ (assert-equal '(direct test-im2 test-im)
+ (uim '(map im-name im-list)))
+ ;; direct IM can be registered to null list
+ (uim '(set! im-list ()))
+ ;; second time im-register-im for 'direct returns #f
+ (assert-false (uim-bool '(apply register-im (cons 'direct
+ (cdr test-im-init-args)))))
+ (assert-equal '(direct)
+ (uim '(map im-name im-list)))
+ ;; ordinary IM can be registered to null list
+ (uim '(set! im-list ()))
+ ;; second time im-register-im for 'test-im returns #f
+ (assert-false (uim-bool '(apply register-im test-im-init-args)))
+ (assert-equal '(test-im)
+ (uim '(map im-name im-list))))
+
("test register-im"
- (uim '(begin
- (apply register-im test-im-init-args)
- #t))
-
+ (assert-true (uim-bool '(apply register-im test-im-init-args)))
(assert-equal (+ (uim 'prev-nr-ims) 1)
(uim '(length im-list)))
(assert-equal 'test-im
(uim '(im-name (retrieve-im 'test-im #f))))
+ (assert-false (uim-bool '(im-module-name (retrieve-im 'test-im #f))))
(assert-equal 16
(uim '(length (retrieve-im 'test-im #f))))
+ (uim '(im-set-module-name! (retrieve-im 'test-im #f) "foo"))
+ (assert-equal "foo"
+ (uim '(im-module-name (retrieve-im 'test-im #f))))
- ;; duplicate register will be rejected
- (assert-false (uim-bool '(apply register-im test-im-init-args)))
+ ;; duplicate register overwrites preexisting one
+ (assert-false (uim-bool '(apply register-im test-im-alt-init-args)))
(assert-equal (+ (uim 'prev-nr-ims) 1)
- (uim '(length im-list))))
+ (uim '(length im-list)))
+ (assert-equal '(test-im
+ "en"
+ "en_US.UTF-8"
+ "an alternative label"
+ "an alternative short desc"
+ alt-arg
+ alt-init-handler
+ alt-release-handler
+ alt-mode-handler
+ alt-key-press-handler
+ alt-key-release-handler
+ alt-reset-handler
+ alt-get-candidate-handler
+ alt-set-candidate-index-handler
+ alt-prop-activate-handler
+ ()) ;; replace with #f for R5RS compliant interpreter
+ (uim '(retrieve-im 'test-im #f)))
+ ;; subsequent registration that has different im-name will be
+ ;; registered as another IM
+ (assert-true (uim-bool '(apply register-im
+ (cons 'test-im2
+ (cdr test-im-alt-init-args)))))
+ (assert-equal (+ (uim 'prev-nr-ims) 2)
+ (uim '(length im-list)))
+ (assert-equal '(test-im2
+ "en"
+ "en_US.UTF-8"
+ "an alternative label"
+ "an alternative short desc"
+ alt-arg
+ alt-init-handler
+ alt-release-handler
+ alt-mode-handler
+ alt-key-press-handler
+ alt-key-release-handler
+ alt-reset-handler
+ alt-get-candidate-handler
+ alt-set-candidate-index-handler
+ alt-prop-activate-handler
+ ()) ;; replace with #f for R5RS compliant interpreter
+ (uim '(retrieve-im 'test-im2 #f))))
+ ("test register-im (module-name)"
+ (assert-true (uim-bool '(apply register-im test-im-init-args)))
+ (assert-false (uim-bool '(im-module-name (retrieve-im 'test-im #f))))
+
+ (uim '(set! currently-loading-module-name "foo"))
+ (assert-true (uim-bool '(apply register-im (cons 'test-im2
+ (cdr test-im-init-args)))))
+ (assert-equal "foo"
+ (uim '(im-module-name (retrieve-im 'test-im2 #f)))))
+
("test retrieve-im"
(assert-false (uim-bool '(retrieve-im 'nonexistent)))
(assert-equal 'direct
@@ -739,3 +837,16 @@
("test set-candidate-index"
)
)
+
+(define-uim-test-case "testcase im im-custom"
+ ("test custom-im-list-as-choice-rec"
+ (assert-equal '((canna "Canna" "Japanese Kana Kanji Conversion Engine, Canna")
+ (skk "SKK" "Uim's SKK like input method")
+ (anthy "Anthy" "Japanese Kana Kanji Conversion Engine, Anthy"))
+ (uim '(custom-im-list-as-choice-rec
+ (map retrieve-im '(canna skk anthy)))))
+ (assert-equal '((tcode "T-Code" "T-Code"))
+ (uim '(custom-im-list-as-choice-rec
+ (map retrieve-im '(tcode)))))
+ (assert-equal ()
+ (uim '(custom-im-list-as-choice-rec ())))))
Added: trunk/test/test-lazy-load.scm
===================================================================
--- trunk/test/test-lazy-load.scm 2005-01-18 13:24:58 UTC (rev 326)
+++ trunk/test/test-lazy-load.scm 2005-01-18 18:46:31 UTC (rev 327)
@@ -0,0 +1,244 @@
+#!/usr/bin/env gosh
+
+;;; Copyright (c) 2005 uim Project http://uim.freedesktop.org/
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+;;; 2. Redistributions in binary form must reproduce the above copyright
+;;; notice, this list of conditions and the following disclaimer in the
+;;; documentation and/or other materials provided with the distribution.
+;;; 3. Neither the name of authors nor the names of its contributors
+;;; may be used to endorse or promote products derived from this software
+;;; without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+;;; SUCH DAMAGE.
+;;;;
+
+;; This file is tested with revision 327 of new repository
+
+(use test.unit)
+
+(require "test/uim-test-utils")
+
+(define-uim-test-case "testcase stub-im"
+ (setup
+ (lambda ()
+ (uim '(require "lazy-load.scm"))))
+
+ ("test stub-im-generate-init-handler"
+ (uim '(set! im-list ()))
+ (uim '(undefine *hangul.scm-loaded*))
+ (assert-false (uim-bool '(symbol-bound? '*hangul.scm-loaded*)))
+ (uim '(define init-handler (stub-im-generate-init-handler 'hangul2
+ "hangul")))
+ (assert-true (uim-bool '(procedure? init-handler)))
+ (assert-false (uim-bool '(retrieve-im 'hangul2)))
+ (uim '(define test-context (init-handler 0 #f #f)))
+ (assert-equal 'hangul2
+ (uim '(im-name (retrieve-im 'hangul2))))
+ (assert-equal "hangul"
+ (uim '(im-module-name (retrieve-im 'hangul2))))
+ (assert-equal 'hangul2
+ (uim '(im-name (context-im test-context))))
+ (assert-equal "hangul"
+ (uim '(im-module-name (context-im test-context)))))
+
+ ("test register-stub-im"
+ (uim '(set! im-list ()))
+ (uim '(undefine *hangul.scm-loaded*))
+ (assert-false (uim-bool '(symbol-bound? '*hangul.scm-loaded*)))
+ (uim '(register-stub-im
+ 'hangul2
+ "ko"
+ "UTF-8"
+ "Hangul (2-bul)"
+ "2-bul style hangul input method"
+ "hangul"))
+ (uim '(define init-handler (im-init-handler (retrieve-im 'hangul2))))
+ (uim '(im-set-init-handler! (retrieve-im 'hangul2) 'init))
+ (assert-equal '(hangul2
+ "ko"
+ "UTF-8"
+ "Hangul (2-bul)"
+ "2-bul style hangul input method"
+ ;; replace () with #f for R5RS compliant interpreter
+ () ;; arg
+ init
+ () ;; release-handler
+ () ;; mode-handler
+ () ;; press-key-handler
+ () ;; release-key-handler
+ () ;; reset-handler
+ () ;; get-candidate-handler
+ () ;; set-candidate-index-handler
+ () ;; prop-activate-handler
+ "hangul")
+ (uim '(retrieve-im 'hangul2)))
+ (uim '(im-set-init-handler! (retrieve-im 'hangul2) init-handler))
+
+ (assert-true (uim-bool '(procedure? (im-init-handler
+ (retrieve-im 'hangul2)))))
+ ;; to prevent SEGV on create-context
+ (uim '(define im-update-preedit (lambda arg #f)))
+ (uim '(define im-pushback-preedit (lambda arg #f)))
+
+ (uim '(create-context 0 #f 'hangul2))
+ (uim '(define test-context (find-context 0)))
+ (assert-equal 'hangul2
+ (uim '(im-name (context-im test-context))))
+ (assert-equal "hangul"
+ (uim '(im-module-name (context-im test-context))))
+ (uim '(define test-hangul2 (retrieve-im 'hangul2)))
+ (assert-equal 'hangul2
+ (uim '(im-name test-hangul2)))
+ (assert-equal "hangul"
+ (uim '(im-module-name test-hangul2)))
+ (assert-true (uim-bool '(procedure? (im-init-handler test-hangul2))))
+ (assert-false (uim-bool '(procedure? (im-release-handler test-hangul2))))
+ (assert-true (uim-bool '(procedure? (im-mode-handler test-hangul2))))
+ (assert-true (uim-bool '(procedure? (im-key-press-handler test-hangul2))))
+ (assert-true (uim-bool '(procedure? (im-key-release-handler test-hangul2))))
+ (assert-true (uim-bool '(procedure? (im-reset-handler test-hangul2))))
+ (assert-true (uim-bool '(procedure? (im-get-candidate-handler test-hangul2))))
+ (assert-true (uim-bool '(procedure? (im-set-candidate-index-handler test-hangul2))))
+ (assert-true (uim-bool '(procedure? (im-prop-activate-handler test-hangul2)))))
+
+ ("test stub-im-generate-stub-im-list"
+ (uim '(set! im-list ()))
+ (uim '(undefine *tcode.scm-loaded*))
+ (uim '(undefine *hangul.scm-loaded*))
+ (assert-false (uim-bool '(symbol-bound? '*tcode.scm-loaded*)))
+ (assert-false (uim-bool '(symbol-bound? '*hangul.scm-loaded*)))
+ (assert-false (uim-bool '(retrieve-im 'tcode)))
+ (assert-false (uim-bool '(retrieve-im 'hangul2)))
+ (assert-false (uim-bool '(retrieve-im 'hangul3)))
+
+ (assert-equal ()
+ (uim '(stub-im-generate-stub-im-list ())))
+ (assert-equal (list
+ (string-append
+ "(if (and (symbol-bound? '*lazy-load.scm-loaded*)\n"
+ " (member 'hangul2 enabled-im-list))\n"
+ " (register-stub-im\n"
+ " 'hangul2\n"
+ " \"ko\"\n"
+ " \"UTF-8\"\n"
+ " \"Hangul (2-bul)\"\n"
+ " \"2-bul style hangul input method\"\n"
+ " \"hangul\"))\n"))
+ (uim '(stub-im-generate-stub-im-list '(hangul2))))
+ (assert-equal (list
+ (string-append
+ "(if (and (symbol-bound? '*lazy-load.scm-loaded*)\n"
+ " (member 'hangul3 enabled-im-list))\n"
+ " (register-stub-im\n"
+ " 'hangul3\n"
+ " \"ko\"\n"
+ " \"UTF-8\"\n"
+ " \"Hangul (3-bul)\"\n"
+ " \"3-bul style hangul input method\"\n"
+ " \"hangul\"))\n"))
+ (uim '(stub-im-generate-stub-im-list '(hangul3))))
+ (assert-equal (list
+ (string-append
+ "(if (and (symbol-bound? '*lazy-load.scm-loaded*)\n"
+ " (member 'tcode enabled-im-list))\n"
+ " (register-stub-im\n"
+ " 'tcode\n"
+ " \"ja\"\n"
+ " \"EUC-JP\"\n"
+ " \"T-Code\"\n"
+ " \"T-Code\"\n"
+ " \"tcode\"))\n"))
+ (uim '(stub-im-generate-stub-im-list '(tcode))))
+
+ (assert-equal (list
+ (string-append
+ "(if (and (symbol-bound? '*lazy-load.scm-loaded*)\n"
+ " (member 'hangul2 enabled-im-list))\n"
+ " (register-stub-im\n"
+ " 'hangul2\n"
+ " \"ko\"\n"
+ " \"UTF-8\"\n"
+ " \"Hangul (2-bul)\"\n"
+ " \"2-bul style hangul input method\"\n"
+ " \"hangul\"))\n")
+ (string-append
+ "(if (and (symbol-bound? '*lazy-load.scm-loaded*)\n"
+ " (member 'tcode enabled-im-list))\n"
+ " (register-stub-im\n"
+ " 'tcode\n"
+ " \"ja\"\n"
+ " \"EUC-JP\"\n"
+ " \"T-Code\"\n"
+ " \"T-Code\"\n"
+ " \"tcode\"))\n")
+ (string-append
+ "(if (and (symbol-bound? '*lazy-load.scm-loaded*)\n"
+ " (member 'hangul3 enabled-im-list))\n"
+ " (register-stub-im\n"
+ " 'hangul3\n"
+ " \"ko\"\n"
+ " \"UTF-8\"\n"
+ " \"Hangul (3-bul)\"\n"
+ " \"3-bul style hangul input method\"\n"
+ " \"hangul\"))\n"))
+ (uim '(stub-im-generate-stub-im-list '(hangul2 tcode hangul3)))))
+
+ ("test stub-im-generate-all-stub-im-list"
+ (uim '(set! im-list (filter (lambda (im)
+ (case (im-name im)
+ ((hangul2 hangul3 tcode) #t)
+ (else #f)))
+ im-list)))
+ (assert-equal (list
+ (string-append
+ "(if (and (symbol-bound? '*lazy-load.scm-loaded*)\n"
+ " (member 'tcode enabled-im-list))\n"
+ " (register-stub-im\n"
+ " 'tcode\n"
+ " \"ja\"\n"
+ " \"EUC-JP\"\n"
+ " \"T-Code\"\n"
+ " \"T-Code\"\n"
+ " \"tcode\"))\n")
+ (string-append
+ "(if (and (symbol-bound? '*lazy-load.scm-loaded*)\n"
+ " (member 'hangul2 enabled-im-list))\n"
+ " (register-stub-im\n"
+ " 'hangul2\n"
+ " \"ko\"\n"
+ " \"UTF-8\"\n"
+ " \"Hangul (2-bul)\"\n"
+ " \"2-bul style hangul input method\"\n"
+ " \"hangul\"))\n")
+ (string-append
+ "(if (and (symbol-bound? '*lazy-load.scm-loaded*)\n"
+ " (member 'hangul3 enabled-im-list))\n"
+ " (register-stub-im\n"
+ " 'hangul3\n"
+ " \"ko\"\n"
+ " \"UTF-8\"\n"
+ " \"Hangul (3-bul)\"\n"
+ " \"3-bul style hangul input method\"\n"
+ " \"hangul\"))\n"))
+ (uim '(stub-im-generate-all-stub-im-list)))
+
+ (uim '(set! im-list ()))
+ (assert-equal ()
+ (uim '(stub-im-generate-all-stub-im-list)))))
Added: trunk/test/test-plugin.scm
===================================================================
--- trunk/test/test-plugin.scm 2005-01-18 13:24:58 UTC (rev 326)
+++ trunk/test/test-plugin.scm 2005-01-18 18:46:31 UTC (rev 327)
@@ -0,0 +1,79 @@
+#!/usr/bin/env gosh
+
+;;; Copyright (c) 2005 uim Project http://uim.freedesktop.org/
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+;;; 2. Redistributions in binary form must reproduce the above copyright
+;;; notice, this list of conditions and the following disclaimer in the
+;;; documentation and/or other materials provided with the distribution.
+;;; 3. Neither the name of authors nor the names of its contributors
+;;; may be used to endorse or promote products derived from this software
+;;; without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+;;; SUCH DAMAGE.
+;;;;
+
+;; This file is tested with revision 327 of new repository
+
+(use test.unit)
+
+(require "test/uim-test-utils")
+
+(define-uim-test-case "testcase module"
+ (setup
+ (lambda ()
+ (uim '(begin
+ ))))
+
+ ("test require-module"
+ (uim '(set! im-list ()))
+ (uim '(undefine *tcode.scm-loaded*))
+ (uim '(undefine *hangul.scm-loaded*))
+ (assert-false (uim-bool '(symbol-bound? '*tcode.scm-loaded*)))
+ (assert-false (uim-bool '(symbol-bound? '*hangul.scm-loaded*)))
+ (assert-false (uim-bool '(retrieve-im 'tcode)))
+ (assert-false (uim-bool '(retrieve-im 'hangul2)))
+ ;; im-module-name == im-name
+ (assert-true (uim-bool '(require-module "tcode")))
+ (assert-equal 'tcode
+ (uim '(im-name (retrieve-im 'tcode))))
+ (assert-equal "tcode"
+ (uim '(im-module-name (retrieve-im 'tcode))))
+ ;; im-module-name != im-name
+ (assert-true (uim-bool '(require-module "hangul")))
+ (assert-equal 'hangul2
+ (uim '(im-name (retrieve-im 'hangul2))))
+ (assert-equal "hangul"
+ (uim '(im-module-name (retrieve-im 'hangul2))))
+ ;; raw require does not set im-module-name
+ (uim '(set! im-list ()))
+ (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")))
+ (assert-equal 'tcode
+ (uim '(im-name (retrieve-im 'tcode))))
+ (assert-false (uim-bool '(im-module-name (retrieve-im 'tcode))))
+ ;; nonexistent module
+ ;; TODO: suppress "ERROR:" message in try-require
+ ;;(assert-false (uim-bool '(require-module "nonexistent")))
+
+ ;; TODO: test load-plugin (requires complete unload-plugin
+ ;; implementation)
+ ))
More information about the Uim-commit
mailing list