Simplify GOOPS effective method cache format
[bpt/guile.git] / test-suite / tests / regexp.test
index eba4153..2446dc7 100644 (file)
@@ -2,7 +2,7 @@
 ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
 ;;;;
 ;;;;   Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009, 2010,
-;;;;      2012 Free Software Foundation, Inc.
+;;;;      2012, 2013, 2014 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
@@ -23,8 +23,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 regex))
 
-(if (defined? 'setlocale)
-    (setlocale LC_ALL "C"))
+(when (defined? 'setlocale)
+  (setlocale LC_ALL "C"))
 
 ;; Don't fail if we can't display a test name to stdout/stderr.
 (set-port-conversion-strategy! (current-output-port) 'escape)
 
 (define char-code-limit 256)
 
-;; 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"
 
   (pass-if-exception "no args" exception:wrong-num-args
 
   (let ((lst `((regexp/basic    ,regexp/basic)
               (regexp/extended ,regexp/extended)))
-       ;; string of all characters, except #\nul which doesn't work because
-       ;; it's the usual end-of-string for the underlying C regexec()
-       (allchars (list->string (map integer->char
-                                    (cdr (iota char-code-limit))))))
+       ;; String of all latin-1 characters, except #\nul which doesn't
+       ;; work because it's the usual end-of-string for the underlying
+       ;; C regexec().
+       (allchars (list->string (map integer->char (cdr (iota 256))))))
     (for-each
      (lambda (elem)
        (let ((name (car  elem))
 
         (with-test-prefix name
 
-          ;; try on each individual character, except #\nul
+          ;; Try on each individual latin-1 character, except #\nul.
           (do ((i 1 (1+ i)))
-              ((>= i char-code-limit))
+              ((>= i 256))
              (let* ((c (integer->char i))
                     (s (string c)))
                (pass-if (list "char" i (format #f "~s ~s" c s))
                  (with-ascii-or-latin1-locale i
-                  (let* ((q (with-unicode (regexp-quote s)))
+                  (let* ((q (regexp-quote s))
                          (m (regexp-exec (make-regexp q flag) s)))
                     (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
-          ;; follow a pattern to repeat or whatever ("a" in this case)
+          ;; Try on pattern "aX" where X is each latin-1 character,
+          ;; except #\nul.  This exposes things like "?" which are
+          ;; special only when they follow a pattern to repeat or
+          ;; whatever ("a" in this case).
           (do ((i 1 (1+ i)))
-              ((>= i char-code-limit))
+              ((>= i 256))
              (let* ((c (integer->char i))
                     (s (string #\a c))
-                    (q (with-unicode (regexp-quote s))))
+                    (q (regexp-quote s)))
                (pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q))
                  (with-ascii-or-latin1-locale i
                  (let* ((m (regexp-exec (make-regexp q flag) s)))
 
           (pass-if "string of all chars"
              (with-latin1-locale
-               (let ((m (regexp-exec (make-regexp (with-unicode
-                                                   (regexp-quote allchars))
-                                                  flag) allchars)))
+               (let ((m (regexp-exec (make-regexp (regexp-quote allchars)
+                                                  flag)
+                                     allchars)))
                  (and (= 0 (match:start m))
                       (= (string-length allchars) (match:end m)))))))))
      lst)))