dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
guile/test-suite/tests/i18n.test
Michael Gran 03d80c0327 Revert changes that gather thread-specific local language 
The method used was not portable.  However, the underlying problem
still exists: the uc_locale_language used by libunistring does not
work with thread-specific locale_t locales.

* libguile/i18n.c (locale_language): avoid unpacking semi-opaque type
  locale_t.

* test-suite/tests/i18n.test: set Turkish string and char locale upcase
  and downcase tests to throw untested
2009-10-09 07:06:14 -07:00

352 lines
12 KiB
Scheme
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;;; 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"))
(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))))
(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")))))
(define %french-locale-name
"fr_FR.ISO-8859-1")
(define %french-utf8-locale-name
"fr_FR.UTF-8")
(define %turkish-utf8-locale-name
"tr_TR.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 %turkish-utf8-locale
(false-if-exception
(make-locale LC_ALL
%turkish-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))
(define (under-turkish-utf8-locale-or-unresolved thunk)
(under-locale-or-unresolved %turkish-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))))))
(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")))))
(pass-if "char-locale-upcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
;; This test is disabled for now, because char-locale-upcase is
;; incomplete.
(throw 'untested)
(eq? #\İ (char-locale-upcase #\i %turkish-utf8-locale)))))
(pass-if "char-locale-downcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
;; This test is disabled for now, because char-locale-downcase
;; is incomplete.
(throw 'untested)
(eq? #\i (char-locale-downcase #\İ %turkish-utf8-locale))))))
(with-test-prefix "string mapping"
(pass-if "string-locale-downcase"
(and (string=? "a" (string-locale-downcase "A"))
(string=? "a" (string-locale-downcase "A" (make-locale LC_ALL "C")))))
(pass-if "string-locale-upcase"
(and (string=? "Z" (string-locale-upcase "z"))
(string=? "Z" (string-locale-upcase "z" (make-locale LC_ALL "C")))))
(pass-if "string-locale-upcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
;; This test is disabled for now, because string-locale-upcase
;; is incomplete.
(throw 'untested)
(string=? "İI" (string-locale-upcase "iı" %turkish-utf8-locale)))))
(pass-if "string-locale-downcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
;; This test is disabled for now, because
;; string-locale-downcase is incomplete.
(throw 'untested)
(string=? "iı" (string-locale-downcase "İI" %turkish-utf8-locale))))))
(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))))))))
;;;
;;; `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")))))))
Reference in a new issue View git blame Copy permalink