| 1 | ;;;; i18n.test --- Exercise the i18n API. -*- coding: utf-8; mode: scheme; -*- |
| 2 | ;;;; |
| 3 | ;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. |
| 4 | ;;;; Ludovic Courtès |
| 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 |
| 9 | ;;;; version 3 of the License, or (at your option) any later version. |
| 10 | ;;;; |
| 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. |
| 15 | ;;;; |
| 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) |
| 22 | :use-module (srfi srfi-1) |
| 23 | :use-module (test-suite lib)) |
| 24 | |
| 25 | ;; Start from a pristine locale state. |
| 26 | (setlocale LC_ALL "C") |
| 27 | |
| 28 | (define exception:locale-error |
| 29 | (cons 'system-error "Failed to install locale")) |
| 30 | |
| 31 | |
| 32 | \f |
| 33 | (with-test-prefix "locale objects" |
| 34 | |
| 35 | (pass-if "make-locale (2 args)" |
| 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")))) |
| 40 | |
| 41 | (pass-if "make-locale (3 args)" |
| 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")) |
| 47 | |
| 48 | (pass-if "locale?" |
| 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)))) |
| 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" |
| 65 | (make-locale (list LC_COLLATE) "C")))) |
| 66 | |
| 67 | (pass-if "char-locale<?" |
| 68 | (and (char-locale<? #\a #\b) |
| 69 | (char-locale<? #\a #\b (make-locale (list LC_COLLATE) "C")))) |
| 70 | |
| 71 | (pass-if "string-locale-ci=?" |
| 72 | (and (string-locale-ci=? "Hello" "HELLO") |
| 73 | (string-locale-ci=? "Hello" "HELLO" |
| 74 | (make-locale (list LC_COLLATE) "C")))) |
| 75 | |
| 76 | (pass-if "string-locale-ci<?" |
| 77 | (and (string-locale-ci<? "hello" "WORLD") |
| 78 | (string-locale-ci<? "hello" "WORLD" |
| 79 | (make-locale (list LC_COLLATE) "C"))))) |
| 80 | |
| 81 | \f |
| 82 | (define %french-locale-name |
| 83 | "fr_FR.ISO-8859-1") |
| 84 | |
| 85 | (define %french-utf8-locale-name |
| 86 | "fr_FR.UTF-8") |
| 87 | |
| 88 | (define %french-locale |
| 89 | (false-if-exception |
| 90 | (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME) |
| 91 | %french-locale-name))) |
| 92 | |
| 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) |
| 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. |
| 102 | (if locale |
| 103 | (if (string-contains %host-type "-gnu") |
| 104 | (thunk) |
| 105 | (catch 'system-error thunk |
| 106 | (lambda (key . args) |
| 107 | (throw 'unresolved)))) |
| 108 | (throw 'unresolved))) |
| 109 | |
| 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 | |
| 117 | (with-test-prefix "text collation (French)" |
| 118 | |
| 119 | (pass-if "string-locale<?" |
| 120 | (under-french-locale-or-unresolved |
| 121 | (lambda () |
| 122 | (string-locale<? "été" "hiver" %french-locale)))) |
| 123 | |
| 124 | (pass-if "char-locale<?" |
| 125 | (under-french-locale-or-unresolved |
| 126 | (lambda () |
| 127 | (char-locale<? #\é #\h %french-locale)))) |
| 128 | |
| 129 | (pass-if "string-locale-ci=?" |
| 130 | (under-french-locale-or-unresolved |
| 131 | (lambda () |
| 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)))) |
| 151 | |
| 152 | (pass-if "string-locale-ci<>?" |
| 153 | (under-french-locale-or-unresolved |
| 154 | (lambda () |
| 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))))) |
| 171 | |
| 172 | (pass-if "char-locale-ci<>?" |
| 173 | (under-french-locale-or-unresolved |
| 174 | (lambda () |
| 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)))))) |
| 183 | |
| 184 | \f |
| 185 | (with-test-prefix "character mapping" |
| 186 | |
| 187 | (pass-if "char-locale-downcase" |
| 188 | (and (eq? #\a (char-locale-downcase #\A)) |
| 189 | (eq? #\a (char-locale-downcase #\A (make-locale LC_ALL "C"))))) |
| 190 | |
| 191 | (pass-if "char-locale-upcase" |
| 192 | (and (eq? #\Z (char-locale-upcase #\z)) |
| 193 | (eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))) |
| 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" |
| 208 | (make-locale (list LC_NUMERIC) "C"))) |
| 209 | (lambda (result char-count) |
| 210 | (and (equal? result 123.456) |
| 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"))))))) |