mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Don't presume existence or success of setlocale in test-suite
* test-suite/lib.scm (with-locale, with-locale*): new test functions * test-suite/tests/encoding-escapes: don't fail if en_US.utf8 doesn't exist * test-suite/tests/encoding-iso88591.test: set and restore locale, if possible * test-suite/tests/encoding-iso88597.test: set and restore locale, if possible * test-suite/tests/encoding-utf8.test: set and restore locale, if possible * test-suite/tests/srfi-14.test: don't need to setlocale to Latin-1 to test Latin-1 since string conversion is handled at read/compile time. Set and restore locale, if possible.
This commit is contained in:
Michael Gran
parent
8736ef70ac
commit
ce3ed0125f
6 changed files with 123 additions and 129 deletions
|
|
@ -46,6 +46,9 @@
|
|||
;; Using the debugging evaluator.
|
||||
with-debugging-evaluator with-debugging-evaluator*
|
||||
|
||||
;; Using a given locale
|
||||
with-locale with-locale*
|
||||
|
||||
;; Reporting results in various ways.
|
||||
register-reporter unregister-reporter reporter-registered?
|
||||
make-count-reporter print-counts
|
||||
|
|
@ -437,6 +440,26 @@
|
|||
(define-macro (with-debugging-evaluator . body)
|
||||
`(with-debugging-evaluator* (lambda () ,@body)))
|
||||
|
||||
;;; Call THUNK with a given locale
|
||||
(define (with-locale* nloc thunk)
|
||||
(let ((loc #f))
|
||||
(dynamic-wind
|
||||
(lambda ()
|
||||
(if (defined? 'setlocale)
|
||||
(begin
|
||||
(set! loc
|
||||
(false-if-exception (setlocale LC_ALL nloc)))
|
||||
(if (not loc)
|
||||
(throw 'unresolved)))
|
||||
(throw 'unresolved)))
|
||||
thunk
|
||||
(lambda ()
|
||||
(if (defined? 'setlocale)
|
||||
(setlocale LC_ALL loc))))))
|
||||
|
||||
;;; Evaluate BODY... using the given locale.
|
||||
(define-macro (with-locale loc . body)
|
||||
`(with-locale* ,loc (lambda () ,@body)))
|
||||
|
||||
|
||||
;;;; REPORTERS
|
||||
|
|
|
|||
|
|
@ -125,15 +125,16 @@
|
|||
(string=? "\\u7F85\\u751F\\u9580"
|
||||
(get-output-string pt)))))
|
||||
|
||||
(setlocale LC_ALL "en_US.utf8")
|
||||
|
||||
(with-test-prefix "input escapes"
|
||||
|
||||
(pass-if "última"
|
||||
(with-locale "en_US.utf8"
|
||||
(string=? "última"
|
||||
(with-input-from-string "\"\\xfaltima\"" read)))
|
||||
(with-input-from-string "\"\\xfaltima\"" read))))
|
||||
|
||||
(pass-if "羅生門"
|
||||
(with-locale "en_US.utf8"
|
||||
(string=? "羅生門"
|
||||
(with-input-from-string "\"\\u7F85\\u751F\\u9580\"" read))))
|
||||
(with-input-from-string
|
||||
"\"\\u7F85\\u751F\\u9580\"" read)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -28,7 +28,10 @@
|
|||
(define (string-ints . args)
|
||||
(apply string (map integer->char args)))
|
||||
|
||||
(setlocale LC_ALL "")
|
||||
;; Set locale to the environment's locale, so that the prints look OK.
|
||||
(define oldlocale #f)
|
||||
(if (defined? 'setlocale)
|
||||
(set! oldlocale (setlocale LC_ALL "")))
|
||||
|
||||
(define s1 "última")
|
||||
(define s2 "cédula")
|
||||
|
|
@ -132,4 +135,5 @@
|
|||
(display (string-ints 256) pt))))
|
||||
|
||||
;; Reset locales
|
||||
(setlocale LC_ALL "C")
|
||||
(if (defined? 'setlocale)
|
||||
(setlocale LC_ALL oldlocale))
|
||||
|
|
|
|||
|
|
@ -28,7 +28,9 @@
|
|||
(define (string-ints . args)
|
||||
(apply string (map integer->char args)))
|
||||
|
||||
(setlocale LC_ALL "")
|
||||
(define oldlocale #f)
|
||||
(if (defined? 'setlocale)
|
||||
(set! oldlocale (setlocale LC_ALL "")))
|
||||
|
||||
(define s1 "Ðåñß")
|
||||
(define s2 "ôçò")
|
||||
|
|
@ -133,4 +135,5 @@
|
|||
(display (string-ints #x0400) pt))))
|
||||
|
||||
;; Reset locale
|
||||
(setlocale LC_ALL "C")
|
||||
(if (defined? 'setlocale)
|
||||
(setlocale LC_ALL oldlocale))
|
||||
|
|
|
|||
|
|
@ -28,7 +28,9 @@
|
|||
(define (string-ints . args)
|
||||
(apply string (map integer->char args)))
|
||||
|
||||
(setlocale LC_ALL "")
|
||||
(define oldlocale #f)
|
||||
(if (defined? 'setlocale)
|
||||
(set! oldlocale (setlocale LC_ALL "")))
|
||||
|
||||
(define s1 "última")
|
||||
(define s2 "cédula")
|
||||
|
|
@ -102,4 +104,5 @@
|
|||
(ñ 2))
|
||||
(eq? (+ 芥川龍之介 ñ) 3))))
|
||||
|
||||
|
||||
(if (defined? 'setlocale)
|
||||
(setlocale LC_ALL oldlocale))
|
||||
|
|
|
|||
|
|
@ -238,9 +238,6 @@
|
|||
(string=? (char-set->string cs)
|
||||
"egilu"))))
|
||||
|
||||
;; Make sure we get an ASCII charset and character classification.
|
||||
(if (defined? 'setlocale) (setlocale LC_CTYPE "C"))
|
||||
|
||||
(with-test-prefix "standard char sets (ASCII)"
|
||||
|
||||
(pass-if "char-set:lower-case"
|
||||
|
|
@ -340,50 +337,29 @@
|
|||
(define (every? pred lst)
|
||||
(not (not (every pred lst))))
|
||||
|
||||
(define (find-latin1-locale)
|
||||
;; Try to find and install an ISO-8859-1 locale. Return `#f' on failure.
|
||||
(if (defined? 'setlocale)
|
||||
(let loop ((locales (map (lambda (lang)
|
||||
(string-append lang ".iso88591"))
|
||||
'("de_DE" "en_GB" "en_US" "es_ES"
|
||||
"fr_FR" "it_IT"))))
|
||||
(if (null? locales)
|
||||
#f
|
||||
(if (false-if-exception (setlocale LC_CTYPE (car locales)))
|
||||
(car locales)
|
||||
(loop (cdr locales)))))
|
||||
#f))
|
||||
|
||||
|
||||
(define %latin1 (find-latin1-locale))
|
||||
(define oldlocale #f)
|
||||
(if (defined? 'setlocale)
|
||||
(set! oldlocale (setlocale LC_ALL "")))
|
||||
|
||||
(with-test-prefix "Latin-1 (8-bit charset)"
|
||||
|
||||
(pass-if "char-set:lower-case"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (string->char-set
|
||||
(string-append "abcdefghijklmnopqrstuvwxyz"
|
||||
"µßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ")
|
||||
char-set:lower-case))))
|
||||
char-set:lower-case)))
|
||||
|
||||
(pass-if "char-set:upper-case"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (string->char-set
|
||||
(string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
"ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ")
|
||||
char-set:lower-case))))
|
||||
char-set:lower-case)))
|
||||
|
||||
(pass-if "char-set:title-case"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (string->char-set "")
|
||||
char-set:title-case)))
|
||||
char-set:title-case))
|
||||
|
||||
(pass-if "char-set:letter"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (string->char-set
|
||||
(string-append
|
||||
;; Lowercase
|
||||
|
|
@ -394,60 +370,46 @@
|
|||
"ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ"
|
||||
;; Uncased
|
||||
"ªº"))
|
||||
char-set:letter)))
|
||||
char-set:letter))
|
||||
|
||||
(pass-if "char-set:digit"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (string->char-set "0123456789")
|
||||
char-set:digit)))
|
||||
char-set:digit))
|
||||
|
||||
(pass-if "char-set:hex-digit"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (string->char-set "0123456789abcdefABCDEF")
|
||||
char-set:hex-digit)))
|
||||
char-set:hex-digit))
|
||||
|
||||
(pass-if "char-set:letter+digit"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (char-set-union
|
||||
char-set:letter
|
||||
char-set:digit)
|
||||
char-set:letter+digit)))
|
||||
char-set:letter+digit))
|
||||
|
||||
(pass-if "char-set:punctuation"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (string->char-set
|
||||
(string-append "!\"#%&'()*,-./:;?@[\\]_{}"
|
||||
"¡«·»¿"))
|
||||
char-set:punctuation)))
|
||||
char-set:punctuation))
|
||||
|
||||
(pass-if "char-set:symbol"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (string->char-set
|
||||
(string-append "$+<=>^`|~"
|
||||
"¢£¤¥¦§¨©¬®¯°±´¶¸×÷"))
|
||||
char-set:symbol)))
|
||||
char-set:symbol))
|
||||
|
||||
;; Note that SRFI-14 itself is inconsistent here. Characters that
|
||||
;; are non-digit numbers (such as category No) are clearly 'graphic'
|
||||
;; but don't occur in the letter, digit, punct, or symbol charsets.
|
||||
(pass-if "char-set:graphic"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (char-set-union
|
||||
char-set:letter
|
||||
char-set:digit
|
||||
char-set:punctuation
|
||||
char-set:symbol)
|
||||
char-set:graphic)))
|
||||
char-set:graphic))
|
||||
|
||||
(pass-if "char-set:whitespace"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (string->char-set
|
||||
(string
|
||||
(integer->char #x09)
|
||||
|
|
@ -457,17 +419,13 @@
|
|||
(integer->char #x0d)
|
||||
(integer->char #x20)
|
||||
(integer->char #xa0)))
|
||||
char-set:whitespace)))
|
||||
char-set:whitespace))
|
||||
|
||||
(pass-if "char-set:printing"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (char-set-union char-set:graphic char-set:whitespace)
|
||||
char-set:printing)))
|
||||
char-set:printing))
|
||||
|
||||
(pass-if "char-set:iso-control"
|
||||
(if (not %latin1)
|
||||
(throw 'unresolved)
|
||||
(char-set<= (string->char-set
|
||||
(apply string
|
||||
(map integer->char (append
|
||||
|
|
@ -477,5 +435,7 @@
|
|||
;; U+007F to U+009F
|
||||
(map (lambda (x) (+ #x80 x))
|
||||
(iota #x20))))))
|
||||
char-set:iso-control))))
|
||||
char-set:iso-control)))
|
||||
|
||||
(if (defined? 'setlocale)
|
||||
(setlocale LC_ALL oldlocale))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue