test-suite/tests/regexp.test

   1 ;;;; regexp.test ---  test Guile's regexps   -*- coding: utf-8; mode: scheme -*-
   2 ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
   3 ;;;;
   4 ;;;;    Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5 ;;;;
   6 ;;;; This library is free software; you can redistribute it and/or
   7 ;;;; modify it under the terms of the GNU Lesser General Public
   8 ;;;; License as published by the Free Software Foundation; either
   9 ;;;; version 3 of the License, or (at your option) any later version.
  10 ;;;;
  11 ;;;; This library is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;;; Lesser General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU Lesser General Public
  17 ;;;; License along with this library; if not, write to the Free Software
  18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 (define-module (test-suite test-regexp)
  21   #:use-module (test-suite lib)
  22   #:use-module (srfi srfi-1)
  23   #:use-module (ice-9 regex))
  24
  25 (if (defined? 'setlocale)
  26     (setlocale LC_ALL "C"))
  27
  28 ;; Don't fail if we can't display a test name to stdout/stderr.
  29 (set-port-conversion-strategy! (current-output-port) 'escape)
  30 (set-port-conversion-strategy! (current-error-port) 'escape)
  31
  32 \f
  33 ;;; Run a regexp-substitute or regexp-substitute/global test, once
  34 ;;; providing a real port and once providing #f, requesting direct
  35 ;;; string output.
  36 (define (vary-port func expected . args)
  37   (pass-if "port is string port"
  38            (equal? expected
  39                    (call-with-output-string
  40                     (lambda (port)
  41                       (apply func port args)))))
  42   (pass-if "port is #f"
  43            (equal? expected
  44                    (apply func #f args))))
  45
  46 (define (object->string obj)
  47   (call-with-output-string
  48    (lambda (port)
  49      (write obj port))))
  50
  51 ;;;
  52 ;;; make-regexp
  53 ;;;
  54
  55 (with-test-prefix "make-regexp"
  56
  57   (pass-if-exception "no args" exception:wrong-num-args
  58     (make-regexp))
  59
  60   (pass-if-exception "bad pat arg" exception:wrong-type-arg
  61     (make-regexp 'blah))
  62
  63   ;; in guile prior to 1.6.5 make-regex didn't validate its flags args
  64   (pass-if-exception "bad arg 2" exception:wrong-type-arg
  65     (make-regexp "xyz" 'abc))
  66
  67   (pass-if-exception "bad arg 3" exception:wrong-type-arg
  68     (make-regexp "xyz" regexp/icase 'abc)))
  69
  70 ;;;
  71 ;;; match:string
  72 ;;;
  73
  74 (with-test-prefix "match:string"
  75
  76   (pass-if "foo"
  77     (string=? "foo" (match:string (string-match ".*" "foo"))))
  78
  79   (pass-if "foo offset 1"
  80     (string=? "foo" (match:string (string-match ".*" "foo" 1)))))
  81
  82 ;;;
  83 ;;; regexp-exec
  84 ;;;
  85
  86 (with-test-prefix "regexp-exec"
  87
  88   (pass-if-exception "non-integer offset" exception:wrong-type-arg
  89     (let ((re (make-regexp "ab+")))
  90       (regexp-exec re "aaaabbbb" 1.5 'bogus-flags-arg)))
  91
  92   (pass-if-exception "non-string input" exception:wrong-type-arg
  93     (let ((re (make-regexp "ab+")))
  94       (regexp-exec re 'not-a-string)))
  95
  96   (pass-if-exception "non-string input, with offset" exception:wrong-type-arg
  97     (let ((re (make-regexp "ab+")))
  98       (regexp-exec re 'not-a-string 5)))
  99
 100   ;; in guile 1.8.1 and earlier, a #\nul character in the input string was
 101   ;; only detected in a critical section, and the resulting error throw
 102   ;; abort()ed the program
 103   (pass-if-exception "nul in input" exception:string-contains-nul
 104     (let ((re (make-regexp "ab+")))
 105       (regexp-exec re (string #\a #\b (integer->char 0)))))
 106
 107   ;; in guile 1.8.1 and earlier, a bogus flags argument was only detected
 108   ;; inside a critical section, and the resulting error throw abort()ed the
 109   ;; program
 110   (pass-if-exception "non-integer flags" exception:wrong-type-arg
 111     (let ((re (make-regexp "ab+")))
 112       (regexp-exec re "aaaabbbb" 0 'bogus-flags-arg))))
 113
 114 ;;;
 115 ;;; fold-matches
 116 ;;;
 117
 118 (with-test-prefix "fold-matches"
 119
 120   (pass-if "without flags"
 121     (equal? '("hello")
 122             (fold-matches "^[a-z]+$" "hello" '()
 123                           (lambda (match result)
 124                             (cons (match:substring match)
 125                                   result)))))
 126
 127   (pass-if "with flags"
 128     ;; Prior to 1.8.6, passing an additional flag would not work.
 129     (null?
 130      (fold-matches "^[a-z]+$" "hello" '()
 131                    (lambda (match result)
 132                      (cons (match:substring match)
 133                            result))
 134                    (logior regexp/notbol regexp/noteol)))))
 135
 136
 137 ;;;
 138 ;;; regexp-quote
 139 ;;;
 140
 141 (define-syntax with-ascii-or-latin1-locale
 142   (syntax-rules ()
 143     ((_ chr body ...)
 144      (if (> chr 127)
 145          (with-latin1-locale body ...)
 146          (begin body ...)))))
 147
 148 ;; Since `regexp-quote' uses string ports, and since it is used below
 149 ;; with non-ASCII characters, these ports must be Unicode-capable.
 150 (define-syntax with-unicode
 151   (syntax-rules ()
 152     ((_ exp)
 153      (with-fluids ((%default-port-encoding "UTF-8"))
 154        exp))))
 155
 156 (with-test-prefix "regexp-quote"
 157
 158   (pass-if-exception "no args" exception:wrong-num-args
 159     (regexp-quote))
 160
 161   (pass-if-exception "bad string arg" exception:wrong-type-arg
 162     (regexp-quote 'blah))
 163
 164   (let ((lst `((regexp/basic    ,regexp/basic)
 165                (regexp/extended ,regexp/extended)))
 166         ;; string of all characters, except #\nul which doesn't work because
 167         ;; it's the usual end-of-string for the underlying C regexec()
 168         (allchars (list->string (map integer->char
 169                                      (cdr (iota char-code-limit))))))
 170     (for-each
 171      (lambda (elem)
 172        (let ((name (car  elem))
 173              (flag (cadr elem)))
 174
 175          (with-test-prefix name
 176
 177            ;; try on each individual character, except #\nul
 178            (do ((i 1 (1+ i)))
 179                ((>= i char-code-limit))
 180              (let* ((c (integer->char i))
 181                     (s (string c)))
 182                (pass-if (list "char" i (format #f "~s ~s" c s))
 183                  (with-ascii-or-latin1-locale i
 184                   (let* ((q (with-unicode (regexp-quote s)))
 185                          (m (regexp-exec (make-regexp q flag) s)))
 186                     (and (= 0 (match:start m))
 187                          (= 1 (match:end m))))))))
 188
 189            ;; try on pattern "aX" where X is each character, except #\nul
 190            ;; this exposes things like "?" which are special only when they
 191            ;; follow a pattern to repeat or whatever ("a" in this case)
 192            (do ((i 1 (1+ i)))
 193                ((>= i char-code-limit))
 194              (let* ((c (integer->char i))
 195                     (s (string #\a c))
 196                     (q (with-unicode (regexp-quote s))))
 197                (pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q))
 198                  (with-ascii-or-latin1-locale i
 199                   (let* ((m (regexp-exec (make-regexp q flag) s)))
 200                     (and (= 0 (match:start m))
 201                          (= 2 (match:end m))))))))
 202
 203            (pass-if "string of all chars"
 204              (with-latin1-locale
 205                (let ((m (regexp-exec (make-regexp (with-unicode
 206                                                    (regexp-quote allchars))
 207                                                   flag) allchars)))
 208                  (and (= 0 (match:start m))
 209                       (= (string-length allchars) (match:end m)))))))))
 210      lst)))
 211
 212 ;;;
 213 ;;; regexp-substitute
 214 ;;;
 215
 216 (with-test-prefix "regexp-substitute"
 217   (let ((match
 218          (string-match "patleft(sub1)patmid(sub2)patright"
 219                        "contleftpatleftsub1patmidsub2patrightcontright")))
 220     (define (try expected . args)
 221       (with-test-prefix (object->string args)
 222         (apply vary-port regexp-substitute expected match args)))
 223
 224     (try "")
 225     (try "string1" "string1")
 226     (try "string1string2" "string1" "string2")
 227     (try "patleftsub1patmidsub2patright" 0)
 228     (try "hi-patleftsub1patmidsub2patright-bye" "hi-" 0 "-bye")
 229     (try "sub1" 1)
 230     (try "hi-sub1-bye" "hi-" 1 "-bye")
 231     (try "hi-sub2-bye" "hi-" 2 "-bye")
 232     (try "contleft" 'pre)
 233     (try "contright" 'post)
 234     (try "contrightcontleft" 'post 'pre)
 235     (try "contrightcontleftcontrightcontleft" 'post 'pre 'post 'pre)
 236     (try "contrightsub2sub1contleft" 'post 2 1 'pre)
 237     (try "foosub1sub1sub1sub1bar" "foo" 1 1 1 1 "bar")))
 238
 239 (with-test-prefix "regexp-substitute/global"
 240
 241   (define (try expected . args)
 242     (with-test-prefix (object->string args)
 243       (apply vary-port regexp-substitute/global expected args)))
 244
 245   (try "hi" "a(x*)b" "ab" "hi")
 246   (try ""   "a(x*)b" "ab" 1)
 247   (try "xx" "a(x*)b" "axxb" 1)
 248   (try "xx" "a(x*)b" "_axxb_" 1)
 249   (try "pre" "a(x*)b" "preaxxbpost" 'pre)
 250   (try "post" "a(x*)b" "preaxxbpost" 'post)
 251   (try "string" "x" "string" 'pre "y" 'post)
 252   (try "4" "a(x*)b" "_axxb_" (lambda (m)
 253                                 (number->string (match:end m 1))))
 254
 255   (try "_aybycyd_" "x+" "_axbxxcxxxd_" 'pre "y" 'post)
 256
 257   ;; This should not go into an infinite loop, just because the regexp
 258   ;; can match the empty string.  This test also kind of beats on our
 259   ;; definition of where a null string can match.
 260   (try "y_yaybycydy_y" "x*" "_axbxxcxxxd_" 'pre "y" 'post)
 261
 262   ;; These kind of bother me.  The extension from regexp-substitute to
 263   ;; regexp-substitute/global is only natural if your item list
 264   ;; includes both pre and post.  If those are required, why bother
 265   ;; to include them at all?
 266   (try "4:7:12:_" "a(x*)b" "_axxbaxbaxxxb_"
 267        (lambda (m) (number->string (match:end m 1))) ":"
 268        'post)
 269   (try "4:10:19:_:19:10:4" "a(x*)b" "_axxbaxxxxbaxxxxxxxb_"
 270        (lambda (m) (number->string (match:end m 1))) ":"
 271        'post
 272        ":" (lambda (m) (number->string (match:end m 1))))
 273
 274   ;; Jan Nieuwenhuizen's bug, 2 Sep 1999
 275   (try "" "_" (make-string 500 #\_)
 276        'post))
 277
 278 (with-test-prefix "nonascii locales"
 279   (pass-if "match structures refer to char offsets"
 280     (with-locale "en_US.utf8"
 281       ;; bug #31650
 282       (equal? (match:substring (string-match ".*" "calçot") 0)
 283               "calçot"))))