(use test)
(use posix)
(use free-gettext)

(setenv "GETTEXT_PATH" "locale")

(define *tests*
  '(("en"
     ("Hello, World!")
     ("Menu|File|Quit" "Quit")
     ("A banana plant in the autumn gale\nI listen to the dripping of rain\nInto a basin at night.\n")
     ("Clouds will separate\nThe two friends, after the migrating\nWild goose's departure\n")
     )
    ("ja"
     ("Hello, World!" "今日は、世界！")
     ("Menu|File|Quit" "終了")
     ("A banana plant in the autumn gale\nI listen to the dripping of rain\nInto a basin at night.\n"
      "芭蕉野分して\nたらいに雨を\n聴く夜かな\n")
     ("Clouds will separate\nThe two friends, after the migrating\nWild goose's departure\n"
      "雲と隔つ\n友かや雁の\n生き別れ\n"))))

(define *plural-tests*
  '(("en"
     ("There is ~A mouse." "There are ~A mice."
      (0 "There are 0 mice.")
      (1 "There is 1 mouse.")
      (2 "There are 2 mice.")))
    ("ja"
     ("There is ~A mouse." "There are ~A mice."
      (0 "0ネズミがあります。")
      (1 "1ネズミがあります。")
      ))))

(define (assoc-ref ls key)
  (cond ((assoc key ls) => cdr)
        (else #f)))

(define (get-optional ls default)
  (if (pair? ls) (car ls) default))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; run the tests

(test-begin "gettext")

(for-each

 (lambda (domain)

   (for-each
    (lambda (locale)
      (let* ((gettext-dispatch (make-gettext domain locale))
             (get (gettext-dispatch 'getter)))
        (for-each
         (lambda (t)
           (test (format "get-~A: ~S" locale (car t))
               (get-optional (cdr t) (car t))
             (get (car t))))
         (assoc-ref *tests* locale))))
    '("en" "ja"))

   ;; plural forms

   (for-each
    (lambda (locale)
      (let* ((gettext-dispatch (make-gettext domain locale))
             (nget (gettext-dispatch 'ngetter)))
        (for-each
         (lambda (t)
           (let ((msg (car t)) (msg2 (cadr t)))
             (for-each
              (lambda (t2)
                (test (format "nget-~A: ~S (~A)" locale msg (car t2))
                    (cadr t2)
                  (format #f (nget msg msg2 (car t2)) (car t2))))
              (cddr t))))
         (assoc-ref *plural-tests* locale))))
    '("en" "ja"))

   ;; using the GNU gettext interface

   (for-each
    (lambda (locale)
      (textdomain domain locale)
      (for-each
       (lambda (t)
         (test (format "gettext-~A: ~S" locale (car t))
             (get-optional (cdr t) (car t))
           (gettext (car t)))
         (test (format "dcgettext-~A: ~S" locale (car t))
             (get-optional (cdr t) (car t))
           (dcgettext domain (car t) locale)))
       (assoc-ref *tests* locale)))
    '("en" "ja")))

 '("test"))

(test-end)