[uim-commit] r2019 - in branches/r5rs: . doc scm test uim
yamaken at freedesktop.org
yamaken at freedesktop.org
Sat Nov 5 13:49:16 PST 2005
Author: yamaken
Date: 2005-11-05 13:49:11 -0800 (Sat, 05 Nov 2005)
New Revision: 2019
Modified:
branches/r5rs/
branches/r5rs/doc/COMPATIBILITY
branches/r5rs/scm/custom.scm
branches/r5rs/scm/util.scm
branches/r5rs/test/run-test.scm
branches/r5rs/test/test-custom.scm
branches/r5rs/test/test-im.scm
branches/r5rs/test/test-lazy-load.scm
branches/r5rs/test/test-util.scm
branches/r5rs/uim/uim-scm.c
Log:
r496 at deepblue (orig r1994): yamaken | 2005-11-05 18:47:27 +0900
* test/test-util.scm
- (test string-escape): New test
* scm/util.scm
- (string-escape): Add brief description
r497 at deepblue (orig r1995): yamaken | 2005-11-05 20:47:44 +0900
* scm/custom.scm
- Cosmetic change
r498 at deepblue (orig r1996): yamaken | 2005-11-05 20:51:57 +0900
* test/test-custom.scm
- (testcase custom custom-group, test define-custom (choice),
testcase custom methods, testcase custom interfaces): Define
subgroups referred from subsequent define-custom's to follow the
specification change in r1862 (existence check of subgroup at
define-custom)
r499 at deepblue (orig r1997): yamaken | 2005-11-05 21:06:10 +0900
* test/test-custom.scm
- (test define-custom (group)): New test. It tests updated features
committed in r559 and r1862 of new repository
r500 at deepblue (orig r1998): yamaken | 2005-11-05 21:57:38 +0900
* test/test-custom.scm
- (test custom-list-groups): Fix lacking predefined subgroups
- (test define-custom (choice), test define-custom (key), test
custom-groups): Fix lacking implicit 'main' subgroup changed in r559
r501 at deepblue (orig r1999): yamaken | 2005-11-05 22:24:58 +0900
* test/test-custom.scm
- (test custom-choice-label, test custom-choice-desc): Follow the
specification change in r588, r590
r502 at deepblue (orig r2000): yamaken | 2005-11-05 22:36:57 +0900
* test/test-lazy-load.scm
- (test register-stub-im): Fix broken uim-sh interaction
r503 at deepblue (orig r2001): yamaken | 2005-11-05 23:22:44 +0900
* test/test-custom.scm
- (test custom-choice-label, test custom-choice-desc): Cosmetic change
r504 at deepblue (orig r2002): yamaken | 2005-11-05 23:47:35 +0900
* test/run-test.scm
- Add copyright header
r505 at deepblue (orig r2003): yamaken | 2005-11-05 23:50:27 +0900
* test/run-test.scm
- (main): Exclude test-example.scm from test
r506 at deepblue (orig r2004): yamaken | 2005-11-06 00:18:04 +0900
* This commit fixes unstable result of the testing framework
* doc/COMPATIBILITY
- Add new section "Verbose level of backtrace has been changed"
* uim/uim-scm.c
- (uim_scm_init): Change default verbose level to 2 from 0
* uim/slib.c
- (my_err): Change verbose level for show_backtrace() to 2 from 1
r507 at deepblue (orig r2005): yamaken | 2005-11-06 01:20:25 +0900
* test/test-im.scm
- (testcase im im-management): Exclude m17n-en-ispell from
enabled-im-list to fallback to direct IM
Property changes on: branches/r5rs
___________________________________________________________________
Name: svk:merge
- 2f05256a-0800-0410-85e3-84fe06922419:/local/uim/trunk:1514
74100eb5-a104-0410-9326-fdab01523867:/branches/r5rs:6
fb73e508-85ea-0310-95c3-a85c473e0941:/trunk:1993
+ 2f05256a-0800-0410-85e3-84fe06922419:/local/uim/trunk:1514
74100eb5-a104-0410-9326-fdab01523867:/branches/r5rs:6
fb73e508-85ea-0310-95c3-a85c473e0941:/trunk:2005
Modified: branches/r5rs/doc/COMPATIBILITY
===================================================================
--- branches/r5rs/doc/COMPATIBILITY 2005-11-05 21:24:04 UTC (rev 2018)
+++ branches/r5rs/doc/COMPATIBILITY 2005-11-05 21:49:11 UTC (rev 2019)
@@ -57,6 +57,22 @@
The changes are described below in most recently updated order.
------------------------------------------------------------------------------
+Summary: Verbose level of backtrace has been changed
+Affects: uim developers, bridge developers
+Updates: Internal behavior of libuim
+Version: 0.5.1
+Revision: ac2004
+Date: 2005-11-05
+Modifier: YamaKen
+Related:
+URL:
+Changes:
+Description:
+ To fix unstable result of the testing framework, backtrace printing
+ has been suppressed at verbose level 1. Now verbose level 2 is
+ required to print backtrace, and libuim's default is also changed to
+ 2. So ordinary users and developers don't needed to mind it.
+------------------------------------------------------------------------------
Summary: Notification of changes in input context configuration
Affects: Bridge developers
Updates: C API
Modified: branches/r5rs/scm/custom.scm
===================================================================
--- branches/r5rs/scm/custom.scm 2005-11-05 21:24:04 UTC (rev 2018)
+++ branches/r5rs/scm/custom.scm 2005-11-05 21:49:11 UTC (rev 2019)
@@ -741,6 +741,10 @@
(let ((cb (lambda () (gate-func func ptr custom-sym))))
(custom-add-hook custom-sym hook cb)))))
+;;
+;; predefined subgroups
+;;
+
(define-custom-group 'main
(_ "-")
(_ "Main settings of this group"))
@@ -749,5 +753,6 @@
(_ "Hidden settings")
(_ "Hidden settings of this group. This group is invisible from uim_custom clients. Exists for internal variable management."))
-;(prealloc-heaps-for-heavy-job)
+
+(prealloc-heaps-for-heavy-job)
(custom-reload-customs)
Modified: branches/r5rs/scm/util.scm
===================================================================
--- branches/r5rs/scm/util.scm 2005-11-05 21:24:04 UTC (rev 2018)
+++ branches/r5rs/scm/util.scm 2005-11-05 21:49:11 UTC (rev 2019)
@@ -34,7 +34,6 @@
;(require "slib-mulapply.scm")
;(require "slib-srfi-1.scm")
-;; Current uim implementation treats char as integer
;;
;; generic utilities
;;
@@ -42,19 +41,25 @@
;; FIXME: Properly escape all special chars in s such as "\"", "\\" as
;; original siod based one does.
;;
-;;$ uim-sh
-;;uim> (string-escape "\"")
-;;"\"\\\"\""
-;;uim> (string-escape "\\")
-;;"\"\\\\\""
-;;uim> (string-escape "\n")
-;;"\"\\n\""
+;; Make escaped string literal to print a form.
;;
-;; TODO: write test
+;; (string-escape "a str\n") -> "\"a str\\n\""
+;;
+;; The following two codes must display same result. See
+;; test/test-util.scm for further specification.
+;;
+;; (display str)
+;;
+;; (use srfi-6)
+;; (define estr (string-append "(display " (string-escape str) ")"))
+;; (eval (read (open-input-string estr))
+;; (interaction-environment))
(define string-escape
(lambda (s)
(string-append "\"" s "\"")))
+;; Current uim implementation treats char as integer
+
;; TODO: write test
(define string->char
(lambda (str)
Modified: branches/r5rs/test/run-test.scm
===================================================================
--- branches/r5rs/test/run-test.scm 2005-11-05 21:24:04 UTC (rev 2018)
+++ branches/r5rs/test/run-test.scm 2005-11-05 21:49:11 UTC (rev 2019)
@@ -1,5 +1,34 @@
#!/usr/bin/env gosh
+;;; Copyright (c) 2004-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 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.
+;;;;
+
(use gauche.interactive)
(use file.util)
(use test.unit)
@@ -15,7 +44,9 @@
(load (string-join (list dir test-script) "/")))
(directory-list dir
:filter (lambda (x)
- (rxmatch #/^test-.+\.scm$/ x))))
+ (and (rxmatch #/^test-.+\.scm$/ x)
+ (not (string=? "test-example.scm"
+ x))))))
(if (symbol-bound? '_main)
(_main `(,(car args) "-vp" ,@(cdr args)))
(run-all-test))))
Modified: branches/r5rs/test/test-custom.scm
===================================================================
--- branches/r5rs/test/test-custom.scm 2005-11-05 21:24:04 UTC (rev 2018)
+++ branches/r5rs/test/test-custom.scm 2005-11-05 21:49:11 UTC (rev 2019)
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; This file is tested with revision 327 of new repository
+;; This file is tested with revision 1999 of new repository
;; TODO:
;;
@@ -324,21 +324,23 @@
(uim '(custom-choice-label 'uim-color 'uim-color-uim)))
(assert-equal "ATOK like"
(uim '(custom-choice-label 'uim-color 'uim-color-atok)))
+ (assert-equal "uim-color-nonexistent"
+ (uim '(custom-choice-label 'uim-color
+ 'uim-color-nonexistent)))
(assert-error (lambda ()
- (uim '(custom-choice-label 'uim-color
- 'uim-color-nonexistent))))
- (assert-error (lambda ()
- (uim '(custom-choice-label 'uim-nonexistent
- 'uim-nonexistent)))))
+ (uim '(custom-choice-label 'uim-nonexistent
+ 'uim-nonexistent)))))
("test custom-choice-desc"
(assert-equal "uim native"
(uim '(custom-choice-desc 'uim-color 'uim-color-uim)))
(assert-equal "Similar to ATOK"
(uim '(custom-choice-desc 'uim-color 'uim-color-atok)))
- (assert-error (lambda () (uim '(custom-choice-desc 'uim-color
- 'uim-color-nonexistent))))
- (assert-error (lambda () (uim '(custom-choice-desc 'uim-nonexistent
- 'uim-nonexistent))))))
+ (assert-equal "uim-color-nonexistent"
+ (uim '(custom-choice-desc 'uim-color
+ 'uim-color-nonexistent)))
+ (assert-error (lambda ()
+ (uim '(custom-choice-desc 'uim-nonexistent
+ 'uim-nonexistent))))))
(define-uim-test-case "testcase custom custom-group"
(setup
@@ -350,6 +352,15 @@
(define custom-group-rec-alist ())
(define custom-subgroup-alist ())
+ ;; resurrect the predefined subgroups defined in custom.scm
+ (define-custom-group 'main
+ (_ "-")
+ (_ "Main settings of this group"))
+
+ (define-custom-group 'hidden
+ (_ "Hidden settings")
+ (_ "Hidden settings of this group. This group is invisible from uim_custom clients. Exists for internal variable management."))
+
(define test-group-recs-length 0)
(define-custom-group 'global
(_ "Global settings")
@@ -670,7 +681,7 @@
"long description of test group 3"))
(uim '(custom-group-rec 'test-group3))))
("test custom-list-groups"
- (assert-equal '(advanced anthy canna global im-switching other-ims prime skk spellcheck)
+ (assert-equal '(advanced anthy canna global hidden im-switching main other-ims prime skk spellcheck)
(sort-symbol (uim '(custom-list-groups)))))
("test custom-list-primary-groups"
;; defined order have to be kept
@@ -1425,6 +1436,46 @@
(lambda ()
(uim '(require "custom.scm"))))
+ ;; tests updated features committed in r559 and r1862 of new repository
+ ("test define-custom (group)"
+ (uim '(define-custom 'test-bool #f
+ '(global)
+ '(boolean)
+ "Test bool"
+ "long description will be here."))
+
+ ;; implicit subgroup 'main' is complemented
+ (assert-equal '(global main)
+ (uim '(custom-groups 'test-bool)))
+
+ ;; at least a primary group required
+ (assert-error (lambda ()
+ (uim '(define-custom 'test-bool2 #f
+ '()
+ '(boolean)
+ "Test bool"
+ "long description will be here."))))
+
+ ;; referring undefined group(s) causes error
+ (assert-error (lambda ()
+ (uim '(define-custom 'test-bool3 #f
+ '(global nonexistent)
+ '(boolean)
+ "Test bool"
+ "long description will be here."))))
+ (assert-error (lambda ()
+ (uim '(define-custom 'test-bool4 #f
+ '(nonexistent)
+ '(boolean)
+ "Test bool"
+ "long description will be here."))))
+ (assert-error (lambda ()
+ (uim '(define-custom 'test-bool5 #f
+ '(nonexistent hidden)
+ '(boolean)
+ "Test bool"
+ "long description will be here.")))))
+
("test define-custom (choice)"
(assert-false (uim-bool '(symbol-bound? 'test-style)))
@@ -1440,13 +1491,16 @@
(assert-true (uim-bool '(symbol-bound? 'test-style)))
(assert-equal 'test-style-ddskk
(uim 'test-style))
- (assert-equal '(global)
+ (assert-equal '(global main)
(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)))
+ (uim '(define-custom-group 'global-keys
+ "global-keys"
+ "global-keys"))
;; overwriting definition
(uim '(define-custom 'test-style 'test-style-uim
'(global-keys)
@@ -1459,7 +1513,7 @@
(assert-true (uim-bool '(symbol-bound? 'test-style)))
(assert-equal 'test-style-ddskk
(uim 'test-style))
- (assert-equal '(global-keys)
+ (assert-equal '(global-keys main)
(uim '(custom-groups 'test-style)))
(assert-equal '(test-style-canna test-style-uim)
(uim '(custom-range 'test-style)))
@@ -1497,6 +1551,8 @@
(assert-true (uim-bool '(symbol-bound? 'test-foo-key)))
(assert-equal '("a")
(uim 'test-foo-key))
+ (assert-equal '(global main)
+ (uim '(custom-groups 'test-foo-key)))
(assert-true (uim-bool '(symbol-bound? 'test-foo-key?)))
(assert-true (uim-bool '(test-foo-key? (string->charcode "a") 0)))
@@ -1538,6 +1594,14 @@
(setup
(lambda ()
(uim '(require "custom.scm"))
+
+ (uim '(define-custom-group 'test
+ "test"
+ "test"))
+ (uim '(define-custom-group 'ui
+ "ui"
+ "ui"))
+
(uim '(define-custom 'test-style 'test-style-ddskk
'(global)
'(choice
@@ -1988,19 +2052,19 @@
(uim '(custom-default-value 'test-dic-file-name))))
("test custom-groups"
- (assert-equal '(global)
+ (assert-equal '(global main)
(uim '(custom-groups 'test-style)))
- (assert-equal '(global)
+ (assert-equal '(global main)
(uim '(custom-groups 'test-available-ims)))
- (assert-equal '(global)
+ (assert-equal '(global main)
(uim '(custom-groups 'test-cancel-key)))
(assert-equal '(test ui)
(uim '(custom-groups 'test-use-candidate-window?)))
(assert-equal '(test advanced ui)
(uim '(custom-groups 'test-nr-candidate-max)))
- (assert-equal '(test)
+ (assert-equal '(test main)
(uim '(custom-groups 'test-string)))
- (assert-equal '(test)
+ (assert-equal '(test main)
(uim '(custom-groups 'test-dic-file-name))))
("test custom-type"
@@ -2146,6 +2210,14 @@
(setup
(lambda ()
(uim '(require "custom.scm"))
+
+ (uim '(define-custom-group 'test
+ "test"
+ "test"))
+ (uim '(define-custom-group 'ui
+ "ui"
+ "ui"))
+
(uim '(define-custom 'test-nr-candidate-max 10
'(test advanced ui)
'(integer 1 20)
Modified: branches/r5rs/test/test-im.scm
===================================================================
--- branches/r5rs/test/test-im.scm 2005-11-05 21:24:04 UTC (rev 2018)
+++ branches/r5rs/test/test-im.scm 2005-11-05 21:49:11 UTC (rev 2019)
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; This file is tested with revision 327 of new repository
+;; This file is tested with revision 2005 of new repository
(use test.unit)
@@ -53,7 +53,8 @@
(require-module "canna")
(require-module "skk")
(require-module "tcode")
- (set! enabled-im-list (append enabled-im-list
+ (set! enabled-im-list (append (delete 'm17n-en-ispell
+ enabled-im-list)
'(test-im test-im2)))
(for-each require-module installed-im-module-list)
(define prev-im #f)
Modified: branches/r5rs/test/test-lazy-load.scm
===================================================================
--- branches/r5rs/test/test-lazy-load.scm 2005-11-05 21:24:04 UTC (rev 2018)
+++ branches/r5rs/test/test-lazy-load.scm 2005-11-05 21:49:11 UTC (rev 2019)
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; This file is tested with revision 327 of new repository
+;; This file is tested with revision 2000 of new repository
(use test.unit)
@@ -107,8 +107,12 @@
(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)))
+ (uim '(begin
+ (create-context 0 #f 'hangul2)
+ #f))
+ (uim '(begin
+ (define test-context (find-context 0))
+ #f))
(assert-equal 'hangul2
(uim '(im-name (context-im test-context))))
(assert-equal "hangul"
Modified: branches/r5rs/test/test-util.scm
===================================================================
--- branches/r5rs/test/test-util.scm 2005-11-05 21:24:04 UTC (rev 2018)
+++ branches/r5rs/test/test-util.scm 2005-11-05 21:49:11 UTC (rev 2019)
@@ -542,6 +542,60 @@
(uim '(string-append-map car '(("c" "C") ("a" "A") ("r" "R")))))))
(define-uim-test-case "testcase util misc"
+ ("test string-escape"
+ ;; empty string
+ (assert-equal "\"\""
+ (uim '(string-escape "")))
+ ;; single character
+ (assert-equal "\"\\\"\""
+ (uim '(string-escape "\"")))
+ (assert-equal "\"\\\\\""
+ (uim '(string-escape "\\")))
+ (assert-equal "\"\\n\""
+ (uim '(string-escape "\n")))
+ (assert-equal "\"a\""
+ (uim '(string-escape "a")))
+ (assert-equal "\"b\""
+ (uim '(string-escape "b")))
+ (assert-equal "\"c\""
+ (uim '(string-escape "c")))
+ (assert-equal "\"a\""
+ (uim '(string-escape "\a")))
+ (assert-equal "\"b\""
+ (uim '(string-escape "\b")))
+ (assert-equal "\"c\""
+ (uim '(string-escape "\c")))
+ (assert-equal "\"A\""
+ (uim '(string-escape "A")))
+ (assert-equal "\"B\""
+ (uim '(string-escape "B")))
+ (assert-equal "\"C\""
+ (uim '(string-escape "C")))
+ (assert-equal "\"A\""
+ (uim '(string-escape "\A")))
+ (assert-equal "\"B\""
+ (uim '(string-escape "\B")))
+ (assert-equal "\"C\""
+ (uim '(string-escape "\C")))
+ ;; 2 characters
+ (assert-equal "\"\\\"\\\"\""
+ (uim '(string-escape "\"\"")))
+ (assert-equal "\"\\\\\\\"\""
+ (uim '(string-escape "\\\"")))
+ (assert-equal "\"\\\\\\\\\""
+ (uim '(string-escape "\\\\")))
+ (assert-equal "\"\\r\\n\""
+ (uim '(string-escape "\r\n")))
+ (assert-equal "\"aB\""
+ (uim '(string-escape "aB")))
+ (assert-equal "\"aB\""
+ (uim '(string-escape "a\B")))
+ (assert-equal "\"aB\""
+ (uim '(string-escape "\a\B")))
+ ;; complex
+ (assert-equal "\"\\\"a string\\\" in two-line\\nstring\\n\""
+ (uim '(string-escape "\"a\ string\" in two-line\nstring\n"))))
+
("test compose"
(uim '(define test-list '(0 1 2 3 4 5)))
(assert-true (uim-bool '(procedure? (compose))))
Modified: branches/r5rs/uim/uim-scm.c
===================================================================
--- branches/r5rs/uim/uim-scm.c 2005-11-05 21:24:04 UTC (rev 2018)
+++ branches/r5rs/uim/uim-scm.c 2005-11-05 21:49:11 UTC (rev 2019)
@@ -582,7 +582,7 @@
void
uim_scm_init(const char *verbose_level)
{
- long vlevel = 4;
+ long vlevel = 2;
ScmObj output_port;
if (!uim_output)
More information about the uim-commit
mailing list