mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

More setlocale robustness in regexp tests

Browse source 
* 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.
This commit is contained in:
Michael Gran 2009-09-10 21:30:11 -07:00
parent 45f15cac1f
commit 7583976b3a
1 changed files with 65 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

108
test-suite/tests/regexp.test
View file

@ -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