mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

Make sure `regexp-quote' tests use Unicode-capable string ports.

Browse source 
* test-suite/tests/regexp.test (with-unicode): New macro.
  ("regexp-quote"): Wrap all `regexp-quote' calls in it.  This fixes
  tests on machines where the default port encoding is US-ASCII.
This commit is contained in:
Ludovic Courtès 2012-01-09 23:16:20 +01:00
parent 67543d0761
commit 211e71a184
1 changed files with 12 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -145,6 +145,14 @@
(with-latin1-locale body ...) (with-latin1-locale body ...)
(begin body ...))))) (begin body ...)))))
;; Since `regexp-quote' uses string ports, and since it is used below
;; with non-ASCII characters, these ports must be Unicode-capable.
(define-syntax with-unicode
(syntax-rules ()
((_ exp)
(with-fluids ((%default-port-encoding "UTF-8"))
exp))))
(with-test-prefix "regexp-quote" (with-test-prefix "regexp-quote"
(pass-if-exception "no args" exception:wrong-num-args (pass-if-exception "no args" exception:wrong-num-args
@ -173,7 +181,7 @@
(s (string c))) (s (string c)))
(pass-if (list "char" i (format #f "~s ~s" c s)) (pass-if (list "char" i (format #f "~s ~s" c s))
(with-ascii-or-latin1-locale i (with-ascii-or-latin1-locale i
(let* ((q (regexp-quote s)) (let* ((q (with-unicode (regexp-quote s)))
(m (regexp-exec (make-regexp q flag) s))) (m (regexp-exec (make-regexp q flag) s)))
(and (= 0 (match:start m)) (and (= 0 (match:start m))
(= 1 (match:end m)))))))) (= 1 (match:end m))))))))
@ -185,7 +193,7 @@
((>= i char-code-limit)) ((>= i char-code-limit))
(let* ((c (integer->char i)) (let* ((c (integer->char i))
(s (string #\a c)) (s (string #\a c))
(q (regexp-quote s))) (q (with-unicode (regexp-quote s))))
(pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q)) (pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q))
(with-ascii-or-latin1-locale i (with-ascii-or-latin1-locale i
(let* ((m (regexp-exec (make-regexp q flag) s))) (let* ((m (regexp-exec (make-regexp q flag) s)))
@ -194,7 +202,8 @@
(pass-if "string of all chars" (pass-if "string of all chars"
(with-latin1-locale (with-latin1-locale
(let ((m (regexp-exec (make-regexp (regexp-quote allchars) (let ((m (regexp-exec (make-regexp (with-unicode
(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)))))))))