source: project/release/4/free-gettext/tags/1.5.1/test-free-gettext.scm @ 27250

Last change on this file since 27250 was 27250, checked in by Alex Shinn, 9 years ago

Supporting .mo files without a header (guessing utf8).

File size: 2.8 KB
Line 
1
2(use test)
3(use posix)
4(use free-gettext)
5
6(setenv "GETTEXT_PATH" "locale")
7
8(define *tests*
9  '(("en"
10     ("Hello, World!")
11     ("Menu|File|Quit" "Quit")
12     ("A banana plant in the autumn gale\nI listen to the dripping of rain\nInto a basin at night.\n")
13     ("Clouds will separate\nThe two friends, after the migrating\nWild goose's departure\n")
14     )
15    ("ja"
16     ("Hello, World!" "今日は、䞖界")
17     ("Menu|File|Quit" "終了")
18     ("A banana plant in the autumn gale\nI listen to the dripping of rain\nInto a basin at night.\n"
19      "芭蕉野分しお\nたらいに雚を\n聎く倜かな\n")
20     ("Clouds will separate\nThe two friends, after the migrating\nWild goose's departure\n"
21      "雲ず隔぀\n友かや雁の\n生き別れ\n"))
22    ))
23
24(define *plural-tests*
25  '(("en"
26     ("There is ~A mouse." "There are ~A mice."
27      (0 "There are 0 mice.")
28      (1 "There is 1 mouse.")
29      (2 "There are 2 mice.")))
30    ("ja"
31     ("There is ~A mouse." "There are ~A mice."
32      (0 "0ネズミがありたす。")
33      (1 "1ネズミがありたす。")
34      ))))
35
36(define (assoc-ref ls key)
37  (cond ((assoc key ls) => cdr)
38        (else #f)))
39
40(define (get-optional ls default)
41  (if (pair? ls) (car ls) default))
42
43;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44;; run the tests
45
46(test-begin "gettext")
47
48(for-each
49
50 (lambda (domain)
51
52   (for-each
53    (lambda (locale)
54      (let* ((gettext-dispatch (make-gettext domain locale))
55             (get (gettext-dispatch 'getter)))
56        (for-each
57         (lambda (t)
58           (test (format "get-~A: ~S" locale (car t))
59               (get-optional (cdr t) (car t))
60             (get (car t))))
61         (assoc-ref *tests* locale))))
62    '("en" "ja"))
63
64   ;; plural forms
65
66   (for-each
67    (lambda (locale)
68      (let* ((gettext-dispatch (make-gettext domain locale))
69             (nget (gettext-dispatch 'ngetter)))
70        (for-each
71         (lambda (t)
72           (let ((msg (car t)) (msg2 (cadr t)))
73             (for-each
74              (lambda (t2)
75                (test (format "nget-~A: ~S (~A)" locale msg (car t2))
76                    (cadr t2)
77                  (format #f (nget msg msg2 (car t2)) (car t2))))
78              (cddr t))))
79         (assoc-ref *plural-tests* locale))))
80    '("en" "ja"))
81
82   ;; using the GNU gettext interface
83
84   (for-each
85    (lambda (locale)
86      (textdomain domain locale)
87      (for-each
88       (lambda (t)
89         (test (format "gettext-~A: ~S" locale (car t))
90             (get-optional (cdr t) (car t))
91           (gettext (car t)))
92         (test (format "dcgettext-~A: ~S" locale (car t))
93             (get-optional (cdr t) (car t))
94           (dcgettext domain (car t) locale)))
95       (assoc-ref *tests* locale)))
96    '("en" "ja")))
97
98 '("test" "motest"))
99
100(test-end)
Note: See TracBrowser for help on using the repository browser.