1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
|
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: REGEX-TEST; Base: 10 -*-
(in-package :REGEX-TEST)
;;;
;;; testing...
;;;
(defun test (patstr candstr shouldmatchp &optional (verbosep nil))
(when verbosep
(format t "~%Testing pattern ~S against string ~S" patstr candstr)
(format t "~%Compiling..."))
(let ((matcher (compile-str patstr)))
(unless matcher
(format t "~%Error compiling pattern")
(return-from test nil))
(multiple-value-bind (matchedp start len regs)
(match-str matcher candstr)
(format t "~%matched=~A start=~A len=~A regs=~A" matchedp start len regs)
(when verbosep
(cond ((and shouldmatchp (not matchedp))
(format t "~%***** Error: Should have matched, but didn't *****"))
((and (not shouldmatchp) matchedp)
(format t "~%***** Error: Shouldn't have matched, but did *****"))
(matchedp
(format t "~%Success: Matched"))
(t (format t "~%Success: Didn't match"))))
(when matchedp
(dotimes (i (array-dimension regs 0))
(let ((start (register-start regs i))
(end (register-end regs i)))
(format t "~%REG ~D start=~D end=~D" i start end)
(when (register-matched-p regs i)
(format t " substr = \"")
(loop for j from start below end
do (princ (char candstr j)))
(format t "\""))))))))
(defun coveragetest ()
(test "AB" "AB" t t)
(test "A*" "" t t)
(test "A*" "A" t t)
(test "A*" "AA" t t)
(test "A+" "" nil t)
(test "A+" "A" t t)
(test "A+" "AA" t t)
;; test '.' and '?'
(test ".BC" "ABC" t t)
(test ".BC" "BC" nil t)
(test "A?BC" "ABC" t t)
(test "A?BC" "BC" t t)
;; test alternation
(test "A|B" "A" t t)
(test "(A)|(B)" "B" t t)
;; more complicated test
(test "((A*B)|(AC))D" "BD" t t)
(test "((A*B)|(AC))D" "ABD" t t)
(test "((A*B)|(AC))D" "AABD" t t)
(test "((A*B)|(AC))D" "AAABD" t t)
(test "((A*B)|(AC))D" "AAABC" nil t)
(test "((A*B)|(AC))D" "ACD" t t)
(test "(ABC)*DEF" "ABCABCABCDEF" t t)
;; test character patterns and anchors
(test "[a-z][0-9][z-a][9-0]" "a0a0" t t)
(test "[a-z][0-9][z-a][9-0]" "A0A0" nil t)
(test "[^a-z][0-9]" "A0" t t)
(test "[^a-z][0-9]" "a0" nil t)
(test "^[abcdefg]*$" "abcdefg" t t)
(test "^[abcdefg]*$" "abcdefgh" nil t)
(test "^[abcdefg]*$" "ABCDEFG" nil t)
;; test special character patterns
(test "[:lower:][:digit:][:upper:][:xdigit:]" "a0A0" t t)
(test "[:lower:][:digit:][:upper:][:xdigit:]" "a0Aa" t t)
(test "[:lower:][:digit:][:upper:][:xdigit:]" "a0AA" t t)
(test "[:lower:][:digit:][:upper:][:xdigit:]" "a0Af" t t)
(test "[:lower:][:digit:][:upper:][:xdigit:]" "a0AF" t t)
;; test compiler errors
(format t "~%~%All of the following should generate compiler errors!")
(test "(abc" "(abc" nil t)
(test "(abc" "abc" nil t)
(test "abc)def" "abc)def" nil t)
(test "abc)def" "abc" nil t)
(test "[abc" "[abc" nil t)
(test "[abc" "abc" nil t)
;; Unlike the C++ parser, this one treats unattached ] as a normal character
;; (test "abc]def" "abc]def" nil t)
;; (test "abc]def" "abc" nil t)
(test "[:digit]*" "012345" nil t)
)
(defun respeedtest-closure (numreps patstr candstr)
(let* ((matcher (compile-str patstr))
(regs (make-regs (matcher-numregs matcher)))
(matchedp nil))
(when (null matcher)
(format t "Error compiling pattern ~A" patstr)
(return-from respeedtest-closure nil))
(format t "~%~%Timing ~S (closure)" patstr)
(let ((starttime (get-internal-run-time)))
(dotimes (rep numreps)
(setq matchedp (match-str matcher candstr :regs regs)))
(let* ((endtime (get-internal-run-time))
(elapsed (- endtime starttime)))
(format t "~%~T: ~D secs, ~D/sec, ~S --> ~S~%"
(round (/ elapsed internal-time-units-per-second))
(round (/ numreps (/ elapsed internal-time-units-per-second)))
patstr
candstr)))
(when (not matchedp)
(format t "~%Didn't match"))))
(defun respeedtest-comp (numreps patstr matcher candstr)
(let* ((regs (make-regs (matcher-numregs matcher)))
(matchedp nil))
(when (null matcher)
(format t "Error compiling pattern ~A" patstr)
(return-from respeedtest-comp nil))
(format t "~%~%Timing ~S (compiled)" patstr)
(let ((starttime (get-internal-run-time)))
(dotimes (rep numreps)
(setq matchedp (match-str matcher candstr :regs regs)))
(let* ((endtime (get-internal-run-time))
(elapsed (- endtime starttime)))
(format t "~%~T: ~D secs, ~D/sec, ~S --> ~S~%"
(round (/ elapsed internal-time-units-per-second))
(round (/ numreps (/ elapsed internal-time-units-per-second)))
patstr
candstr)))
(when (not matchedp)
(format t "~%Didn't match"))))
(defun strcmpspeedtest (numreps patstr candstr compname compfxn)
(format t "~%~%Timing ~S ~S" compname patstr)
(let ((matchedp nil)
(starttime (get-internal-run-time)))
(dotimes (rep numreps)
(setq matchedp (funcall compfxn patstr candstr)))
(let* ((endtime (get-internal-run-time))
(elapsed (- endtime starttime)))
(format t "~%~T: ~D secs, ~D/sec, ~S --> ~S~%"
(round (/ elapsed internal-time-units-per-second))
(round (/ numreps (/ elapsed internal-time-units-per-second)))
patstr candstr))
(when (not matchedp)
(format t "~%Didn't match"))))
;;;
;;; Speeds are under Win NT, P3-600mhz. GNU speeds are w/ MSVC6.0.
;;;
(defregex test1 "A*BD")
(defregex test2 "(?A|A)*BD")
(defregex test3 "(A|A)*BD")
(defregex test4 "(A|B)*BD")
(defregex test5 "(B|A)*BD")
(defregex test6 "((A*B)|(AC))D")
(defregex test7 "((A*B)|(A*C))D")
(defregex test8 "[Aa]*[Bb][Dd]")
(defun speedtest ()
(let ((numreps #-:Genera 1000000
#+:Genera 250000)
(candstr "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABD"))
(regex::clear-pattern-cache)
;; CLAWK: 9 secs; MSVC/GNU: 53 secs
(respeedtest-closure numreps "A*BD" candstr)
;; CLAWK: 10 secs; MSVC/GNU: No known equivalent
(respeedtest-closure numreps "(?A|A)*BD" candstr)
;; CLAWK: 10 secs; MSVC/GNU: 171 secs
(respeedtest-closure numreps "(A|A)*BD" candstr)
;; CLAWK: 34 secs; MSVC/GNU: 176 secs
(respeedtest-closure numreps "(A|B)*BD" candstr)
;; CLAWK: 55 secs; MSVC/GNU: 178 secs
(respeedtest-closure numreps "(B|A)*BD" candstr)
;; CLAWK: 10 secs; MSVC/GNU: 71 secs
(respeedtest-closure numreps "((A*B)|(AC))D" candstr)
;; CLAWK: 11 secs; MSVC/GNU: 72 secs
(respeedtest-closure numreps "((A*B)|(A*C))D" candstr)
;; CLAWK: 9 secs; MSVC/GNU: 63 secs
(respeedtest-closure numreps "[Aa]*[Bb][Dd]" candstr)
;; LWW: 27 secs; MSVC/MSVC: 1 secs
(strcmpspeedtest numreps candstr candstr "string=" #'string=)
;; LWW: 65 secs; MSVC/MSVC: 2 secs
(strcmpspeedtest numreps candstr candstr "string-equal" #'string-equal)
))
(defun run-tests ()
(format t "~%Starting coverage test~%")
(coveragetest)
(format t "~%Starting Sebastien's coverage test~%")
(run-sebastien-tests)
(format t "~%Starting speed test~%")
(speedtest)
(format t "~%Done~%")
)
|
