More setlocale robustness in regexp tests

* test-suite/tests/regexp.test (mysetlocale, set-latin-1): new functions
  (with-latin1-locale): removed
  (regexp-quote tests): try to print test names in locale but run tests
  in ISO-8859-1.

test-suite/tests/regexp.test

@@ -1,7 +1,7 @@
 ;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*-
 ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
 ;;;;
-;;;; 	Copyright (C) 1999, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -19,9 +19,52 @@
 
 (define-module (test-suite test-regexp)
   #:use-module (test-suite lib)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 regex))
 
-(setlocale LC_ALL "C")
+;; Set the locale to LOC, if possible.  Failing that, set the locale
+;; to C.  If that fails, force the port encoding to ASCII.
+(define (mysetlocale loc)
+  (or
+   (and (defined? 'setlocale) 
+        (false-if-exception (setlocale LC_ALL loc)))
+   (and (defined? 'setlocale)
+        (false-if-exception (setlocale LC_ALL "C")))      
+   (begin
+     (false-if-exception (set-port-encoding! (current-input-port) 
+                                             "ASCII"))
+     (false-if-exception (set-port-encoding! (current-output-port) 
+                                             "ASCII"))
+     #f)))
+
+;; Set the locale to a Latin-1 friendly locale.  Failing that, force
+;; the port encoding to Latin-1.  Returns the encoding used.
+(define (set-latin-1)
+  (set-port-conversion-strategy! (current-output-port) 'escape)
+  (or
+   (any 
+    (lambda (loc)
+      (if (defined? 'setlocale)
+          (let ((ret (false-if-exception (setlocale LC_ALL loc))))
+            (if ret
+                loc
+                #f))
+          #f))
+    (append
+     (map (lambda (name)
+            (string-append name ".ISO-8859-1"))
+          '("fr_FR" "es_MX" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT"))
+     (map (lambda (name)
+            (string-append name ".iso88591"))
+          '("fr_FR" "es_MX" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT"))))
+   (begin
+     (false-if-exception (set-port-encoding! (current-input-port) 
+                                             "ISO-8859-1"))
+     (false-if-exception (set-port-encoding! (current-output-port) 
+                                             "ISO-8859-1"))
+     #f)))
+
+(mysetlocale "C")
 
 
 ;;; Run a regexp-substitute or regexp-substitute/global test, once
@@ -132,30 +175,6 @@
 ;;; regexp-quote
 ;;;
 
-(define (with-latin1-locale thunk)
-  ;; Try out several ISO-8859-1 locales and run THUNK under the one that
-  ;; works (if any).
-  (define %locales
-    (append
-     (map (lambda (name)
-            (string-append name ".ISO-8859-1"))
-          '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT"))
-     (map (lambda (name)
-            (string-append name ".iso88591"))
-          '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT"))))
-
-
-  (let loop ((locales %locales))
-    (if (null? locales)
-        (throw 'unresolved)
-        (catch 'unresolved
-          (lambda ()
-            (with-locale (car locales) thunk))
-          (lambda (key . args)
-            (loop (cdr locales)))))))
-
-
-
 (with-test-prefix "regexp-quote"
 
   (pass-if-exception "no args" exception:wrong-num-args
@@ -181,13 +200,15 @@
 	   (do ((i 1 (1+ i)))
 	       ((>= i char-code-limit))
              (let* ((c (integer->char i))
-                    (s (string c)))
+                    (s (string c))
-               (pass-if (list "char" i (format #f "~s ~s" c s))
+                    (q (regexp-quote s)))
-                 (with-latin1-locale
+               (pass-if (list "char" i (format #f "~s ~s ~s" c s q))
-                  (let* ((q (regexp-quote s))
+                 (set-latin-1)      ; set locale for regexp processing
-                         (m (regexp-exec (make-regexp q flag) s)))
+                                    ; on binary data
-                    (and (= 0 (match:start m))
+                 (let ((m (regexp-exec (make-regexp q flag) s)))
-                         (= 1 (match:end m))))))))
+                   (mysetlocale "")     ; restore locale
+                   (and (= 0 (match:start m))
+                        (= 1 (match:end m)))))))
 
 	   ;; try on pattern "aX" where X is each character, except #\nul
 	   ;; this exposes things like "?" which are special only when they
@@ -197,24 +218,25 @@
              (let* ((c (integer->char i))
                     (s (string #\a c))
                     (q (regexp-quote s)))
-               (pass-if (list "string \"aX\"" i (format #f "~s ~s" c s))
+               (pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q))
-                 (with-latin1-locale
+                  (set-latin-1)
-		  (let* ((q (regexp-quote s))
+		  (let* ((m (regexp-exec (make-regexp q flag) s)))
-                         (m (regexp-exec (make-regexp q flag) s)))
+                    (mysetlocale "")
                     (and (= 0 (match:start m))
-                         (= 2 (match:end m))))))))
+                         (= 2 (match:end m)))))))
 
 	   (pass-if "string of all chars"
-             (with-latin1-locale
+             (setbinary)
-              (let ((m (regexp-exec (make-regexp (regexp-quote allchars)
+             (let ((m (regexp-exec (make-regexp (regexp-quote allchars)
-                                                 flag) allchars)))
+                                                flag) allchars)))
-                (and (= 0 (match:start m))
+               (and (= 0 (match:start m))
-                     (= (string-length allchars) (match:end m)))))))))
+                    (= (string-length allchars) (match:end m))))))))
      lst)))
 
 ;;;
 ;;; regexp-substitute
 ;;;
+(mysetlocale "C")
 
 (with-test-prefix "regexp-substitute"
   (let ((match