25c3dedeeb
git-svn-id: svn://bknr.net/svn/trunk/thirdparty/cl-ppcre@3581 4281704c-cde7-0310-8518-8e2dc76b1ff0
160 lines
7.5 KiB
Common Lisp
160 lines
7.5 KiB
Common Lisp
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE-TEST; Base: 10 -*-
|
|
;;; $Header: /usr/local/cvsrep/cl-ppcre/test/tests.lisp,v 1.12 2008/07/23 00:48:00 edi Exp $
|
|
|
|
;;; The tests in this file test CL-PPCRE against testdata generated by
|
|
;;; the Perl program `perltest.pl' from the input file `testinput' in
|
|
;;; order to check compatibility with Perl and correctness of the
|
|
;;; regex engine.
|
|
|
|
;;; Copyright (c) 2002-2008, Dr. Edmund Weitz. All rights reserved.
|
|
|
|
;;; Redistribution and use in source and binary forms, with or without
|
|
;;; modification, are permitted provided that the following conditions
|
|
;;; are met:
|
|
|
|
;;; * Redistributions of source code must retain the above copyright
|
|
;;; notice, this list of conditions and the following disclaimer.
|
|
|
|
;;; * Redistributions in binary form must reproduce the above
|
|
;;; copyright notice, this list of conditions and the following
|
|
;;; disclaimer in the documentation and/or other materials
|
|
;;; provided with the distribution.
|
|
|
|
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
|
|
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
|
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
|
|
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
|
|
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
|
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
|
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
|
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
|
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
(in-package :cl-ppcre-test)
|
|
|
|
(defvar *this-file* (load-time-value
|
|
(or #.*compile-file-pathname* *load-pathname*))
|
|
"The location of this source file.")
|
|
|
|
(defmacro do-tests ((name &optional show-progress-p) &body body)
|
|
"Helper macro which repeatedly executes BODY until the code in body
|
|
calls the function DONE. It is assumed that each invocation of BODY
|
|
will be the execution of one test which returns NIL in case of success
|
|
and list of string describing errors otherwise.
|
|
|
|
The macro prints a simple progress indicator \(one dots for ten tests)
|
|
to *STANDARD-OUTPUT* unless SHOW-PROGRESS-P is NIL and returns a true
|
|
value iff all tests succeeded. Errors in BODY are caught and reported
|
|
\(and counted as failures)."
|
|
`(let ((successp t)
|
|
(testcount 1))
|
|
(block test-block
|
|
(flet ((done ()
|
|
(return-from test-block successp)))
|
|
(format t "~&Test: ~A~%" ,name)
|
|
(loop
|
|
(when (and ,show-progress-p (zerop (mod testcount 10)))
|
|
(format t ".")
|
|
(when (zerop (mod testcount 100))
|
|
(terpri))
|
|
(force-output))
|
|
(let ((errors
|
|
(handler-case
|
|
(progn ,@body)
|
|
(error (msg)
|
|
(list (format nil "~&got an unexpected error: ~A" msg))))))
|
|
(setq successp (and successp (null errors)))
|
|
(when errors
|
|
(format t "~&~4@A:~{~& ~A~}~%" testcount errors))
|
|
(incf testcount)))))
|
|
successp))
|
|
|
|
(defun simple-tests (&key (file-name
|
|
(make-pathname :name "simple"
|
|
:type nil :version nil
|
|
:defaults *this-file*))
|
|
(external-format '(:latin-1 :eol-style :lf))
|
|
verbose)
|
|
"Loops through all the forms in the file FILE-NAME and executes each
|
|
of them using EVAL. It is assumed that each FORM specifies a test
|
|
which returns a true value iff it succeeds. Prints each test form to
|
|
*STANDARD-OUTPUT* if VERBOSE is true and shows a simple progress
|
|
indicator otherwise. EXTERNAL-FORMAT is the FLEXI-STREAMS external
|
|
format which is used to read the file. Returns a true value iff all
|
|
tests succeeded."
|
|
(with-open-file (binary-stream file-name :element-type 'flex:octet)
|
|
(let ((stream (flex:make-flexi-stream binary-stream :external-format external-format))
|
|
(*package* (find-package :cl-ppcre-test)))
|
|
(do-tests ((format nil "Simple tests from file ~S" (file-namestring file-name))
|
|
(not verbose))
|
|
(let ((form (or (read stream nil) (done))))
|
|
(when verbose
|
|
(format t "~&~S" form))
|
|
(cond ((eval form) nil)
|
|
(t (list (format nil "~S returned NIL" form)))))))))
|
|
|
|
(defun random-test-function (probability)
|
|
"Returns a random character test function which contains each
|
|
character with probability PROBABILITY."
|
|
(let ((hash-table (make-hash-table)))
|
|
(dotimes (code char-code-limit)
|
|
(let ((char (code-char code)))
|
|
(when (and char (< (random 1.0d0) probability))
|
|
(setf (gethash (code-char code) hash-table) t))))
|
|
(lambda (char)
|
|
(gethash char hash-table))))
|
|
|
|
(defun test-optimized-test-functions% (probability)
|
|
"Creates a random test function with probability PROBABILITY and six
|
|
\(one for each possible \"kind\") corresponding optimized test
|
|
functions, then checks for each character in turn that all functions
|
|
agree on it."
|
|
(let* ((test-function (random-test-function probability))
|
|
(optimized-functions (loop for kind in '(nil
|
|
:hash-table
|
|
:hash-table*
|
|
:charset
|
|
:charset*
|
|
:charmap)
|
|
collect (create-optimized-test-function test-function :kind kind))))
|
|
(loop for code below char-code-limit
|
|
for char = (code-char code)
|
|
for expected-result = (and char (funcall test-function char))
|
|
always (or (null char)
|
|
(loop for optimized-function in optimized-functions
|
|
always (eq (not (funcall optimized-function char))
|
|
(not expected-result)))))))
|
|
|
|
(defun test-optimized-test-functions (&key verbose)
|
|
"Runs TEST-OPTIMIZED-TEST-FUNCTIONS% with different probabilities."
|
|
(let ((probabilities '(0 .001 .01 .1 1)))
|
|
(do-tests ("Optimized test functions - this might take some time..." (not verbose))
|
|
(let ((probability (or (pop probabilities) (done))))
|
|
(when verbose
|
|
(format t "~&Probability is ~A" probability))
|
|
(not (test-optimized-test-functions% probability))))))
|
|
|
|
(defun run-all-tests (&key more-tests verbose)
|
|
"Runs all tests for CL-PPCRE and returns a true value iff all tests
|
|
succeeded. VERBOSE is interpreted by the individual test suites.
|
|
MORE-TESTS can be a list of function designators designating
|
|
additional tests to run. This facility is used by the tests for
|
|
CL-PPCRE-UNICODE."
|
|
(let ((successp t))
|
|
(macrolet ((run-test-suite (&body body)
|
|
`(unless (progn ,@body)
|
|
(setq successp nil))))
|
|
;; run the automatically generated Perl tests
|
|
(run-test-suite (perl-test :verbose verbose))
|
|
(run-test-suite (test-optimized-test-functions :verbose verbose))
|
|
(run-test-suite (simple-tests :verbose verbose))
|
|
(when more-tests
|
|
(unless (listp more-tests)
|
|
(setq more-tests (list more-tests))
|
|
(dolist (test more-tests)
|
|
(run-test-suite (funcall test :verbose verbose))))))
|
|
(format t "~2&~:[Some tests failed~;All tests passed~]." successp)
|
|
successp))
|