OSCL/cl-ppcre
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Don't stop testing on the first test where PERL-ERROR is T.

Browse Source
This commit is contained in:
Nathan Trapuzzano
2013-12-30 17:47:52 -05:00
parent 0bb107db3a
commit 53b6516725
1 changed files with 35 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

70
test/perl-tests.lisp
View File

@ -104,20 +104,20 @@ test files."
(unless (find counter *tests-to-skip* :test #'=) (unless (find counter *tests-to-skip* :test #'=)
(when verbose (when verbose
(format t "~&~4D: ~S" counter info-string)) (format t "~&~4D: ~S" counter info-string))
(let ((scanner (block inner-test-block
(handler-bind ((error (lambda (condition) (let ((scanner
(declare (ignore condition)) (handler-bind ((error (lambda (condition)
(when perl-error (declare (ignore condition))
;; we expected an (when perl-error
;; error, so we can ;; we expected an
;; signal success ;; error, so we can
(return-from test-block))))) ;; signal success
(create-scanner regex (return-from inner-test-block)))))
:case-insensitive-mode case-insensitive-mode (create-scanner regex
:multi-line-mode multi-line-mode :case-insensitive-mode case-insensitive-mode
:single-line-mode single-line-mode :multi-line-mode multi-line-mode
:extended-mode extended-mode)))) :single-line-mode single-line-mode
(block test-block :extended-mode extended-mode))))
(multiple-value-bind (start end reg-starts reg-ends) (multiple-value-bind (start end reg-starts reg-ends)
(scan scanner target) (scan scanner target)
(cond (perl-error (cond (perl-error
@ -126,25 +126,25 @@ test files."
(t (t
(when (not (eq start expected-result)) (when (not (eq start expected-result))
(if start (if start
(let ((result (subseq target start end))) (let ((result (subseq target start end)))
(unless (string= result expected-result) (unless (string= result expected-result)
(push (format nil "expected ~S but got ~S." (push (format nil "expected ~S but got ~S."
expected-result result) expected-result result)
errors)) errors))
(setq reg-starts (coerce reg-starts 'list) (setq reg-starts (coerce reg-starts 'list)
reg-ends (coerce reg-ends 'list)) reg-ends (coerce reg-ends 'list))
(loop for i from 0 (loop for i from 0
for expected-register in expected-registers for expected-register in expected-registers
for reg-start = (nth i reg-starts) for reg-start = (nth i reg-starts)
for reg-end = (nth i reg-ends) for reg-end = (nth i reg-ends)
for register = (if (and reg-start reg-end) for register = (if (and reg-start reg-end)
(subseq target reg-start reg-end) (subseq target reg-start reg-end)
nil) nil)
unless (string= expected-register register) unless (string= expected-register register)
do (push (format nil "\\~A: expected ~S but got ~S." do (push (format nil "\\~A: expected ~S but got ~S."
(1+ i) expected-register register) (1+ i) expected-register register)
errors))) errors)))
(push (format nil "expected ~S but got ~S." (push (format nil "expected ~S but got ~S."
expected-result start) expected-result start)
errors)))))) errors))))))
errors)))))))))) errors))))))))))