Fix inlining of tail list to apply.

[bpt/guile.git] / test-suite / tests / regexp.test

diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index a6844ca..b5c59f0 100644 (file)
--- a/test-suite/tests/regexp.test
+++ b/test-suite/tests/regexp.test
@@ -1,8 +1,9 @@
-;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*-
+;;;; regexp.test ---  test Guile's regexps   -*- coding: utf-8; mode: scheme -*-
 ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
 ;;;;
-;;;;   Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-;;;; 
+;;;;   Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009, 2010,
+;;;;      2012, 2013 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
 ;;;; License as published by the Free Software Foundation; either
@@ -131,13 +132,35 @@
                    (lambda (match result)
                      (cons (match:substring match)
                            result))
-                   (logior regexp/notbol regexp/noteol)))))
+                   (logior regexp/notbol regexp/noteol))))
+
+  (pass-if "regexp/notbol is set correctly"
+    (equal? '("foo")
+            (fold-matches "^foo" "foofoofoofoo" '()
+                          (lambda (match result)
+                            (cons (match:substring match)
+                                  result))))))
 
 
 ;;;
 ;;; regexp-quote
 ;;;
 
+(define-syntax with-ascii-or-latin1-locale
+  (syntax-rules ()
+    ((_ chr body ...)
+     (if (> chr 127)
+         (with-latin1-locale 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"
 
   (pass-if-exception "no args" exception:wrong-num-args
@@ -148,10 +171,10 @@
 
   (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))
@@ -159,35 +182,37 @@
 
         (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-latin1-locale
-                  (let* ((q (regexp-quote s))
+                 (with-ascii-or-latin1-locale i
+                  (let* ((q (with-unicode (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 (regexp-quote s)))
+                    (q (with-unicode (regexp-quote s))))
                (pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q))
-                 (with-latin1-locale
+                 (with-ascii-or-latin1-locale i
                  (let* ((m (regexp-exec (make-regexp q flag) s)))
                     (and (= 0 (match:start m))
                          (= 2 (match:end m))))))))
 
           (pass-if "string of all chars"
              (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)))
                  (and (= 0 (match:start m))
                       (= (string-length allchars) (match:end m)))))))))
@@ -258,3 +283,18 @@
   ;; Jan Nieuwenhuizen's bug, 2 Sep 1999
   (try "" "_" (make-string 500 #\_)
        'post))
+
+(with-test-prefix "nonascii locales"
+  (pass-if "match structures refer to char offsets"
+    (with-locale "en_US.utf8"
+      ;; bug #31650
+      (equal? (match:substring (string-match ".*" "calçot") 0)
+              "calçot")))
+
+  (pass-if "match structures refer to char offsets, non-ASCII pattern"
+    (with-locale "en_US.utf8"
+      ;; bug #31650
+      (equal? (match:substring (string-match "λ: The Ultimate (.*)"
+                                             "λ: The Ultimate GOTO")
+                               1)
+              "GOTO"))))