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

@@ -118,22 +118,23 @@
 	     (string=? "\\xfaltima"
 		       (get-output-string pt))))
   (pass-if "Rashomon"
-	   (let ((pt (open-output-string)))
+    (let ((pt (open-output-string)))
-	     (set-port-encoding! pt "ASCII")
+      (set-port-encoding! pt "ASCII")
-	     (set-port-conversion-strategy! pt 'escape)
+      (set-port-conversion-strategy! pt 'escape)
-	     (display s4 pt)
+      (display s4 pt)
-	     (string=? "\\u7F85\\u751F\\u9580"
+      (string=? "\\u7F85\\u751F\\u9580"
-		       (get-output-string pt)))))
+                (get-output-string pt)))))
-
-(setlocale LC_ALL "en_US.utf8")
 
 (with-test-prefix "input escapes"
 
-  (pass-if  "última"
+  (pass-if "última"
-	    (string=? "última"
+    (with-locale "en_US.utf8"
-		      (with-input-from-string "\"\\xfaltima\"" read)))
+                 (string=? "última"
+                           (with-input-from-string "\"\\xfaltima\"" read))))
 
   (pass-if "羅生門"
-	   (string=? "羅生門"
+    (with-locale "en_US.utf8"
-		     (with-input-from-string "\"\\u7F85\\u751F\\u9580\"" read))))
+                 (string=? "羅生門"
+                           (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,142 +337,105 @@
 (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)
+    (char-set<= (string->char-set
-	 (throw 'unresolved)
+                 (string-append "abcdefghijklmnopqrstuvwxyz"
-         (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)
+    (char-set<= (string->char-set
-         (throw 'unresolved)
+                 (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-         (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)
+    (char-set<= (string->char-set "")
-	 (throw 'unresolved)
+                char-set:title-case))
-         (char-set<= (string->char-set "")
-                     char-set:title-case)))
 
   (pass-if "char-set:letter"
-     (if (not %latin1)
+    (char-set<= (string->char-set
-	 (throw 'unresolved)
+                 (string-append 
-         (char-set<= (string->char-set
+                  ;; Lowercase
-                      (string-append 
+                  "abcdefghijklmnopqrstuvwxyz" 
-                       ;; Lowercase
+                  "µßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ"
-                       "abcdefghijklmnopqrstuvwxyz" 
+                  ;; Uppercase
-                       "µßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ"
+                  "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 
-                       ;; Uppercase
+                  "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ"
-                       "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 
+                  ;; Uncased
-                       "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ"
+                  "ªº")) 
-                       ;; Uncased
+                char-set:letter))
-                       "ªº")) 
-                     char-set:letter)))
   
   (pass-if "char-set:digit"
-     (if (not %latin1)
+    (char-set<= (string->char-set "0123456789")
-	 (throw 'unresolved)
+                char-set:digit))
-         (char-set<= (string->char-set "0123456789")
-                     char-set:digit)))
 
   (pass-if "char-set:hex-digit"
-     (if (not %latin1)
+    (char-set<= (string->char-set "0123456789abcdefABCDEF")
-	 (throw 'unresolved)
+                char-set:hex-digit))
-         (char-set<= (string->char-set "0123456789abcdefABCDEF")
-                     char-set:hex-digit)))
 
   (pass-if "char-set:letter+digit"
-     (if (not %latin1)
+    (char-set<= (char-set-union
-	 (throw 'unresolved)
+                 char-set:letter
-         (char-set<= (char-set-union
+                 char-set:digit)
-                      char-set:letter
+                char-set:letter+digit))
-                      char-set:digit)
-                     char-set:letter+digit)))
 
   (pass-if "char-set:punctuation"
-     (if (not %latin1)
+    (char-set<= (string->char-set 
-	 (throw 'unresolved)
+                 (string-append "!\"#%&'()*,-./:;?@[\\]_{}"
-         (char-set<= (string->char-set 
+                                "¡«·»¿"))
-                      (string-append "!\"#%&'()*,-./:;?@[\\]_{}"
+                char-set:punctuation))
-                                     "¡«·»¿"))
-                     char-set:punctuation)))
 
   (pass-if "char-set:symbol"
-     (if (not %latin1)
+    (char-set<= (string->char-set 
-	 (throw 'unresolved)
+                 (string-append "$+<=>^`|~"
-         (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)
+    (char-set<= (char-set-union
-	 (throw 'unresolved)
+                 char-set:letter
-         (char-set<= (char-set-union
+                 char-set:digit
-                      char-set:letter
+                 char-set:punctuation
-                      char-set:digit
+                 char-set:symbol)
-                      char-set:punctuation
+                char-set:graphic))
-                      char-set:symbol)
-                     char-set:graphic)))
 
   (pass-if "char-set:whitespace"
-     (if (not %latin1)
+    (char-set<= (string->char-set 
-	 (throw 'unresolved)
+                 (string
-         (char-set<= (string->char-set 
+                  (integer->char #x09)
-                      (string
+                  (integer->char #x0a)
-                       (integer->char #x09)
+                  (integer->char #x0b)
-                       (integer->char #x0a)
+                  (integer->char #x0c)
-                       (integer->char #x0b)
+                  (integer->char #x0d)
-                       (integer->char #x0c)
+                  (integer->char #x20)
-                       (integer->char #x0d)
+                  (integer->char #xa0)))
-                       (integer->char #x20)
+                char-set:whitespace))
-                       (integer->char #xa0)))
-                     char-set:whitespace)))
                                   
   (pass-if "char-set:printing"
-     (if (not %latin1)
+    (char-set<= (char-set-union char-set:graphic char-set:whitespace)
-	 (throw 'unresolved)
+                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)
+    (char-set<= (string->char-set 
-	 (throw 'unresolved)
+                 (apply string 
-         (char-set<= (string->char-set 
+                        (map integer->char (append 
-                      (apply string 
+                                            ;; U+0000 to U+001F
-                             (map integer->char (append 
+                                            (iota #x20)
-                                                 ;; U+0000 to U+001F
+                                            (list #x7f)
-                                                 (iota #x20)
+                                            ;; U+007F to U+009F
-                                                 (list #x7f)
+                                            (map (lambda (x) (+ #x80 x))
-                                                 ;; U+007F to U+009F
+                                                 (iota #x20))))))
-                                                 (map (lambda (x) (+ #x80 x))
+                char-set:iso-control)))
-                                                      (iota #x20))))))
-                     char-set:iso-control))))
 
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))