diff options
author | Michael Gran <spk121@yahoo.com> | 2009-09-10 21:30:11 -0700 |
---|---|---|
committer | Michael Gran <spk121@yahoo.com> | 2009-09-10 21:30:11 -0700 |
commit | 7583976b3a408471ce2146bfaa8efab2598f2531 (patch) | |
tree | c288cb2d15096828518d57c0f97f6455a25310e3 | |
parent | 45f15cac1f7f36c24ad0734fe128483080272e5f (diff) | |
download | guile-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.test | 108 |
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 |