Revision: 6907
Author: ek.kato
Date: Thu Jan 6 17:50:39 2011
Log: * Merge r6906 from trunk.
http://code.google.com/p/uim/source/detail?r=6907
Added:
/branches/1.6/test/broken-test-db.scm
Deleted:
/branches/1.6/test/test-db.scm
Modified:
/branches/1.6/test/test-im.scm
/branches/1.6/test/test-lazy-load.scm
/branches/1.6/test/test-plugin.scm
=======================================
--- /dev/null
+++ /branches/1.6/test/broken-test-db.scm Thu Jan 6 17:50:39 2011
@@ -0,0 +1,107 @@
+#! /usr/bin/env gosh
+
+;;; Copyright (c) 2005-2010 uim Project http://code.google.com/p/uim/
+;;;
+;;; 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 COPYRIGHT HOLDERS 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 COPYRIGHT HOLDERS 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.
+;;;;
+
+;; uim-db.scm is not ported to and does not work on SigScheme-based uim.
+
+
+; Tests for uim-db requires debugging information, so we have to let
+; libuim load this file and give it a toplevel procedure.
+
+(define test-db-find
+ (lambda ()
+ (if (feature? 'debug)
+ (begin
+ (let ((check
+ (lambda (code)
+ (eq? (cdr code)
+ (uim-db-find
+ (dbg-get-file code)
+ (+ 1 (dbg-get-line code)))))))
+ (let* ((q quote))
+ (let name ((code (q (place-holder
+ (target)))))
+ (uim-db-set-break! (dbg-get-file check)
+ (dbg-get-line check))
+ (check code)))))
+ #t)))
+
+; Certain functions in uim-db.scm are not allowed to call scheme
+; functions in other files. Otherwise setting a breakpoint to the
+; function being used may cause an infinite recursion.
+(define test-db-dep
+ (lambda ()
+ (letrec ((exclude
+ '(dbg-closures)) ; don't follow these symbols
+ (dependent?
+ (lambda (datum)
+ (case (typeof datum)
+ ((tc_closure)
+ (or (if (or (null? (dbg-get-info datum))
+ (string=? (dbg-get-file datum)
+ (dbg-expand-file-name "uim-db.scm")))
+ #f
+ ; gosh doesn't recognize "#<CLOSURE arg...>"
+ (%%closure-code datum))
+ (dependent? (cddr (%%closure-code datum)))))
+ ((tc_symbol)
+ (and (symbol-bound? datum)
+ (not (memq datum exclude))
+ (begin
+ (set! exclude (cons datum exclude))
+ (dependent? (eval datum)))))
+ ((tc_cons)
+ (or (dependent? (car datum))
+ (dependent? (cdr datum))))
+ (else #f)))))
+ (if (feature? 'debug)
+ (any dependent?
+ (cdr (srfi-assoc (dbg-expand-file-name "uim-db.scm")
+ dbg-closures
+ string=?)))
+ #f))))
+
+; shadow this part from libuim
+(if (and (not (symbol-bound? 'uim-sh))
+ #f) ;; disable this test until uim-db.scm is ported to SigScheme
+ (begin
+ (use test.unit)
+
+ (require "test/uim-test-utils")
+
+ (define-uim-test-case "testcase debugger"
+ (setup
+ (lambda ()
+ (uim '(begin (load "../test/test-db.scm")
+ (load "uim-db.scm")))))
+ ("test uim-db-find"
+ (assert-true (uim-bool '(test-db-find))))
+ ("test for external dependency"
+ (assert-false (uim-bool '(test-db-dep)))))))
=======================================
--- /branches/1.6/test/test-db.scm Sun Apr 4 20:35:54 2010
+++ /dev/null
@@ -1,107 +0,0 @@
-#! /usr/bin/env gosh
-
-;;; Copyright (c) 2005-2010 uim Project http://code.google.com/p/uim/
-;;;
-;;; 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 COPYRIGHT HOLDERS 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 COPYRIGHT HOLDERS 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.
-;;;;
-
-;; uim-db.scm is not ported to and does not work on SigScheme-based uim.
-
-
-; Tests for uim-db requires debugging information, so we have to let
-; libuim load this file and give it a toplevel procedure.
-
-(define test-db-find
- (lambda ()
- (if (feature? 'debug)
- (begin
- (let ((check
- (lambda (code)
- (eq? (cdr code)
- (uim-db-find
- (dbg-get-file code)
- (+ 1 (dbg-get-line code)))))))
- (let* ((q quote))
- (let name ((code (q (place-holder
- (target)))))
- (uim-db-set-break! (dbg-get-file check)
- (dbg-get-line check))
- (check code)))))
- #t)))
-
-; Certain functions in uim-db.scm are not allowed to call scheme
-; functions in other files. Otherwise setting a breakpoint to the
-; function being used may cause an infinite recursion.
-(define test-db-dep
- (lambda ()
- (letrec ((exclude
- '(dbg-closures)) ; don't follow these symbols
- (dependent?
- (lambda (datum)
- (case (typeof datum)
- ((tc_closure)
- (or (if (or (null? (dbg-get-info datum))
- (string=? (dbg-get-file datum)
- (dbg-expand-file-name "uim-db.scm")))
- #f
- ; gosh doesn't recognize "#<CLOSURE arg...>"
- (%%closure-code datum))
- (dependent? (cddr (%%closure-code datum)))))
- ((tc_symbol)
- (and (symbol-bound? datum)
- (not (memq datum exclude))
- (begin
- (set! exclude (cons datum exclude))
- (dependent? (eval datum)))))
- ((tc_cons)
- (or (dependent? (car datum))
- (dependent? (cdr datum))))
- (else #f)))))
- (if (feature? 'debug)
- (any dependent?
- (cdr (srfi-assoc (dbg-expand-file-name "uim-db.scm")
- dbg-closures
- string=?)))
- #f))))
-
-; shadow this part from libuim
-(if (and (not (symbol-bound? 'uim-sh))
- #f) ;; disable this test until uim-db.scm is ported to SigScheme
- (begin
- (use test.unit)
-
- (require "test/uim-test-utils")
-
- (define-uim-test-case "testcase debugger"
- (setup
- (lambda ()
- (uim '(begin (load "../test/test-db.scm")
- (load "uim-db.scm")))))
- ("test uim-db-find"
- (assert-true (uim-bool '(test-db-find))))
- ("test for external dependency"
- (assert-false (uim-bool '(test-db-dep)))))))
=======================================
--- /branches/1.6/test/test-im.scm Tue Jul 27 22:42:55 2010
+++ /branches/1.6/test/test-im.scm Thu Jan 6 17:50:39 2011
@@ -54,7 +54,7 @@
(require-module "anthy")
(require-module "canna")
(require-module "skk")
- (require-module "tcode")
+ (require-module "latin")
;; Disable IMs that affect the default IM selection.
(define test-im-disabled-im-list '(look
m17n-unicode
@@ -286,14 +286,11 @@
(assert-false (uim-bool '(memq 'nonexistent (map car im-list))))
(assert-true (uim-bool '(memq 'anthy (map car im-list))))
(assert-true (uim-bool '(memq 'skk (map car im-list))))
- (assert-true (uim-bool '(memq 'tcode (map car im-list))))
+ (assert-true (uim-bool '(memq 'latin(map car im-list))))
(assert-true (uim-bool '(memq 'tutcode (map car im-list))))
(assert-true (uim-bool '(memq 'py (map car im-list))))
(assert-true (uim-bool '(memq 'pyunihan (map car im-list))))
(assert-true (uim-bool '(memq 'pinyin-big5 (map car im-list))))
- (assert-true (uim-bool '(memq 'hangul2 (map car im-list))))
- (assert-true (uim-bool '(memq 'hangul3 (map car im-list))))
- (assert-true (uim-bool '(memq 'romaja (map car im-list))))
(assert-true (uim-bool '(memq 'viqr (map car im-list))))
(assert-true (uim-bool '(memq 'ipa-x-sampa (map car im-list))))
(assert-true (uim-bool '(memq 'direct (map car im-list))))
@@ -481,14 +478,12 @@
(uim '(im-name (find-im 'anthy #f))))
(assert-equal 'skk
(uim '(im-name (find-im 'skk #f))))
- (assert-equal 'tcode
- (uim '(im-name (find-im 'tcode #f))))
+ (assert-equal 'latin
+ (uim '(im-name (find-im 'latin #f))))
(assert-equal 'py
(uim '(im-name (find-im 'py #f))))
(assert-equal 'pinyin-big5
(uim '(im-name (find-im 'pinyin-big5 #f))))
- (assert-equal 'hangul2
- (uim '(im-name (find-im 'hangul2 #f))))
(assert-equal 'pyunihan
(uim '(im-name (find-im 'pyunihan #f))))
;; implicit selection by locale information
@@ -538,14 +533,12 @@
(uim '(im-name (find-im 'anthy #f))))
(assert-equal 'skk
(uim '(im-name (find-im 'skk #f))))
- (assert-equal 'tcode
- (uim '(im-name (find-im 'tcode #f))))
+ (assert-equal 'latin
+ (uim '(im-name (find-im 'latin #f))))
(assert-equal 'py
(uim '(im-name (find-im 'py #f))))
(assert-equal 'pinyin-big5
(uim '(im-name (find-im 'pinyin-big5 #f))))
- (assert-equal 'hangul2
- (uim '(im-name (find-im 'hangul2 #f))))
(assert-equal 'pyunihan
(uim '(im-name (find-im 'pyunihan #f))))
(assert-equal 'pyunihan
@@ -582,14 +575,12 @@
(uim '(im-name (find-im 'anthy #f))))
(assert-equal 'skk
(uim '(im-name (find-im 'skk #f))))
- (assert-equal 'tcode
- (uim '(im-name (find-im 'tcode #f))))
+ (assert-equal 'latin
+ (uim '(im-name (find-im 'latin #f))))
(assert-equal 'py
(uim '(im-name (find-im 'py #f))))
(assert-equal 'pinyin-big5
(uim '(im-name (find-im 'pinyin-big5 #f))))
- (assert-equal 'hangul2
- (uim '(im-name (find-im 'hangul2 #f))))
(assert-equal 'pyunihan
(uim '(im-name (find-im 'pyunihan #f))))
(assert-equal 'pyunihan
@@ -626,14 +617,12 @@
(uim '(im-name (find-im 'anthy #f))))
(assert-equal 'skk
(uim '(im-name (find-im 'skk #f))))
- (assert-equal 'tcode
- (uim '(im-name (find-im 'tcode #f))))
+ (assert-equal 'latin
+ (uim '(im-name (find-im 'latin #f))))
(assert-equal 'py
(uim '(im-name (find-im 'py #f))))
(assert-equal 'pinyin-big5
(uim '(im-name (find-im 'pinyin-big5 #f))))
- (assert-equal 'hangul2
- (uim '(im-name (find-im 'hangul2 #f))))
(assert-equal 'pyunihan
(uim '(im-name (find-im 'pyunihan #f))))
(assert-equal 'pyunihan
@@ -664,7 +653,7 @@
(uim '(for-each require-module installed-im-module-list))
(uim '(define test-im-anthy #f))
(uim '(define test-im-skk #f))
- (uim '(define test-im-tcode #f))
+ (uim '(define test-im-latin #f))
(uim '(begin
(set! test-im-anthy (assq 'anthy im-list))
#t))
@@ -672,24 +661,24 @@
(set! test-im-skk (assq 'skk im-list))
#t))
(uim '(begin
- (set! test-im-tcode (assq 'tcode im-list))
+ (set! test-im-latin (assq 'latin im-list))
#t))
(uim '(begin
(set! im-list (list test-im-anthy
test-im-skk
- test-im-tcode))
+ test-im-latin))
#t))
(uim '(begin
- (set! enabled-im-list '(anthy skk tcode))
+ (set! enabled-im-list '(anthy skk latin))
#t))))
("test next-im"
(assert-equal 'skk
(uim '(next-im 'anthy)))
- (assert-equal 'tcode
+ (assert-equal 'latin
(uim '(next-im 'skk)))
(assert-equal 'anthy
- (uim '(next-im 'tcode)))
+ (uim '(next-im 'latin)))
(assert-equal 'anthy
(uim '(next-im 'non-existent))))
@@ -701,14 +690,14 @@
; ;; object in C world is missing
; ;(uim '(create-context 0 #f 'anthy))
; ;(uim '(create-context 1 #f 'skk))
-; ;(uim '(create-context 2 #f 'tcode))
+; ;(uim '(create-context 2 #f 'latin))
; (assert-equal 'anthy
; (uim '(im-name current-im)))
; ;; switch-im fails because create-context fails
-; ;(uim '(switch-im 1 'tcode))
-; (assert-equal 'tcode
+; ;(uim '(switch-im 1 'latin))
+; (assert-equal 'latin
; (uim '(im-name current-im)))
-; (assert-equal 'tcode
+; (assert-equal 'latin
; (uim '(im-name (context-im (find-context 1)))))
; ;(uim '(switch-im 1 'skk))
; (assert-equal 'skk
@@ -724,7 +713,7 @@
;; define as hand-made data to avoid that implementation of
;; register-context affect other tests
(uim '(begin
- (set! context-list (list (im-new 1 (retrieve-im 'tcode))
+ (set! context-list (list (im-new 1 (retrieve-im 'latin))
(im-new 2 (retrieve-im 'direct))
(im-new 3 (retrieve-im 'skk))
(im-new 4 (retrieve-im 'anthy))))
@@ -741,7 +730,7 @@
(uim '(context-uc (nth 3 context-list)))))
("test context-im"
- (assert-equal 'tcode
+ (assert-equal 'latin
(uim '(im-name (context-im (nth 0 context-list)))))
(assert-equal 'direct
(uim '(im-name (context-im (nth 1 context-list)))))
@@ -757,7 +746,7 @@
(uim '(begin (remove-context (assv 3 context-list)) #t))
(assert-equal 3
(uim '(length context-list)))
- (assert-equal 'tcode
+ (assert-equal 'latin
(uim '(im-name (context-im (assv 1 context-list)))))
(assert-equal 'direct
(uim '(im-name (context-im (assv 2 context-list)))))
@@ -818,36 +807,36 @@
#t))
(assert-equal 5
(uim '(length context-list)))
- (assert-equal 'tcode
+ (assert-equal 'latin
(uim '(im-name (context-im (assv 1 context-list)))))
(assert-equal 'tutcode
(uim '(im-name (context-im (assv 5 context-list)))))
;; sparse id must be accepted
(uim '(begin
- (register-context (context-new 10 (find-im 'hangul2 #f)))
+ (register-context (context-new 10 (find-im 'py #f)))
#t))
(assert-equal 6
(uim '(length context-list)))
- (assert-equal 'hangul2
+ (assert-equal 'py
(uim '(im-name (context-im (assv 10 context-list)))))
;; additional sparse id
(uim '(begin
- (register-context (context-new 8 (find-im 'hangul3 #f)))
+ (register-context (context-new 8 (find-im 'pyunihan #f)))
#t))
(assert-equal 7
(uim '(length context-list)))
- (assert-equal 'hangul3
+ (assert-equal 'pyunihan
(uim '(im-name (context-im (assv 8 context-list)))))
;; decrimented id
(uim '(begin
- (register-context (context-new 0 (find-im 'romaja #f)))
+ (register-context (context-new 0 (find-im 'pinyin-big5 #f)))
#t))
(assert-equal 8
(uim '(length context-list)))
- (assert-equal 'romaja
+ (assert-equal 'pinyin-big5
(uim '(im-name (context-im (assv 0 context-list))))))
("test register-context (duplicate id)"
@@ -898,7 +887,7 @@
(require-module "anthy")
(require-module "canna")
(require-module "skk")
- (require-module "tcode")))))
+ (require-module "latin")))))
("test custom-im-list-as-choice-rec"
(assert-equal '((canna "Canna" "A multi-segment kana-kanji conversion
engine")
@@ -906,10 +895,10 @@
(anthy "Anthy" "A multi-segment kana-kanji conversion
engine"))
(uim '(custom-im-list-as-choice-rec
(map retrieve-im '(canna skk anthy)))))
- (assert-equal '((tcode
- "T-Code"
- "A kanji direct input method"))
+ (assert-equal '((latin
+ "Latin characters"
+ "Latin characters mainly used for Latin and Germanic
languages"))
(uim '(custom-im-list-as-choice-rec
- (map retrieve-im '(tcode)))))
+ (map retrieve-im '(latin)))))
(assert-equal ()
(uim '(custom-im-list-as-choice-rec ())))))
=======================================
--- /branches/1.6/test/test-lazy-load.scm Tue Jul 27 22:42:55 2010
+++ /branches/1.6/test/test-lazy-load.scm Thu Jan 6 17:50:39 2011
@@ -49,24 +49,24 @@
(uim-eval
'(begin
(set! im-list ())
- (undefine *hangul.scm-loaded*)))
- (assert-uim-false '(symbol-bound? '*hangul.scm-loaded*))
+ (undefine *pyload.scm-loaded*)))
+ (assert-uim-false '(symbol-bound? '*pyload.scm-loaded*))
(uim-eval
'(define init-handler
- (stub-im-generate-init-handler 'hangul2 "hangul")))
+ (stub-im-generate-init-handler 'py "pyload")))
(assert-uim-true '(procedure? init-handler))
- (assert-uim-false '(retrieve-im 'hangul2))
+ (assert-uim-false '(retrieve-im 'py))
(uim-eval
'(define test-context
(init-handler 0 #f #f)))
- (assert-uim-equal 'hangul2
- '(im-name (retrieve-im 'hangul2)))
- (assert-uim-equal "hangul"
- '(im-module-name (retrieve-im 'hangul2)))
- (assert-uim-equal 'hangul2
+ (assert-uim-equal 'py
+ '(im-name (retrieve-im 'py)))
+ (assert-uim-equal "pyload"
+ '(im-module-name (retrieve-im 'py)))
+ (assert-uim-equal 'py
'(im-name (context-im test-context)))
- (assert-uim-equal "hangul"
+ (assert-uim-equal "pyload"
'(im-module-name (context-im test-context)))
#f)
@@ -74,25 +74,25 @@
(uim-eval
'(begin
(set! im-list ())
- (undefine *hangul.scm-loaded*)))
- (assert-uim-false '(symbol-bound? '*hangul.scm-loaded*))
+ (undefine *pyload.scm-loaded*)))
+ (assert-uim-false '(symbol-bound? '*pyload.scm-loaded*))
(uim-eval
'(begin
(register-stub-im
- 'hangul2
- "ko"
+ 'py
+ "zh_CN"
"UTF-8"
- "Hangul (2-bul)"
- "2-bul style hangul input method"
- "hangul")
- (define init-handler (im-init-handler (retrieve-im 'hangul2)))
- (im-set-init-handler! (retrieve-im 'hangul2) 'init)))
- (assert-uim-equal '(hangul2
- "ko"
+ "New Pinyin (Simplified)"
+ "Pinyin input method (Simplified Chinese version)"
+ "pyload")
+ (define init-handler (im-init-handler (retrieve-im 'py)))
+ (im-set-init-handler! (retrieve-im 'py) 'init)))
+ (assert-uim-equal '(py
+ "zh_CN"
"UTF-8"
- "Hangul (2-bul)"
- "2-bul style hangul input method"
+ "New Pinyin (Simplified)"
+ "Pinyin input method (Simplified Chinese version)"
;; replace () with #f for R5RS compliant interpreter
#f ;; arg
init
@@ -109,12 +109,12 @@
#f ;; focus-out-handler
#f ;; place-handler
#f ;; displace-handler
- "hangul")
- '(retrieve-im 'hangul2))
- (uim-eval '(im-set-init-handler! (retrieve-im 'hangul2) init-handler))
+ "pyload")
+ '(retrieve-im 'py))
+ (uim-eval '(im-set-init-handler! (retrieve-im 'py) init-handler))
(assert-uim-true '(procedure? (im-init-handler
- (retrieve-im 'hangul2))))
+ (retrieve-im 'py))))
;; to prevent SEGV on create-context
(uim-eval
'(begin
@@ -127,142 +127,142 @@
(define im-pushback-mode-list (lambda arg #f))
(define im-update-mode-list (lambda arg #f))
(define im-update-mode (lambda arg #f))
- (create-context 0 #f 'hangul2)
+ (create-context 0 #f 'py)
(define test-context (assv 0 context-list))))
- (assert-uim-equal 'hangul2
+ (assert-uim-equal 'py
'(im-name (context-im test-context)))
- (assert-uim-equal "hangul"
+ (assert-uim-equal "pyload"
'(im-module-name (context-im test-context)))
- (uim-eval '(define test-hangul2 (retrieve-im 'hangul2)))
- (assert-uim-equal 'hangul2
- '(im-name test-hangul2))
- (assert-uim-equal "hangul"
- '(im-module-name test-hangul2))
- (assert-uim-true '(procedure? (im-init-handler test-hangul2)))
- (assert-uim-false '(procedure? (im-release-handler test-hangul2)))
- (assert-uim-true '(procedure? (im-mode-handler test-hangul2)))
- (assert-uim-true '(procedure? (im-key-press-handler test-hangul2)))
- (assert-uim-true '(procedure? (im-key-release-handler test-hangul2)))
- (assert-uim-true '(procedure? (im-reset-handler test-hangul2)))
- (assert-uim-true '(procedure? (im-get-candidate-handler test-hangul2)))
- (assert-uim-true '(procedure? (im-set-candidate-index-handler
test-hangul2)))
- (assert-uim-true '(procedure? (im-prop-activate-handler test-hangul2)))
+ (uim-eval '(define test-py (retrieve-im 'py)))
+ (assert-uim-equal 'py
+ '(im-name test-py))
+ (assert-uim-equal "pyload"
+ '(im-module-name test-py))
+ (assert-uim-true '(procedure? (im-init-handler test-py)))
+ (assert-uim-false '(procedure? (im-release-handler test-py)))
+ (assert-uim-true '(procedure? (im-mode-handler test-py)))
+ (assert-uim-true '(procedure? (im-key-press-handler test-py)))
+ (assert-uim-true '(procedure? (im-key-release-handler test-py)))
+ (assert-uim-true '(procedure? (im-reset-handler test-py)))
+ (assert-uim-true '(procedure? (im-get-candidate-handler test-py)))
+ (assert-uim-true '(procedure? (im-set-candidate-index-handler test-py)))
+ (assert-uim-true '(procedure? (im-prop-activate-handler test-py)))
#f)
(define (test-stub-im-generate-stub-im-list)
(uim-eval
'(begin
(set! im-list ())
- (undefine *tcode.scm-loaded*)
- (undefine *hangul.scm-loaded*)
- (set! installed-im-module-list '("tcode" "hangul"))))
- (assert-uim-false '(symbol-bound? '*tcode.scm-loaded*))
- (assert-uim-false '(symbol-bound? '*hangul.scm-loaded*))
-
- (assert-uim-false '(retrieve-im 'tcode))
- (assert-uim-false '(retrieve-im 'hangul2))
- (assert-uim-false '(retrieve-im 'hangul3))
+ (undefine *latin.scm-loaded*)
+ (undefine *pyload.scm-loaded*)
+ (set! installed-im-module-list '("latin" "pyload"))))
+ (assert-uim-false '(symbol-bound? '*latin.scm-loaded*))
+ (assert-uim-false '(symbol-bound? '*pyload.scm-loaded*))
+
+ (assert-uim-false '(retrieve-im 'latin))
+ (assert-uim-false '(retrieve-im 'py))
+ (assert-uim-false '(retrieve-im 'pyunihan))
(assert-uim-equal ()
'(stub-im-generate-stub-im-list ()))
(assert-uim-equal (list
(string-append
- " (hangul2\n"
- " \"ko\"\n"
+ " (py\n"
+ " \"zh_CN\"\n"
" \"UTF-8\"\n"
- " \"Hangul (2-beol)\"\n"
- " \"2-beol style hangul input method\"\n"
- " \"hangul\")\n"))
- '(stub-im-generate-stub-im-list '(hangul2)))
+ " \"New Pinyin (Simplified)\"\n"
+ " \"Pinyin input method (Simplified Chinese
version)\"\n"
+ " \"pyload\")\n"))
+ '(stub-im-generate-stub-im-list '(py)))
(assert-uim-equal (list
(string-append
- " (hangul3\n"
- " \"ko\"\n"
+ " (pyunihan\n"
+ " \"zh\"\n"
" \"UTF-8\"\n"
- " \"Hangul (3-beol)\"\n"
- " \"3-beol style hangul input method\"\n"
- " \"hangul\")\n"))
- '(stub-im-generate-stub-im-list '(hangul3)))
+ " \"Pinyin (Unicode)\"\n"
+ " \"Pinyin input method (Unicode version)\"\n"
+ " \"pyload\")\n"))
+ '(stub-im-generate-stub-im-list '(pyunihan)))
(assert-uim-equal (list
(string-append
- " (tcode\n"
- " \"ja\"\n"
- " \"EUC-JP\"\n"
- " \"T-Code\"\n"
- " \"A kanji direct input method\"\n"
- " \"tcode\")\n"))
- '(stub-im-generate-stub-im-list '(tcode)))
+ " (latin\n"
+ " \"\"\n"
+ " \"UTF-8\"\n"
+ " \"Latin characters\"\n"
+ " \"Latin characters mainly used for Latin and
Germanic languages\"\n"
+ " \"latin\")\n"))
+ '(stub-im-generate-stub-im-list '(latin)))
(assert-uim-equal (list
(string-append
- " (hangul2\n"
- " \"ko\"\n"
+ " (py\n"
+ " \"zh_CN\"\n"
" \"UTF-8\"\n"
- " \"Hangul (2-beol)\"\n"
- " \"2-beol style hangul input method\"\n"
- " \"hangul\")\n")
+ " \"New Pinyin (Simplified)\"\n"
+ " \"Pinyin input method (Simplified Chinese
version)\"\n"
+ " \"pyload\")\n")
(string-append
- " (tcode\n"
- " \"ja\"\n"
- " \"EUC-JP\"\n"
- " \"T-Code\"\n"
- " \"A kanji direct input method\"\n"
- " \"tcode\")\n")
+ " (latin\n"
+ " \"\"\n"
+ " \"UTF-8\"\n"
+ " \"Latin characters\"\n"
+ " \"Latin characters mainly used for Latin and
Germanic languages\"\n"
+ " \"latin\")\n")
(string-append
- " (hangul3\n"
- " \"ko\"\n"
+ " (pyunihan\n"
+ " \"zh\"\n"
" \"UTF-8\"\n"
- " \"Hangul (3-beol)\"\n"
- " \"3-beol style hangul input method\"\n"
- " \"hangul\")\n"))
- '(stub-im-generate-stub-im-list '(hangul2 tcode
hangul3)))
+ " \"Pinyin (Unicode)\"\n"
+ " \"Pinyin input method (Unicode version)\"\n"
+ " \"pyload\")\n"))
+ '(stub-im-generate-stub-im-list '(py latin pyunihan)))
#f)
(define (test-stub-im-generate-all-stub-im-list)
(uim-eval
'(begin
(set! im-list ())
- (undefine *tcode.scm-loaded*)
- (undefine *hangul.scm-loaded*)
- (set! installed-im-module-list '("tcode" "hangul"))))
+ (undefine *latin.scm-loaded*)
+ (undefine *pyload.scm-loaded*)
+ (set! installed-im-module-list '("latin" "pyload"))))
(assert-uim-equal (list
(string-append
- " (tcode\n"
- " \"ja\"\n"
- " \"EUC-JP\"\n"
- " \"T-Code\"\n"
- " \"A kanji direct input method\"\n"
- " \"tcode\")\n")
+ " (latin\n"
+ " \"\"\n"
+ " \"UTF-8\"\n"
+ " \"Latin characters\"\n"
+ " \"Latin characters mainly used for Latin and
Germanic languages\"\n"
+ " \"latin\")\n")
(string-append
- " (hangul2\n"
- " \"ko\"\n"
+ " (py\n"
+ " \"zh_CN\"\n"
" \"UTF-8\"\n"
- " \"Hangul (2-beol)\"\n"
- " \"2-beol style hangul input method\"\n"
- " \"hangul\")\n")
+ " \"New Pinyin (Simplified)\"\n"
+ " \"Pinyin input method (Simplified Chinese
version)\"\n"
+ " \"pyload\")\n")
(string-append
- " (hangul3\n"
- " \"ko\"\n"
+ " (pyunihan\n"
+ " \"zh\"\n"
" \"UTF-8\"\n"
- " \"Hangul (3-beol)\"\n"
- " \"3-beol style hangul input method\"\n"
- " \"hangul\")\n")
+ " \"Pinyin (Unicode)\"\n"
+ " \"Pinyin input method (Unicode version)\"\n"
+ " \"pyload\")\n")
(string-append
- " (romaja\n"
- " \"ko\"\n"
+ " (pinyin-big5\n"
+ " \"zh_TW:zh_HK\"\n"
" \"UTF-8\"\n"
- " \"Hangul (Romaja)\"\n"
- " \"Romaja input style hangul input method\"\n"
- " \"hangul\")\n"))
+ " \"Pinyin (Traditional)\"\n"
+ " \"Pinyin input method (Traditional Chinese
version)\"\n"
+ " \"pyload\")\n"))
'(stub-im-generate-all-stub-im-list))
(uim-eval
'(begin
(set! im-list ())
- (undefine *tcode.scm-loaded*)
- (undefine *hangul.scm-loaded*)
+ (undefine *latin.scm-loaded*)
+ (undefine *pyload.scm-loaded*)
(set! installed-im-module-list '())))
(assert-uim-equal ()
'(stub-im-generate-all-stub-im-list))
=======================================
--- /branches/1.6/test/test-plugin.scm Tue Jul 27 22:42:55 2010
+++ /branches/1.6/test/test-plugin.scm Thu Jan 6 17:50:39 2011
@@ -45,35 +45,35 @@
(uim-eval
'(begin
(set! im-list ())
- (undefine *tcode.scm-loaded*)
- (undefine *hangul.scm-loaded*)))
- (assert-uim-false '(symbol-bound? '*tcode.scm-loaded*))
- (assert-uim-false '(symbol-bound? '*hangul.scm-loaded*))
- (assert-uim-false '(retrieve-im 'tcode))
- (assert-uim-false '(retrieve-im 'hangul2))
+ (undefine *latin.scm-loaded*)
+ (undefine *pyload.scm-loaded*)))
+ (assert-uim-false '(symbol-bound? '*latin.scm-loaded*))
+ (assert-uim-false '(symbol-bound? '*pyload.scm-loaded*))
+ (assert-uim-false '(retrieve-im 'latin))
+ (assert-uim-false '(retrieve-im 'py))
;; im-module-name == im-name
- (assert-uim-true-value '(require-module "tcode"))
- (assert-uim-equal 'tcode
- '(im-name (retrieve-im 'tcode)))
- (assert-uim-equal "tcode"
- '(im-module-name (retrieve-im 'tcode)))
+ (assert-uim-true-value '(require-module "latin"))
+ (assert-uim-equal 'latin
+ '(im-name (retrieve-im 'latin)))
+ (assert-uim-equal "latin"
+ '(im-module-name (retrieve-im 'latin)))
;; im-module-name != im-name
- (assert-uim-true-value '(require-module "hangul"))
- (assert-uim-equal 'hangul2
- '(im-name (retrieve-im 'hangul2)))
- (assert-uim-equal "hangul"
- '(im-module-name (retrieve-im 'hangul2)))
+ (assert-uim-true-value '(require-module "pyload"))
+ (assert-uim-equal 'py
+ '(im-name (retrieve-im 'py)))
+ (assert-uim-equal "pyload"
+ '(im-module-name (retrieve-im 'py)))
;; raw require does not set im-module-name
(uim-eval '(set! im-list ()))
- (uim-eval '(undefine *tcode.scm-loaded*))
- (assert-uim-false '(symbol-bound? '*tcode.scm-loaded*))
- (assert-uim-false '(retrieve-im 'tcode))
- (assert-uim-true-value '(require "tcode.scm"))
-
- (assert-uim-equal 'tcode
- '(im-name (retrieve-im 'tcode)))
- (assert-uim-false '(im-module-name (retrieve-im 'tcode)))
+ (uim-eval '(undefine *latin.scm-loaded*))
+ (assert-uim-false '(symbol-bound? '*latin.scm-loaded*))
+ (assert-uim-false '(retrieve-im 'latin))
+ (assert-uim-true-value '(require "latin.scm"))
+
+ (assert-uim-equal 'latin
+ '(im-name (retrieve-im 'latin)))
+ (assert-uim-false '(im-module-name (retrieve-im 'latin)))
;; nonexistent module
(assert-uim-false '(require-module "nonexistent"))
