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.

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

test-suite/tests/encoding-escapes.test

@@ -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)))))
 

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 "cédula")
@@ -132,4 +135,5 @@
 		       (display (string-ints 256) pt))))
 
 ;; Reset locales
-(setlocale LC_ALL "C")
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))

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")
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))

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))

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,50 +337,29 @@
 (define (every? pred lst)
   (not (not (every pred lst))))
 
-(define (find-latin1-locale)
+(define oldlocale #f)
-  ;; Try to find and install an ISO-8859-1 locale.  Return `#f' on failure.
+(if (defined? 'setlocale)
-  (if (defined? 'setlocale)
+    (set! oldlocale (setlocale LC_ALL "")))
-      (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))
 
 (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))