Author: koutou
Date: Sun Mar 22 00:37:00 2009
New Revision: 5918
Modified:
trunk/test/test-intl.scm (contents, props changed)
Log:
* test/test-intl.scm: update to new style.
Modified: trunk/test/test-intl.scm
==============================================================================
--- trunk/test/test-intl.scm (original)
+++ trunk/test/test-intl.scm Sun Mar 22 00:37:00 2009
@@ -1,5 +1,3 @@
-#!/usr/bin/env gosh
-
;;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/
;;;
;;; All rights reserved.
@@ -29,63 +27,85 @@
;;; SUCH DAMAGE.
;;;;
-;; These tests are passed at revision 5329 (new repository)
+(define-module test.test-intl
+ (use test.unit.test-case)
+ (use test.uim-test)
+ (use file.util)
+ (use gauche.process))
+(select-module test.test-intl)
+
+(define current-lang (or (sys-getenv "LANG")
+ (sys-getenv "LC_ALL")))
+;; At least on glibc 2.6.1-1ubuntu9 on Ubuntu 7.10, gettext(3)
+;; does not read the translation for "en_US" and "C". So I
+;; specify "ja_JP" as an arbitrary locale for these tests.
+;; -- YamaKen 2008-03-23
+;;(define lang "en_US") ;; doesn't work
+;;(define lang "C") ;; doesn't work
+;;(define lang "ja_JP")
+;;
+;; "ja_JP" doesn't work on "ja_JP" isn't generated environment.
+;; For example, "ja_JP" isn't generated but "ja_JP.UTF-8" is
+;; generated on my environment. So, I guess available locales
+;; from "locale -a" and use the current locale as fallback locale.
+;; -- kou 2009-03-22 -- Wow! just (- a-year 1) ago!
+(define lang
+ (let ((locale-process (run-process '("locale" "-a")
+ :output :pipe
+ :error :pipe
+ :wait #t)))
+ (or (and (= 0 (process-exit-status locale-process))
+ (find #/\./ (port->string-list (process-output
locale-process))))
+ current-lang)))
+
+(define locale-dir (uim-test-build-path "test" "locale"))
+(define LC_MESSAGES-dir (build-path locale-dir lang "LC_MESSAGES"))
+(define domain "uim")
+(define msgid "hello")
+(define msgstr "Hello")
+
+
+(define (setup)
+ (make-directory* LC_MESSAGES-dir)
+ (with-output-to-file (build-path LC_MESSAGES-dir #`",|domain|.po")
+ (lambda ()
+ (display
+ (string-join
+ `("msgid \"\""
+ "msgstr \"\""
+ "\"MIME-Version: 1.0\\n\""
+ "\"Content-Type: text/plain; charset=UTF-8\\n\""
+ "\"Content-Transfer-Encoding: 8bit\\n\""
+ ""
+ ,#`"msgid \",|msgid|\""
+ ,#`"msgstr \",|msgstr|\"")
+ "\n"))))
+ (run-process "msgfmt" "-o"
+ (build-path LC_MESSAGES-dir #`",|domain|.mo")
+ (build-path LC_MESSAGES-dir #`",|domain|.po")
+ :wait #t)
+
+ (when lang
+ (sys-putenv "LANG" lang)
+ (sys-putenv "LC_ALL" lang))
+ (uim-test-setup)
+ (when lang
+ (sys-putenv "LANG" current-lang)
+ (sys-putenv "LC_ALL" current-lang)))
+
+(define (teardown)
+ (uim-test-teardown)
-(use test.unit)
-(use file.util)
+ (remove-directory* locale-dir))
-(require "test/uim-test-utils")
+(define (test-gettext)
+ (assert-equal msgid (uim `(gettext ,msgid)))
+ (assert-equal locale-dir (uim `(bindtextdomain ,domain ,locale-dir)))
+ (assert-equal locale-dir (uim `(bindtextdomain ,domain #f)))
+ (assert-equal msgstr (uim `(dgettext ,domain ,msgid)))
+ (assert-equal domain (uim `(textdomain ,domain)))
+ (assert-equal domain (uim `(textdomain #f)))
+ (assert-equal msgstr (uim `(gettext ,msgid)))
+ #f)
-(let* ((current-lang #f)
- ;; At least on glibc 2.6.1-1ubuntu9 on Ubuntu 7.10, gettext(3)
- ;; does not read the translation for "en_US" and "C". So I
- ;; specify "ja_JP" as an arbitrary locale for these tests.
- ;; -- YamaKen 2008-03-23
- ;;(lang "en_US") ;; doesn't work
- ;;(lang "C") ;; doesn't work
- (lang "ja_JP")
- (locale-dir (build-path "test" "locale"))
- (LC_MESSAGES-dir (build-path locale-dir lang "LC_MESSAGES"))
- (domain "uim")
- (msgid "hello")
- (msgstr "Hello"))
- (define-uim-test-case "test intl"
- (setup
- (lambda ()
- (set! current-lang (or (sys-getenv "LANG")
- (sys-getenv "LC_ALL")
- "C"))
- (sys-putenv "LANG" lang)
- (sys-putenv "LC_ALL" lang)
- (make-directory* LC_MESSAGES-dir)
- (with-output-to-file (build-path LC_MESSAGES-dir #`",|domain|.po")
- (lambda ()
- (display
- (string-join
- `("msgid \"\""
- "msgstr \"\""
- "\"MIME-Version: 1.0\\n\""
- "\"Content-Type: text/plain; charset=UTF-8\\n\""
- "\"Content-Transfer-Encoding: 8bit\\n\""
- ""
- ,#`"msgid \",|msgid|\""
- ,#`"msgstr \",|msgstr|\"")
- "\n"))))
- (run-process "msgfmt" "-o"
- (build-path LC_MESSAGES-dir #`",|domain|.mo")
- (build-path LC_MESSAGES-dir #`",|domain|.po")
- :wait #t)
- (*uim-sh-setup-proc*)))
- (teardown
- (lambda ()
- (sys-putenv "LANG" current-lang)
- (sys-putenv "LC_ALL" current-lang)
- (remove-directory* locale-dir)))
- ("test gettext"
- (assert-equal msgid (uim `(gettext ,msgid)))
- (assert-equal locale-dir (uim `(bindtextdomain ,domain ,locale-dir)))
- (assert-equal locale-dir (uim `(bindtextdomain ,domain #f)))
- (assert-equal msgstr (uim `(dgettext ,domain ,msgid)))
- (assert-equal domain (uim `(textdomain ,domain)))
- (assert-equal domain (uim `(textdomain #f)))
- (assert-equal msgstr (uim `(gettext ,msgid))))))
+(provide "test/test-intl")
