Commit | Line | Data |
---|---|---|
3dcdcfe8 JB |
1 | ;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*- |
2 | ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999 | |
3 | ;;;; | |
710491c5 | 4 | ;;;; Copyright (C) 1999, 2004 Free Software Foundation, Inc. |
3dcdcfe8 JB |
5 | ;;;; |
6 | ;;;; This program is free software; you can redistribute it and/or modify | |
7 | ;;;; it under the terms of the GNU General Public License as published by | |
8 | ;;;; the Free Software Foundation; either version 2, or (at your option) | |
9 | ;;;; any later version. | |
10 | ;;;; | |
11 | ;;;; This program 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 | |
14 | ;;;; GNU General Public License for more details. | |
15 | ;;;; | |
16 | ;;;; You should have received a copy of the GNU General Public License | |
17 | ;;;; along with this software; see the file COPYING. If not, write to | |
92205699 MV |
18 | ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
19 | ;;;; Boston, MA 02110-1301 USA | |
3dcdcfe8 JB |
20 | |
21 | (use-modules (test-suite lib) | |
22 | (ice-9 regex)) | |
23 | ||
24 | ;;; Run a regexp-substitute or regexp-substitute/global test, once | |
25 | ;;; providing a real port and once providing #f, requesting direct | |
26 | ;;; string output. | |
27 | (define (vary-port func expected . args) | |
28 | (pass-if "port is string port" | |
29 | (equal? expected | |
30 | (call-with-output-string | |
31 | (lambda (port) | |
32 | (apply func port args))))) | |
33 | (pass-if "port is #f" | |
34 | (equal? expected | |
35 | (apply func #f args)))) | |
36 | ||
37 | (define (object->string obj) | |
38 | (call-with-output-string | |
39 | (lambda (port) | |
40 | (write obj port)))) | |
41 | ||
710491c5 KR |
42 | ;;; |
43 | ;;; make-regexp | |
44 | ;;; | |
45 | ||
46 | (with-test-prefix "make-regexp" | |
47 | ||
48 | (pass-if-exception "no args" exception:wrong-num-args | |
49 | (make-regexp)) | |
50 | ||
51 | (pass-if-exception "bad pat arg" exception:wrong-type-arg | |
52 | (make-regexp 'blah)) | |
53 | ||
54 | ;; in guile prior to 1.6.5 make-regex didn't validate its flags args | |
55 | (pass-if-exception "bad arg 2" exception:wrong-type-arg | |
56 | (make-regexp "xyz" 'abc)) | |
57 | ||
58 | (pass-if-exception "bad arg 3" exception:wrong-type-arg | |
59 | (make-regexp "xyz" regexp/icase 'abc))) | |
60 | ||
38923713 KR |
61 | ;;; |
62 | ;;; match:string | |
63 | ;;; | |
64 | ||
65 | (with-test-prefix "match:string" | |
66 | ||
67 | (pass-if "foo" | |
68 | (string=? "foo" (match:string (string-match ".*" "foo")))) | |
69 | ||
70 | (pass-if "foo offset 1" | |
71 | (string=? "foo" (match:string (string-match ".*" "foo" 1))))) | |
72 | ||
1df6de96 KR |
73 | ;;; |
74 | ;;; regexp-quote | |
75 | ;;; | |
76 | ||
77 | (with-test-prefix "regexp-quote" | |
78 | ||
79 | (pass-if-exception "no args" exception:wrong-num-args | |
80 | (regexp-quote)) | |
81 | ||
82 | (pass-if-exception "bad string arg" exception:wrong-type-arg | |
83 | (regexp-quote 'blah)) | |
84 | ||
85 | (let ((lst `((regexp/basic ,regexp/basic) | |
86 | (regexp/extended ,regexp/extended))) | |
87 | ;; string of all characters, except #\nul which doesn't work because | |
88 | ;; it's the usual end-of-string for the underlying C regexec() | |
89 | (allchars (list->string (map integer->char | |
90 | (cdr (iota char-code-limit)))))) | |
91 | (for-each | |
92 | (lambda (elem) | |
93 | (let ((name (car elem)) | |
94 | (flag (cadr elem))) | |
95 | ||
96 | (with-test-prefix name | |
97 | ||
98 | ;; try on each individual character, except #\nul | |
99 | (do ((i 1 (1+ i))) | |
100 | ((>= i char-code-limit)) | |
101 | (let* ((c (integer->char i)) | |
102 | (s (string c)) | |
103 | (q (regexp-quote s))) | |
104 | (pass-if (list "char" i c s q) | |
105 | (let ((m (regexp-exec (make-regexp q flag) s))) | |
106 | (and (= 0 (match:start m)) | |
107 | (= 1 (match:end m))))))) | |
108 | ||
109 | ;; try on pattern "aX" where X is each character, except #\nul | |
110 | ;; this exposes things like "?" which are special only when they | |
111 | ;; follow a pattern to repeat or whatever ("a" in this case) | |
112 | (do ((i 1 (1+ i))) | |
113 | ((>= i char-code-limit)) | |
114 | (let* ((c (integer->char i)) | |
115 | (s (string #\a c)) | |
116 | (q (regexp-quote s))) | |
117 | (pass-if (list "string \"aX\"" i c s q) | |
118 | (let ((m (regexp-exec (make-regexp q flag) s))) | |
119 | (and (= 0 (match:start m)) | |
120 | (= 2 (match:end m))))))) | |
121 | ||
122 | (pass-if "string of all chars" | |
123 | (let ((m (regexp-exec (make-regexp (regexp-quote allchars) | |
124 | flag) allchars))) | |
125 | (and (= 0 (match:start m)) | |
126 | (= (string-length allchars) (match:end m)))))))) | |
127 | lst))) | |
128 | ||
710491c5 KR |
129 | ;;; |
130 | ;;; regexp-substitute | |
131 | ;;; | |
132 | ||
3dcdcfe8 JB |
133 | (with-test-prefix "regexp-substitute" |
134 | (let ((match | |
135 | (string-match "patleft(sub1)patmid(sub2)patright" | |
136 | "contleftpatleftsub1patmidsub2patrightcontright"))) | |
137 | (define (try expected . args) | |
138 | (with-test-prefix (object->string args) | |
139 | (apply vary-port regexp-substitute expected match args))) | |
140 | ||
141 | (try "") | |
142 | (try "string1" "string1") | |
143 | (try "string1string2" "string1" "string2") | |
144 | (try "patleftsub1patmidsub2patright" 0) | |
145 | (try "hi-patleftsub1patmidsub2patright-bye" "hi-" 0 "-bye") | |
146 | (try "sub1" 1) | |
147 | (try "hi-sub1-bye" "hi-" 1 "-bye") | |
148 | (try "hi-sub2-bye" "hi-" 2 "-bye") | |
149 | (try "contleft" 'pre) | |
150 | (try "contright" 'post) | |
151 | (try "contrightcontleft" 'post 'pre) | |
152 | (try "contrightcontleftcontrightcontleft" 'post 'pre 'post 'pre) | |
153 | (try "contrightsub2sub1contleft" 'post 2 1 'pre) | |
154 | (try "foosub1sub1sub1sub1bar" "foo" 1 1 1 1 "bar"))) | |
155 | ||
156 | (with-test-prefix "regexp-substitute/global" | |
157 | ||
158 | (define (try expected . args) | |
159 | (with-test-prefix (object->string args) | |
160 | (apply vary-port regexp-substitute/global expected args))) | |
161 | ||
3dcdcfe8 JB |
162 | (try "hi" "a(x*)b" "ab" "hi") |
163 | (try "" "a(x*)b" "ab" 1) | |
164 | (try "xx" "a(x*)b" "axxb" 1) | |
165 | (try "xx" "a(x*)b" "_axxb_" 1) | |
166 | (try "pre" "a(x*)b" "preaxxbpost" 'pre) | |
167 | (try "post" "a(x*)b" "preaxxbpost" 'post) | |
f88fdc6e | 168 | (try "string" "x" "string" 'pre "y" 'post) |
3dcdcfe8 JB |
169 | (try "4" "a(x*)b" "_axxb_" (lambda (m) |
170 | (number->string (match:end m 1)))) | |
171 | ||
172 | (try "_aybycyd_" "x+" "_axbxxcxxxd_" 'pre "y" 'post) | |
173 | ||
174 | ;; This should not go into an infinite loop, just because the regexp | |
175 | ;; can match the empty string. This test also kind of beats on our | |
176 | ;; definition of where a null string can match. | |
177 | (try "y_yaybycydy_y" "x*" "_axbxxcxxxd_" 'pre "y" 'post) | |
178 | ||
179 | ;; These kind of bother me. The extension from regexp-substitute to | |
180 | ;; regexp-substitute/global is only natural if your item list | |
181 | ;; includes both pre and post. If those are required, why bother | |
182 | ;; to include them at all? | |
183 | (try "4:7:12:_" "a(x*)b" "_axxbaxbaxxxb_" | |
184 | (lambda (m) (number->string (match:end m 1))) ":" | |
185 | 'post) | |
186 | (try "4:10:19:_:19:10:4" "a(x*)b" "_axxbaxxxxbaxxxxxxxb_" | |
187 | (lambda (m) (number->string (match:end m 1))) ":" | |
188 | 'post | |
189 | ":" (lambda (m) (number->string (match:end m 1)))) | |
190 | ||
191 | ;; Jan Nieuwenhuizen's bug, 2 Sep 1999 | |
192 | (try "" "_" (make-string 500 #\_) | |
193 | 'post)) |