[Guile-commits] GNU Guile branch, master, updated. release_1-9-2-338-g7583976

[Michael Gran]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=7583976b3a408471ce2146bfaa8efab2598f2531

The branch, master has been updated
       via  7583976b3a408471ce2146bfaa8efab2598f2531 (commit)
      from  45f15cac1f7f36c24ad0734fe128483080272e5f (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 7583976b3a408471ce2146bfaa8efab2598f2531
Author: Michael Gran <address@hidden>
Date:   Thu Sep 10 21:30:11 2009 -0700

    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.

-----------------------------------------------------------------------

Summary of changes:
 test-suite/tests/regexp.test |  108 +++++++++++++++++++++++++-----------------
 1 files changed, 65 insertions(+), 43 deletions(-)

diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index 9c48ea5..d840f04 100644
--- a/test-suite/tests/regexp.test
+++ b/test-suite/tests/regexp.test
@@ -1,7 +1,7 @@
 ;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*-
 ;;;; Jim Blandy <address@hidden> --- 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)))
-               (pass-if (list "char" i (format #f "~s ~s" c s))
-                 (with-latin1-locale
-                  (let* ((q (regexp-quote s))
-                         (m (regexp-exec (make-regexp q flag) s)))
-                    (and (= 0 (match:start m))
-                         (= 1 (match:end m))))))))
+                    (s (string c))
+                    (q (regexp-quote s)))
+               (pass-if (list "char" i (format #f "~s ~s ~s" c s q))
+                 (set-latin-1)      ; set locale for regexp processing
+                                    ; on binary data
+                 (let ((m (regexp-exec (make-regexp q flag) s)))
+                   (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))
-                 (with-latin1-locale
-                 (let* ((q (regexp-quote s))
-                         (m (regexp-exec (make-regexp q flag) s)))
+               (pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q))
+                  (set-latin-1)
+                 (let* ((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
-              (let ((m (regexp-exec (make-regexp (regexp-quote allchars)
-                                                 flag) allchars)))
-                (and (= 0 (match:start m))
-                     (= (string-length allchars) (match:end m)))))))))
+             (setbinary)
+             (let ((m (regexp-exec (make-regexp (regexp-quote allchars)
+                                                flag) allchars)))
+               (and (= 0 (match:start m))
+                    (= (string-length allchars) (match:end m))))))))
      lst)))
 
 ;;;
 ;;; regexp-substitute
 ;;;
+(mysetlocale "C")
 
 (with-test-prefix "regexp-substitute"
   (let ((match


hooks/post-receive
-- 
GNU Guile