Author: yamakenz
Date: Tue Jul 10 00:59:33 2007
New Revision: 4673
Modified:
trunk/scm/im.scm
trunk/test/test-action.scm
trunk/test/test-custom.scm
trunk/test/test-example.scm
trunk/test/test-im.scm
trunk/test/test-lazy-load.scm
trunk/test/test-uim-util.scm
trunk/test/test-util.scm
trunk/test/uim-test-utils.scm
trunk/uim/intl.c
trunk/uim/uim-util.c
Log:
* scm/im.scm
- (next-im): Fix SIOD-dependent list operation
* test/test-im.scm
- Replace SIOD bool expected values to R5RS
* uim/uim-util.c
- (uim_split_string): Fix SIOD-dependent duplexed result meaning of
#f and '()
* uim/intl.c
- (intl_textdomain, intl_bindtextdomain): Fix SIOD-dependent boolean
condition
* test/uim-test-utils.scm
- (uim-bool): Change SIOD bool to R5RS bool
* test/test-uim-util.scm
* test/test-lazy-load.scm
* test/test-util.scm
- Replace SIOD bool expected values to R5RS
* test/test-action.scm
- Replace SIOD bool expected values to R5RS
- Fix non-R5RS-conformant internal definitions
- Fix incorrect #f with '()
* test/test-custom.scm
- Add SigScheme-specific closure external representation workaround
* test/test-example.scm
- Fix a SIOD-dependent? test result to R5RS
Modified: trunk/scm/im.scm
==============================================================================
--- trunk/scm/im.scm (original)
+++ trunk/scm/im.scm Tue Jul 10 00:59:33 2007
@@ -238,7 +238,7 @@
(let* ((im-names (map car im-list))
(im-rest (memq name im-names)))
(or (and im-rest
- (not (null? im-rest))
+ (pair? (cdr im-rest))
(cadr im-rest))
(car im-names)))))
Modified: trunk/test/test-action.scm
==============================================================================
--- trunk/test/test-action.scm (original)
+++ trunk/test/test-action.scm Tue Jul 10 00:59:33 2007
@@ -513,70 +513,70 @@
("test widget-new"
(assert-false (uim-bool '(widget-new 'widget_test_nonexistent tc)))
;; widget_test_input_mode
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
(assert-equal 'widget_test_input_mode
(uim '(widget-id test-input-mode)))
(assert-equal 'action_test_direct
(uim '(action-id (widget-activity test-input-mode))))
;; widget_test_input_mode with default value
(uim '(define default-widget_test_input_mode 'action_test_hiragana))
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
(assert-equal 'action_test_hiragana
(uim '(action-id (widget-activity test-input-mode))))
;; widget_test_input_mode with default value #2
(uim '(define default-widget_test_input_mode 'action_test_katakana))
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
(assert-equal 'action_test_katakana
(uim '(action-id (widget-activity test-input-mode))))
;; widget_test_input_mode with default value #3
(uim '(define default-widget_test_input_mode 'action_test_zenkaku))
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
(assert-equal 'action_test_zenkaku
(uim '(action-id (widget-activity test-input-mode))))
;; widget_test_input_mode with invalid default value
(uim '(define default-widget_test_input_mode 'action_nonexistent))
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
(assert-equal 'action_test_zenkaku
(uim '(action-id (widget-activity test-input-mode))))
;; widget_test_kana_input_method
- (assert-true (uim-bool '(and (define test-kana-input-method
- (widget-new 'widget_test_kana_input_method
tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-kana-input-method
+ (widget-new 'widget_test_kana_input_method
tc))
+ #t)))
(assert-equal 'action_test_roma
(uim '(action-id (widget-activity test-kana-input-method))))
;; widget_test_kana_input_method with default value
(uim '(define default-widget_test_kana_input_method 'action_test_kana))
- (assert-true (uim-bool '(and (define test-kana-input-method
- (widget-new 'widget_test_kana_input_method
tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-kana-input-method
+ (widget-new 'widget_test_kana_input_method
tc))
+ #t)))
(assert-equal 'action_test_kana
(uim '(action-id (widget-activity test-kana-input-method))))
;; widget_test_kana_input_method with invalid default value
(uim '(define default-widget_test_kana_input_method 'action_nonexistent))
- (assert-true (uim-bool '(and (define test-kana-input-method
- (widget-new 'widget_test_kana_input_method
tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-kana-input-method
+ (widget-new 'widget_test_kana_input_method
tc))
+ #t)))
(assert-equal 'action_test_kana
(uim '(action-id (widget-activity test-kana-input-method)))))
("test widget-activity"
;;; widget_test_input_mode
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
;; action_test_direct (initial activity)
(assert-false (uim-bool '(test-context-on tc)))
(assert-false (uim-bool '(test-context-wide-latin tc)))
@@ -659,9 +659,9 @@
("test widget-activate!"
;;; widget_test_input_mode
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
;; action_test_direct (initial activity)
(assert-false (uim-bool '(test-context-on tc)))
(assert-false (uim-bool '(test-context-wide-latin tc)))
@@ -726,9 +726,9 @@
("test widget-configuration"
;;; widget_test_input_mode
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
(assert-equal '(action_unknown
(figure_ja_hiragana
"あ"
@@ -752,9 +752,9 @@
"全角英数入力モード"))
(uim '(widget-configuration test-input-mode)))
;;; widget_test_kana_input_method
- (assert-true (uim-bool '(and (define test-kana-input-method
- (widget-new 'widget_test_kana_input_method
tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-kana-input-method
+ (widget-new 'widget_test_kana_input_method
tc))
+ #t)))
(assert-equal '(action_unknown
(figure_ja_roma
"Ｒ"
@@ -766,17 +766,17 @@
"かな入力モード"))
(uim '(widget-configuration test-kana-input-method)))
;;; widget_test_null
- (assert-true (uim-bool '(and (define test-null
- (widget-new 'widget_test_null tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-null
+ (widget-new 'widget_test_null tc))
+ #t)))
(assert-equal '(action_unknown)
(uim '(widget-configuration test-null))))
("test widget-state"
;;; widget_test_input_mode
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_direct)
'(figure_ja_direct
"a"
@@ -800,9 +800,9 @@
"カタカナ入力モード"))
(widget-state test-input-mode))))
;;; widget_test_kana_input_method
- (assert-true (uim-bool '(and (define test-kana-input-method
- (widget-new 'widget_test_kana_input_method
tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-kana-input-method
+ (widget-new 'widget_test_kana_input_method
tc))
+ #t)))
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_roma)
'(figure_ja_roma
"Ｒ"
@@ -810,9 +810,9 @@
"ローマ字入力モード"))
(widget-state test-kana-input-method))))
;;; widget_test_null
- (assert-true (uim-bool '(and (define test-null
- (widget-new 'widget_test_null tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-null
+ (widget-new 'widget_test_null tc))
+ #t)))
(assert-true (uim-bool '(equal? (list #f
'(unknown
"?"
@@ -822,9 +822,9 @@
("test widget-update-configuration!"
;;; widget_test_input_mode
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
(assert-equal '(action_unknown
(figure_ja_hiragana
"あ"
@@ -917,9 +917,9 @@
"全角英数入力モード"))
(uim '(widget-prev-config test-input-mode)))
;;; widget_test_null
- (assert-true (uim-bool '(and (define test-null
- (widget-new 'widget_test_null tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-null
+ (widget-new 'widget_test_null tc))
+ #t)))
(assert-equal '(action_unknown)
(uim '(widget-configuration test-null)))
(assert-false (uim-bool '(widget-prev-config test-null)))
@@ -930,9 +930,9 @@
("test widget-update-state!"
;;; widget_test_input_mode
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
;; initial state
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_direct)
'(figure_ja_direct
@@ -1014,9 +1014,9 @@
"カタカナ入力モード"))
(widget-prev-state test-input-mode))))
;;; widget_test_null
- (assert-true (uim-bool '(and (define test-null
- (widget-new 'widget_test_null tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-null
+ (widget-new 'widget_test_null tc))
+ #t)))
;; initial state
(assert-true (uim-bool '(equal? (list #f
@@ -1056,9 +1056,9 @@
(widget-prev-state test-null)))))
("test widget-debug-message"
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
(assert-equal "something in somewhere. debug widget_test_input_mode."
(uim '(widget-debug-message test-input-mode
"somewhere"
@@ -1214,9 +1214,9 @@
("test widget-compose-live-branch"
;; widget_test_input_mode
- (assert-true (uim-bool '(and (define test-input-mode
- (widget-new 'widget_test_input_mode tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-input-mode
+ (widget-new 'widget_test_input_mode tc))
+ #t)))
(assert-equal (string-append
"branch\tfigure_ja_direct\ta\t直接入力\n"
"leaf\tfigure_ja_hiragana\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
@@ -1236,9 +1236,9 @@
"leaf\tfigure_ja_zenkaku\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t*\n")
(uim '(widget-compose-live-branch test-input-mode)))
;;; prop_test_kana_input_method
- (assert-true (uim-bool '(and (define test-kana-input-method
- (widget-new 'widget_test_kana_input_method
tc))
- #t)))
+ (assert-true (uim-bool '(begin (define test-kana-input-method
+ (widget-new 'widget_test_kana_input_method
tc))
+ #t)))
(assert-equal (string-append
"branch\tfigure_ja_roma\tＲ\tローマ字\n"
"leaf\tfigure_ja_roma\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
@@ -1305,8 +1305,8 @@
#t))
;; initial update
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-update-widgets tc)
#t))
@@ -1318,49 +1318,49 @@
(uim '(map widget-id test-widget-state)))
;; duplicate update
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-update-widgets tc)
#t))
- (assert-false (uim-bool '(map widget-id test-widget-conf)))
- (assert-false (uim-bool '(map widget-id test-widget-state)))
+ (assert-true (null? (uim '(map widget-id test-widget-conf))))
+ (assert-true (null? (uim '(map widget-id test-widget-state))))
;; duplicate update #2
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-update-widgets tc)
#t))
- (assert-false (uim-bool '(map widget-id test-widget-conf)))
- (assert-false (uim-bool '(map widget-id test-widget-state)))
+ (assert-true (null? (uim '(map widget-id test-widget-conf))))
+ (assert-true (null? (uim '(map widget-id test-widget-state))))
;; state update
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(assert-true (uim-bool '(widget-activate! (assq 'widget_test_input_mode
(context-widgets tc))
'action_test_katakana)))
(uim '(begin
(context-update-widgets tc)
#t))
- (assert-false (uim-bool '(map widget-id test-widget-conf)))
+ (assert-true (null? (uim '(map widget-id test-widget-conf))))
(assert-equal '(widget_test_input_mode
widget_test_kana_input_method)
(uim '(map widget-id test-widget-state)))
;; duplicate state update
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-update-widgets tc)
#t))
- (assert-false (uim-bool '(map widget-id test-widget-conf)))
- (assert-false (uim-bool '(map widget-id test-widget-state)))
+ (assert-true (null? (uim '(map widget-id test-widget-conf))))
+ (assert-true (null? (uim '(map widget-id test-widget-state))))
;; configuration update
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(register-action 'action_test_alt_hiragana
(lambda (tc)
@@ -1395,20 +1395,20 @@
(assert-equal '(widget_test_input_mode
widget_test_kana_input_method)
(uim '(map widget-id test-widget-conf)))
- (assert-false (uim-bool '(map widget-id test-widget-state)))
+ (assert-true (null? (uim '(map widget-id test-widget-state))))
;; duplicate configuration update
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-update-widgets tc)
#t))
- (assert-false (uim-bool '(map widget-id test-widget-conf)))
- (assert-false (uim-bool '(map widget-id test-widget-state)))
+ (assert-true (null? (uim '(map widget-id test-widget-conf))))
+ (assert-true (null? (uim '(map widget-id test-widget-state))))
;; configuration & state update
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-init-widgets! tc '(widget_test_input_mode))
#t))
@@ -1421,19 +1421,19 @@
(uim '(map widget-id test-widget-state)))
;; duplicate configuration & state update
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-update-widgets tc)
#t))
- (assert-false (uim-bool '(map widget-id test-widget-conf)))
- (assert-false (uim-bool '(map widget-id test-widget-state)))
+ (assert-true (null? (uim '(map widget-id test-widget-conf))))
+ (assert-true (null? (uim '(map widget-id test-widget-state))))
;; The framework can't detect the configuration information
;; invalidation when violently reconfigured by
;; context-set-widgets!.
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-set-widgets!
tc
@@ -1445,8 +1445,8 @@
(uim '(begin
(context-update-widgets tc)
#t))
- (assert-false (uim-bool '(map widget-id test-widget-conf)))
- (assert-false (uim-bool '(map widget-id test-widget-state)))
+ (assert-true (null? (uim '(map widget-id test-widget-conf))))
+ (assert-true (null? (uim '(map widget-id test-widget-state))))
;;; no widgets
(uim '(begin
@@ -1454,8 +1454,8 @@
#t))
;; initial update (widget_fallback)
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-update-widgets tc)
#t))
@@ -1465,13 +1465,13 @@
(uim '(map widget-id test-widget-state)))
;; subsequent update
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-update-widgets tc)
#t))
- (assert-false (uim-bool '(map widget-id test-widget-conf)))
- (assert-false (uim-bool '(map widget-id test-widget-state)))
+ (assert-true (null? (uim '(map widget-id test-widget-conf))))
+ (assert-true (null? (uim '(map widget-id test-widget-state))))
;;; null widget
(uim '(begin
@@ -1479,8 +1479,8 @@
#t))
;; initial update (widget_test_null with fallback-indication)
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-update-widgets tc)
#t))
@@ -1490,13 +1490,13 @@
(uim '(map widget-id test-widget-state)))
;; subsequent update
(uim '(begin
- (define test-widget-conf #f)
- (define test-widget-state #f)))
+ (define test-widget-conf '())
+ (define test-widget-state '())))
(uim '(begin
(context-update-widgets tc)
#t))
- (assert-false (uim-bool '(map widget-id test-widget-conf)))
- (assert-false (uim-bool '(map widget-id test-widget-state))))
+ (assert-true (null? (uim '(map widget-id test-widget-conf))))
+ (assert-true (null? (uim '(map widget-id test-widget-state)))))
("test context-propagate-prop-list-update"
(uim '(begin
Modified: trunk/test/test-custom.scm
==============================================================================
--- trunk/test/test-custom.scm (original)
+++ trunk/test/test-custom.scm Tue Jul 10 00:59:33 2007
@@ -974,6 +974,13 @@
(uim '(custom-hook-procs 'test-custom2 test-hook))))
("test custom-remove-hook"
+ (uim '(define custom-remove-hook-orig custom-remove-hook))
+ ;; Canonicalize to boolean since the pipe communication between
+ ;; uim-sh and gosh cannot treat (test-custom1 . #<closure (() 2)>)
+ ;; properly.
+ (uim '(define custom-remove-hook
+ (lambda args
+ (not (not (apply custom-remove-hook-orig args))))))
;; null
(assert-equal ()
(uim 'test-hook))
Modified: trunk/test/test-example.scm
==============================================================================
--- trunk/test/test-example.scm (original)
+++ trunk/test/test-example.scm Tue Jul 10 00:59:33 2007
@@ -55,7 +55,7 @@
;; When <extected> and the actual evaluated values are different,
;; it is countted as failure and reported.
- (assert-equal -1
+ (assert-equal 1
(uim '(- 0 -1))))
("test /"
Modified: trunk/test/test-im.scm
==============================================================================
--- trunk/test/test-im.scm (original)
+++ trunk/test/test-im.scm Tue Jul 10 00:59:33 2007
@@ -171,12 +171,12 @@
alt-set-candidate-index-handler
alt-prop-activate-handler
;; replace with #f for R5RS compliant interpreter
- ()
- ()
- ()
- ()
- ()
- ())
+ #f
+ #f
+ #f
+ #f
+ #f
+ #f)
(uim '(retrieve-im 'test-im)))
;; subsequent registration that has different im-name will be
;; registered as another IM
@@ -201,12 +201,12 @@
alt-set-candidate-index-handler
alt-prop-activate-handler
;; replace with #f for R5RS compliant interpreter
- ()
- ()
- ()
- ()
- ()
- ())
+ #f
+ #f
+ #f
+ #f
+ #f
+ #f)
(uim '(retrieve-im 'test-im2))))
("test register-im (module-name)"
Modified: trunk/test/test-lazy-load.scm
==============================================================================
--- trunk/test/test-lazy-load.scm (original)
+++ trunk/test/test-lazy-load.scm Tue Jul 10 00:59:33 2007
@@ -83,21 +83,21 @@
"Hangul (2-bul)"
"2-bul style hangul input method"
;; replace () with #f for R5RS compliant interpreter
- () ;; arg
+ #f ;; arg
init
- () ;; release-handler
- () ;; mode-handler
- () ;; press-key-handler
- () ;; release-key-handler
- () ;; reset-handler
- () ;; get-candidate-handler
- () ;; set-candidate-index-handler
- () ;; prop-activate-handler
- () ;; input-string-handler
- () ;; focus-in-handler
- () ;; focus-out-handler
- () ;; place-handler
- () ;; displace-handler
+ #f ;; release-handler
+ #f ;; mode-handler
+ #f ;; press-key-handler
+ #f ;; release-key-handler
+ #f ;; reset-handler
+ #f ;; get-candidate-handler
+ #f ;; set-candidate-index-handler
+ #f ;; prop-activate-handler
+ #f ;; input-string-handler
+ #f ;; focus-in-handler
+ #f ;; focus-out-handler
+ #f ;; place-handler
+ #f ;; displace-handler
"hangul")
(uim '(retrieve-im 'hangul2)))
(uim '(im-set-init-handler! (retrieve-im 'hangul2) init-handler))
Modified: trunk/test/test-uim-util.scm
==============================================================================
--- trunk/test/test-uim-util.scm (original)
+++ trunk/test/test-uim-util.scm Tue Jul 10 00:59:33 2007
@@ -194,7 +194,7 @@
(uim '(nthcdr 3 lst)))
(assert-equal ()
(uim '(nthcdr 4 lst)))
- (assert-equal ()
+ (assert-equal #f
(uim '(nthcdr 5 lst))))
("test charcode->string"
Modified: trunk/test/test-util.scm
==============================================================================
--- trunk/test/test-util.scm (original)
+++ trunk/test/test-util.scm Tue Jul 10 00:59:33 2007
@@ -771,7 +771,8 @@
(assert-false (uim-bool '(boolean? 1)))
(assert-false (uim-bool '(boolean? 10)))
- (assert-true (uim-bool '(boolean? ()))) ; Siod specific
+ ;;(assert-true (uim-bool '(boolean? ()))) ; SIOD specific
+ (assert-false (uim-bool '(boolean? ()))) ; SigScheme
(assert-false (uim-bool '(boolean? '(1 "2" 'three))))
(assert-false (uim-bool '(boolean? 'nil)))
(assert-false (uim-bool '(symbol-bound? 'nil))))
@@ -787,7 +788,8 @@
(assert-false (uim-bool '(integer? ())))
(assert-false (uim-bool '(integer? '(1 "2" 'three)))))
("test list?"
- (assert-true (uim-bool '(list? #f))) ; Siod specific
+ ;;(assert-true (uim-bool '(list? #f))) ; SIOD specific
+ (assert-false (uim-bool '(list? #f))) ; SigScheme
(assert-false (uim-bool '(list? "foo")))
(assert-false (uim-bool '(list? 'foo)))
(assert-false (uim-bool '(list? -1)))
@@ -1120,7 +1122,7 @@
(uim '(find string? lst)))
(assert-equal 'three
(uim '(find symbol? lst)))
- (assert-equal ()
+ (assert-equal #f
(uim '(find string? ())))
(assert-equal -9
(uim '(find (lambda (x)
Modified: trunk/test/uim-test-utils.scm
==============================================================================
--- trunk/test/uim-test-utils.scm (original)
+++ trunk/test/uim-test-utils.scm Tue Jul 10 00:59:33 2007
@@ -100,7 +100,7 @@
(uim-sh-read (process-output *uim-sh-process*)))
(define (uim-bool sexp)
- (not (null? (uim sexp))))
+ (not (not (uim sexp))))
;; only the tricky tests require this 'require' emulation.
(define (uim-define-siod-compatible-require)
Modified: trunk/uim/intl.c
==============================================================================
--- trunk/uim/intl.c (original)
+++ trunk/uim/intl.c Tue Jul 10 00:59:33 2007
@@ -62,7 +62,7 @@
{
const char *new_domain;
- if (uim_scm_nullp(domainname)) {
+ if (UIM_SCM_FALSEP(domainname)) {
new_domain = textdomain(NULL);
} else {
new_domain = textdomain(uim_scm_refer_c_str(domainname));
@@ -78,7 +78,7 @@
domain = uim_scm_refer_c_str(domainname);
- if (uim_scm_nullp(dirname)) {
+ if (UIM_SCM_FALSEP(dirname)) {
new_dir = bindtextdomain(domain, NULL);
} else {
new_dir = bindtextdomain(domain, uim_scm_refer_c_str(dirname));
Modified: trunk/uim/uim-util.c
==============================================================================
--- trunk/uim/uim-util.c (original)
+++ trunk/uim/uim-util.c Tue Jul 10 00:59:33 2007
@@ -293,8 +293,11 @@
strs = uim_strsplit(splittee, splitter);
- if (!strs || !*strs)
+ if (!strs)
return uim_scm_f();
+
+ if (!*strs)
+ return uim_scm_null_list();
for (n_strs = 0; strs[n_strs] != '\0'; n_strs++);
