summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--test-suite/lib.scm23
-rw-r--r--test-suite/tests/encoding-escapes.test27
-rw-r--r--test-suite/tests/encoding-iso88591.test8
-rw-r--r--test-suite/tests/encoding-iso88597.test7
-rw-r--r--test-suite/tests/encoding-utf8.test7
-rw-r--r--test-suite/tests/srfi-14.test182
6 files changed, 124 insertions, 130 deletions
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index 8190d1fd0..e5b7a0813 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -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
diff --git a/test-suite/tests/encoding-escapes.test b/test-suite/tests/encoding-escapes.test
index 8859d2e83..ea7a821e7 100644
--- a/test-suite/tests/encoding-escapes.test
+++ b/test-suite/tests/encoding-escapes.test
@@ -118,22 +118,23 @@
(string=? "\\xfaltima"
(get-output-string pt))))
(pass-if "Rashomon"
- (let ((pt (open-output-string)))
- (set-port-encoding! pt "ASCII")
- (set-port-conversion-strategy! pt 'escape)
- (display s4 pt)
- (string=? "\\u7F85\\u751F\\u9580"
- (get-output-string pt)))))
-
-(setlocale LC_ALL "en_US.utf8")
+ (let ((pt (open-output-string)))
+ (set-port-encoding! pt "ASCII")
+ (set-port-conversion-strategy! pt 'escape)
+ (display s4 pt)
+ (string=? "\\u7F85\\u751F\\u9580"
+ (get-output-string pt)))))
(with-test-prefix "input escapes"
- (pass-if "última"
- (string=? "última"
- (with-input-from-string "\"\\xfaltima\"" read)))
+ (pass-if "última"
+ (with-locale "en_US.utf8"
+ (string=? "última"
+ (with-input-from-string "\"\\xfaltima\"" read))))
(pass-if "羅生門"
- (string=? "羅生門"
- (with-input-from-string "\"\\u7F85\\u751F\\u9580\"" read))))
+ (with-locale "en_US.utf8"
+ (string=? "羅生門"
+ (with-input-from-string
+ "\"\\u7F85\\u751F\\u9580\"" read)))))
diff --git a/test-suite/tests/encoding-iso88591.test b/test-suite/tests/encoding-iso88591.test
index edd573432..d4de5e534 100644
--- a/test-suite/tests/encoding-iso88591.test
+++ b/test-suite/tests/encoding-iso88591.test
@@ -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 "cdula")
@@ -132,4 +135,5 @@
(display (string-ints 256) pt))))
;; Reset locales
-(setlocale LC_ALL "C") \ No newline at end of file
+(if (defined? 'setlocale)
+ (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/encoding-iso88597.test b/test-suite/tests/encoding-iso88597.test
index 8985042f4..22212690c 100644
--- a/test-suite/tests/encoding-iso88597.test
+++ b/test-suite/tests/encoding-iso88597.test
@@ -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") \ No newline at end of file
+(if (defined? 'setlocale)
+ (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/encoding-utf8.test b/test-suite/tests/encoding-utf8.test
index 83e7540f3..a2613f1d7 100644
--- a/test-suite/tests/encoding-utf8.test
+++ b/test-suite/tests/encoding-utf8.test
@@ -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))
diff --git a/test-suite/tests/srfi-14.test b/test-suite/tests/srfi-14.test
index 2bb934aac..56c944a42 100644
--- a/test-suite/tests/srfi-14.test
+++ b/test-suite/tests/srfi-14.test
@@ -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,142 +337,105 @@
(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<= (string->char-set
+ (string-append "abcdefghijklmnopqrstuvwxyz"
+ "")
+ 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<= (string->char-set
+ (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "")
+ 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<= (string->char-set "")
+ char-set:title-case))
(pass-if "char-set:letter"
- (if (not %latin1)
- (throw 'unresolved)
- (char-set<= (string->char-set
- (string-append
- ;; Lowercase
- "abcdefghijklmnopqrstuvwxyz"
- ""
- ;; Uppercase
- "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- ""
- ;; Uncased
- ""))
- char-set:letter)))
+ (char-set<= (string->char-set
+ (string-append
+ ;; Lowercase
+ "abcdefghijklmnopqrstuvwxyz"
+ ""
+ ;; Uppercase
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ ""
+ ;; Uncased
+ ""))
+ char-set:letter))
(pass-if "char-set:digit"
- (if (not %latin1)
- (throw 'unresolved)
- (char-set<= (string->char-set "0123456789")
- char-set:digit)))
+ (char-set<= (string->char-set "0123456789")
+ 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<= (string->char-set "0123456789abcdefABCDEF")
+ 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<= (char-set-union
+ char-set:letter
+ char-set: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<= (string->char-set
+ (string-append "!\"#%&'()*,-./:;?@[\\]_{}"
+ ""))
+ 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<= (string->char-set
+ (string-append "$+<=>^`|~"
+ ""))
+ 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<= (char-set-union
+ char-set:letter
+ char-set:digit
+ char-set:punctuation
+ char-set:symbol)
+ char-set:graphic))
(pass-if "char-set:whitespace"
- (if (not %latin1)
- (throw 'unresolved)
- (char-set<= (string->char-set
- (string
- (integer->char #x09)
- (integer->char #x0a)
- (integer->char #x0b)
- (integer->char #x0c)
- (integer->char #x0d)
- (integer->char #x20)
- (integer->char #xa0)))
- char-set:whitespace)))
+ (char-set<= (string->char-set
+ (string
+ (integer->char #x09)
+ (integer->char #x0a)
+ (integer->char #x0b)
+ (integer->char #x0c)
+ (integer->char #x0d)
+ (integer->char #x20)
+ (integer->char #xa0)))
+ 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<= (char-set-union char-set:graphic char-set:whitespace)
+ 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
- ;; U+0000 to U+001F
- (iota #x20)
- (list #x7f)
- ;; U+007F to U+009F
- (map (lambda (x) (+ #x80 x))
- (iota #x20))))))
- char-set:iso-control))))
-
+ (char-set<= (string->char-set
+ (apply string
+ (map integer->char (append
+ ;; U+0000 to U+001F
+ (iota #x20)
+ (list #x7f)
+ ;; U+007F to U+009F
+ (map (lambda (x) (+ #x80 x))
+ (iota #x20))))))
+ char-set:iso-control)))
+
+(if (defined? 'setlocale)
+ (setlocale LC_ALL oldlocale))