summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichael Gran <spk121@yahoo.com>2009-09-10 21:30:11 -0700
committerMichael Gran <spk121@yahoo.com>2009-09-10 21:30:11 -0700
commit7583976b3a408471ce2146bfaa8efab2598f2531 (patch)
treec288cb2d15096828518d57c0f97f6455a25310e3
parent45f15cac1f7f36c24ad0734fe128483080272e5f (diff)
downloadguile-7583976b3a408471ce2146bfaa8efab2598f2531.tar.gz
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.
-rw-r--r--test-suite/tests/regexp.test108
1 files changed, 65 insertions, 43 deletions
diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index 9c48ea57b..d840f04e4 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 <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)))
- (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