[bpt/guile.git] / test-suite / tests / i18n.test

;;;; i18n.test --- Exercise the i18n API.  -*- coding: utf-8; mode: scheme; -*-
;;;;
;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
;;;; Ludovic Courtès
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

(define-module (test-suite i18n)
  :use-module (ice-9 i18n)
  :use-module (srfi srfi-1)
  :use-module (test-suite lib))

;; Start from a pristine locale state.
(setlocale LC_ALL "C")

(define exception:locale-error
  (cons 'system-error "Failed to install locale"))


\f
(with-test-prefix "locale objects"

  (pass-if "make-locale (2 args)"
    (not (not (make-locale LC_ALL "C"))))

  (pass-if "make-locale (2 args, list)"
    (not (not (make-locale (list LC_COLLATE LC_MESSAGES) "C"))))

  (pass-if "make-locale (3 args)"
    (not (not (make-locale (list LC_COLLATE) "C"
                           (make-locale (list LC_MESSAGES) "C")))))

  (pass-if-exception "make-locale with unknown locale" exception:locale-error
    (make-locale LC_ALL "does-not-exist"))

  (pass-if "locale?"
    (and (locale? (make-locale (list LC_ALL) "C"))
         (locale? (make-locale (list LC_MESSAGES LC_NUMERIC) "C"
                               (make-locale (list LC_CTYPE) "C")))))

  (pass-if "%global-locale"
    (and (locale? %global-locale))
         (locale? (make-locale (list LC_MONETARY) "C"
                               %global-locale))))


\f
(with-test-prefix "text collation (English)"

  (pass-if "string-locale<?"
    (and (string-locale<? "hello" "world")
         (string-locale<? "hello" "world"
                          (make-locale (list LC_COLLATE) "C"))))

  (pass-if "char-locale<?"
    (and (char-locale<? #\a #\b)
         (char-locale<? #\a #\b (make-locale (list LC_COLLATE) "C"))))

  (pass-if "string-locale-ci=?"
    (and (string-locale-ci=? "Hello" "HELLO")
         (string-locale-ci=? "Hello" "HELLO"
                             (make-locale (list LC_COLLATE) "C"))))

  (pass-if "string-locale-ci<?"
    (and (string-locale-ci<? "hello" "WORLD")
         (string-locale-ci<? "hello" "WORLD"
                             (make-locale (list LC_COLLATE) "C")))))

\f
(define %french-locale-name
  "fr_FR.ISO-8859-1")

(define %french-utf8-locale-name
  "fr_FR.UTF-8")

(define %french-locale
  (false-if-exception
   (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
                %french-locale-name)))

(define %french-utf8-locale
  (false-if-exception
   (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
                %french-utf8-locale-name)))

(define (under-locale-or-unresolved locale thunk)
  ;; On non-GNU systems, an exception may be raised only when the locale is
  ;; actually used rather than at `make-locale'-time.  Thus, we must guard
  ;; against both.
  (if locale
      (if (string-contains %host-type "-gnu")
          (thunk)
          (catch 'system-error thunk
                 (lambda (key . args)
                   (throw 'unresolved))))
      (throw 'unresolved)))

(define (under-french-locale-or-unresolved thunk)
  (under-locale-or-unresolved %french-locale thunk))

(define (under-french-utf8-locale-or-unresolved thunk)
  (under-locale-or-unresolved %french-utf8-locale thunk))


(with-test-prefix "text collation (French)"

  (pass-if "string-locale<?"
    (under-french-locale-or-unresolved
      (lambda ()
        (string-locale<? "été" "hiver" %french-locale))))

  (pass-if "char-locale<?"
    (under-french-locale-or-unresolved
      (lambda ()
        (char-locale<? #\é #\h %french-locale))))

  (pass-if "string-locale-ci=?"
    (under-french-locale-or-unresolved
      (lambda ()
        (string-locale-ci=? "ÉTÉ" "été" %french-locale))))

  (pass-if "string-locale-ci=? (2 args, wide strings)"
    (under-french-utf8-locale-or-unresolved
      (lambda ()
        ;; Note: Character `œ' is not part of Latin-1, so these are wide
        ;; strings.
        (dynamic-wind
          (lambda ()
            (setlocale LC_ALL "fr_FR.UTF-8"))
          (lambda ()
            (string-locale-ci=? "œuf" "ŒUF"))
          (lambda ()
            (setlocale LC_ALL "C"))))))

  (pass-if "string-locale-ci=? (3 args, wide strings)"
    (under-french-utf8-locale-or-unresolved
      (lambda ()
        (string-locale-ci=? "œuf" "ŒUF" %french-utf8-locale))))

  (pass-if "string-locale-ci<>?"
    (under-french-locale-or-unresolved
      (lambda ()
        (and (string-locale-ci<? "été" "Hiver" %french-locale)
             (string-locale-ci>? "HiVeR" "été" %french-locale)))))

  (pass-if "string-locale-ci<>? (wide strings)"
    (under-french-utf8-locale-or-unresolved
      (lambda ()
        ;; One of the strings is UCS-4, the other is Latin-1.
        (and (string-locale-ci<? "Œdème" "œuf" %french-utf8-locale)
             (string-locale-ci>? "Œuf" "œdÈMe" %french-utf8-locale)))))

  (pass-if "string-locale-ci<>? (wide and narrow strings)"
    (under-french-utf8-locale-or-unresolved
      (lambda ()
        ;; One of the strings is UCS-4, the other is Latin-1.
        (and (string-locale-ci>? "Œdème" "odyssée" %french-utf8-locale)
             (string-locale-ci<? "Odyssée" "œdème" %french-utf8-locale)))))

  (pass-if "char-locale-ci<>?"
     (under-french-locale-or-unresolved
       (lambda ()
         (and (char-locale-ci<? #\é #\H %french-locale)
              (char-locale-ci>? #\h #\É %french-locale)))))

  (pass-if "char-locale-ci<>? (wide)"
     (under-french-utf8-locale-or-unresolved
       (lambda ()
         (and (char-locale-ci<? #\o #\œ %french-utf8-locale)
              (char-locale-ci>? #\Œ #\e %french-utf8-locale))))))

\f
(with-test-prefix "character mapping"

  (pass-if "char-locale-downcase"
    (and (eq? #\a (char-locale-downcase #\A))
         (eq? #\a (char-locale-downcase #\A (make-locale LC_ALL "C")))))

  (pass-if "char-locale-upcase"
    (and (eq? #\Z (char-locale-upcase #\z))
         (eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C"))))))

\f
(with-test-prefix "number parsing"

  (pass-if "locale-string->integer"
    (call-with-values (lambda () (locale-string->integer "123"))
      (lambda (result char-count)
        (and (equal? result 123)
             (equal? char-count 3)))))

  (pass-if "locale-string->inexact"
    (call-with-values
        (lambda ()
          (locale-string->inexact "123.456"
                                  (make-locale (list LC_NUMERIC) "C")))
      (lambda (result char-count)
        (and (equal? result 123.456)
             (equal? char-count 7)))))

  (pass-if "locale-string->inexact (French)"
    (under-french-locale-or-unresolved
     (lambda ()
       (call-with-values
           (lambda ()
             (locale-string->inexact "123,456" %french-locale))
         (lambda (result char-count)
           (and (equal? result 123.456)
                (equal? char-count 7))))))))

\f
;;;
;;; `nl-langinfo'
;;;

(setlocale LC_ALL "C")
(define %c-locale (make-locale LC_ALL "C"))

(define %english-days
  '("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"))

(define (every? . args)
  (not (not (apply every args))))


(with-test-prefix "nl-langinfo et al."

  (pass-if "locale-day (1 arg)"
    (every? equal?
            %english-days
            (map locale-day (map 1+ (iota 7)))))

  (pass-if "locale-day (2 args)"
    (every? equal?
            %english-days
            (map (lambda (day)
                   (locale-day day %c-locale))
                 (map 1+ (iota 7)))))

  (pass-if "locale-day (2 args, using `%global-locale')"
    (every? equal?
            %english-days
            (map (lambda (day)
                   (locale-day day %global-locale))
                 (map 1+ (iota 7)))))

  (pass-if "locale-day (French)"
    (under-french-locale-or-unresolved
     (lambda ()
       (let ((result (locale-day 3 %french-locale)))
         (and (string? result)
              (string-ci=? result "mardi"))))))

  (pass-if "locale-day (French, using `%global-locale')"
    ;; Make sure `%global-locale' captures the current locale settings as
    ;; installed using `setlocale'.
    (under-french-locale-or-unresolved
     (lambda ()
       (dynamic-wind
           (lambda ()
             (setlocale LC_TIME %french-locale-name))
           (lambda ()
             (let* ((fr (make-locale (list LC_MONETARY) "C" %global-locale))
                    (result (locale-day 3 fr)))
               (setlocale LC_ALL "C")
               (and (string? result)
                    (string-ci=? result "mardi"))))
           (lambda ()
             (setlocale LC_ALL "C"))))))

  (pass-if "default locale"
    ;; Make sure the default locale does not capture the current locale
    ;; settings as installed using `setlocale'.  The default locale should be
    ;; "C".
    (under-french-locale-or-unresolved
     (lambda ()
       (dynamic-wind
           (lambda ()
             (setlocale LC_ALL %french-locale-name))
           (lambda ()
             (let* ((locale (make-locale (list LC_MONETARY) "C"))
                    (result (locale-day 3 locale)))
               (setlocale LC_ALL "C")
               (and (string? result)
                    (string-ci=? result "Tuesday"))))
           (lambda ()
             (setlocale LC_ALL "C")))))))
Commit	Line	Data
cdf52ff0	1	;;;; i18n.test --- Exercise the i18n API. -- coding: utf-8; mode: scheme; --
5b3a39c7	2	;;;;
cdf52ff0 LC	3	;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
cdf52ff0 LC	4	;;;; Ludovic Courtès
5b3a39c7 LC	5	;;;;
	6	;;;; This library is free software; you can redistribute it and/or
	7	;;;; modify it under the terms of the GNU Lesser General Public
	8	;;;; License as published by the Free Software Foundation; either
53befeb7 NJ	9	;;;; version 3 of the License, or (at your option) any later version.
53befeb7 NJ	10	;;;;
5b3a39c7 LC	11	;;;; This library is distributed in the hope that it will be useful,
	12	;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	14	;;;; Lesser General Public License for more details.
53befeb7	15	;;;;
5b3a39c7 LC	16	;;;; You should have received a copy of the GNU Lesser General Public
	17	;;;; License along with this library; if not, write to the Free Software
	18	;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
	19
	20	(define-module (test-suite i18n)
	21	:use-module (ice-9 i18n)
a2f00b9b	22	:use-module (srfi srfi-1)
5b3a39c7 LC	23	:use-module (test-suite lib))
	24
	25	;; Start from a pristine locale state.
	26	(setlocale LC_ALL "C")
	27
a2f00b9b LC	28	(define exception:locale-error
	29	(cons 'system-error "Failed to install locale"))
	30
	31
5b3a39c7 LC	32	\f
	33	(with-test-prefix "locale objects"
	34
	35	(pass-if "make-locale (2 args)"
a2f00b9b LC	36	(not (not (make-locale LC_ALL "C"))))
	37
	38	(pass-if "make-locale (2 args, list)"
	39	(not (not (make-locale (list LC_COLLATE LC_MESSAGES) "C"))))
5b3a39c7 LC	40
5b3a39c7 LC	41	(pass-if "make-locale (3 args)"
a2f00b9b LC	42	(not (not (make-locale (list LC_COLLATE) "C"
	43	(make-locale (list LC_MESSAGES) "C")))))
	44
	45	(pass-if-exception "make-locale with unknown locale" exception:locale-error
	46	(make-locale LC_ALL "does-not-exist"))
5b3a39c7 LC	47
5b3a39c7 LC	48	(pass-if "locale?"
a2f00b9b LC	49	(and (locale? (make-locale (list LC_ALL) "C"))
	50	(locale? (make-locale (list LC_MESSAGES LC_NUMERIC) "C"
	51	(make-locale (list LC_CTYPE) "C")))))
	52
	53	(pass-if "%global-locale"
	54	(and (locale? %global-locale))
	55	(locale? (make-locale (list LC_MONETARY) "C"
	56	%global-locale))))
5b3a39c7 LC	57
	58
	59	\f
	60	(with-test-prefix "text collation (English)"
	61
	62	(pass-if "string-locale<?"
	63	(and (string-locale<? "hello" "world")
	64	(string-locale<? "hello" "world"
a2f00b9b	65	(make-locale (list LC_COLLATE) "C"))))
5b3a39c7 LC	66
	67	(pass-if "char-locale<?"
	68	(and (char-locale<? #\a #\b)
a2f00b9b	69	(char-locale<? #\a #\b (make-locale (list LC_COLLATE) "C"))))
5b3a39c7 LC	70
	71	(pass-if "string-locale-ci=?"
	72	(and (string-locale-ci=? "Hello" "HELLO")
	73	(string-locale-ci=? "Hello" "HELLO"
a2f00b9b	74	(make-locale (list LC_COLLATE) "C"))))
5b3a39c7 LC	75
	76	(pass-if "string-locale-ci<?"
	77	(and (string-locale-ci<? "hello" "WORLD")
	78	(string-locale-ci<? "hello" "WORLD"
a2f00b9b	79	(make-locale (list LC_COLLATE) "C")))))
5b3a39c7 LC	80
5b3a39c7 LC	81	\f
a2f00b9b LC	82	(define %french-locale-name
	83	"fr_FR.ISO-8859-1")
	84
cdf52ff0 LC	85	(define %french-utf8-locale-name
	86	"fr_FR.UTF-8")
	87
5b3a39c7 LC	88	(define %french-locale
5b3a39c7 LC	89	(false-if-exception
a2f00b9b LC	90	(make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
a2f00b9b LC	91	%french-locale-name)))
5b3a39c7	92
cdf52ff0 LC	93	(define %french-utf8-locale
	94	(false-if-exception
	95	(make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
	96	%french-utf8-locale-name)))
	97
	98	(define (under-locale-or-unresolved locale thunk)
5b3a39c7 LC	99	;; On non-GNU systems, an exception may be raised only when the locale is
	100	;; actually used rather than at `make-locale'-time. Thus, we must guard
	101	;; against both.
cdf52ff0 LC	102	(if locale
	103	(if (string-contains %host-type "-gnu")
	104	(thunk)
	105	(catch 'system-error thunk
	106	(lambda (key . args)
	107	(throw 'unresolved))))
5b3a39c7 LC	108	(throw 'unresolved)))
5b3a39c7 LC	109
cdf52ff0 LC	110	(define (under-french-locale-or-unresolved thunk)
	111	(under-locale-or-unresolved %french-locale thunk))
	112
	113	(define (under-french-utf8-locale-or-unresolved thunk)
	114	(under-locale-or-unresolved %french-utf8-locale thunk))
	115
	116
5b3a39c7 LC	117	(with-test-prefix "text collation (French)"
	118
	119	(pass-if "string-locale<?"
	120	(under-french-locale-or-unresolved
	121	(lambda ()
cdf52ff0	122	(string-locale<? "été" "hiver" %french-locale))))
5b3a39c7 LC	123
	124	(pass-if "char-locale<?"
	125	(under-french-locale-or-unresolved
	126	(lambda ()
cdf52ff0	127	(char-locale<? #\é #\h %french-locale))))
5b3a39c7 LC	128
	129	(pass-if "string-locale-ci=?"
	130	(under-french-locale-or-unresolved
	131	(lambda ()
cdf52ff0 LC	132	(string-locale-ci=? "ÉTÉ" "été" %french-locale))))
	133
	134	(pass-if "string-locale-ci=? (2 args, wide strings)"
	135	(under-french-utf8-locale-or-unresolved
	136	(lambda ()
	137	;; Note: Character `œ' is not part of Latin-1, so these are wide
	138	;; strings.
	139	(dynamic-wind
	140	(lambda ()
	141	(setlocale LC_ALL "fr_FR.UTF-8"))
	142	(lambda ()
	143	(string-locale-ci=? "œuf" "ŒUF"))
	144	(lambda ()
	145	(setlocale LC_ALL "C"))))))
	146
	147	(pass-if "string-locale-ci=? (3 args, wide strings)"
	148	(under-french-utf8-locale-or-unresolved
	149	(lambda ()
	150	(string-locale-ci=? "œuf" "ŒUF" %french-utf8-locale))))
5b3a39c7 LC	151
	152	(pass-if "string-locale-ci<>?"
	153	(under-french-locale-or-unresolved
	154	(lambda ()
cdf52ff0 LC	155	(and (string-locale-ci<? "été" "Hiver" %french-locale)
	156	(string-locale-ci>? "HiVeR" "été" %french-locale)))))
	157
	158	(pass-if "string-locale-ci<>? (wide strings)"
	159	(under-french-utf8-locale-or-unresolved
	160	(lambda ()
	161	;; One of the strings is UCS-4, the other is Latin-1.
	162	(and (string-locale-ci<? "Œdème" "œuf" %french-utf8-locale)
	163	(string-locale-ci>? "Œuf" "œdÈMe" %french-utf8-locale)))))
	164
	165	(pass-if "string-locale-ci<>? (wide and narrow strings)"
	166	(under-french-utf8-locale-or-unresolved
	167	(lambda ()
	168	;; One of the strings is UCS-4, the other is Latin-1.
	169	(and (string-locale-ci>? "Œdème" "odyssée" %french-utf8-locale)
	170	(string-locale-ci<? "Odyssée" "œdème" %french-utf8-locale)))))
5b3a39c7 LC	171
	172	(pass-if "char-locale-ci<>?"
	173	(under-french-locale-or-unresolved
	174	(lambda ()
cdf52ff0 LC	175	(and (char-locale-ci<? #\é #\H %french-locale)
	176	(char-locale-ci>? #\h #\É %french-locale)))))
	177
	178	(pass-if "char-locale-ci<>? (wide)"
	179	(under-french-utf8-locale-or-unresolved
	180	(lambda ()
	181	(and (char-locale-ci<? #\o #\œ %french-utf8-locale)
	182	(char-locale-ci>? #\Œ #\e %french-utf8-locale))))))
5b3a39c7 LC	183
	184	\f
	185	(with-test-prefix "character mapping"
	186
	187	(pass-if "char-locale-downcase"
	188	(and (eq? #\a (char-locale-downcase #\A))
a2f00b9b	189	(eq? #\a (char-locale-downcase #\A (make-locale LC_ALL "C")))))
5b3a39c7 LC	190
	191	(pass-if "char-locale-upcase"
	192	(and (eq? #\Z (char-locale-upcase #\z))
a2f00b9b	193	(eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C"))))))
5b3a39c7 LC	194
	195	\f
	196	(with-test-prefix "number parsing"
	197
	198	(pass-if "locale-string->integer"
	199	(call-with-values (lambda () (locale-string->integer "123"))
	200	(lambda (result char-count)
	201	(and (equal? result 123)
	202	(equal? char-count 3)))))
	203
	204	(pass-if "locale-string->inexact"
	205	(call-with-values
	206	(lambda ()
	207	(locale-string->inexact "123.456"
a2f00b9b	208	(make-locale (list LC_NUMERIC) "C")))
5b3a39c7 LC	209	(lambda (result char-count)
5b3a39c7 LC	210	(and (equal? result 123.456)
a2f00b9b LC	211	(equal? char-count 7)))))
	212
	213	(pass-if "locale-string->inexact (French)"
	214	(under-french-locale-or-unresolved
	215	(lambda ()
	216	(call-with-values
	217	(lambda ()
	218	(locale-string->inexact "123,456" %french-locale))
	219	(lambda (result char-count)
	220	(and (equal? result 123.456)
	221	(equal? char-count 7))))))))
	222
	223	\f
	224	;;;
	225	;;; `nl-langinfo'
	226	;;;
	227
	228	(setlocale LC_ALL "C")
	229	(define %c-locale (make-locale LC_ALL "C"))
	230
	231	(define %english-days
	232	'("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"))
	233
	234	(define (every? . args)
	235	(not (not (apply every args))))
	236
	237
	238	(with-test-prefix "nl-langinfo et al."
	239
	240	(pass-if "locale-day (1 arg)"
	241	(every? equal?
	242	%english-days
	243	(map locale-day (map 1+ (iota 7)))))
	244
	245	(pass-if "locale-day (2 args)"
	246	(every? equal?
	247	%english-days
	248	(map (lambda (day)
	249	(locale-day day %c-locale))
	250	(map 1+ (iota 7)))))
	251
	252	(pass-if "locale-day (2 args, using `%global-locale')"
	253	(every? equal?
	254	%english-days
	255	(map (lambda (day)
	256	(locale-day day %global-locale))
	257	(map 1+ (iota 7)))))
	258
	259	(pass-if "locale-day (French)"
	260	(under-french-locale-or-unresolved
	261	(lambda ()
	262	(let ((result (locale-day 3 %french-locale)))
	263	(and (string? result)
	264	(string-ci=? result "mardi"))))))
	265
	266	(pass-if "locale-day (French, using `%global-locale')"
	267	;; Make sure `%global-locale' captures the current locale settings as
	268	;; installed using `setlocale'.
	269	(under-french-locale-or-unresolved
	270	(lambda ()
	271	(dynamic-wind
	272	(lambda ()
	273	(setlocale LC_TIME %french-locale-name))
	274	(lambda ()
275	(let* ((fr (make-locale (list LC_MONETARY) "C" %global-locale))
276	(result (locale-day 3 fr)))
277	(setlocale LC_ALL "C")
278	(and (string? result)
279	(string-ci=? result "mardi"))))
280	(lambda ()
281	(setlocale LC_ALL "C"))))))
282
283	(pass-if "default locale"
284	;; Make sure the default locale does not capture the current locale
285	;; settings as installed using `setlocale'. The default locale should be
286	;; "C".
287	(under-french-locale-or-unresolved
288	(lambda ()
289	(dynamic-wind
290	(lambda ()
291	(setlocale LC_ALL %french-locale-name))
292	(lambda ()
293	(let* ((locale (make-locale (list LC_MONETARY) "C"))
294	(result (locale-day 3 locale)))
295	(setlocale LC_ALL "C")
296	(and (string? result)
297	(string-ci=? result "Tuesday"))))
298	(lambda ()
299	(setlocale LC_ALL "C")))))))