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