From 5fd5a6dbc0fcdcae25c307fd076ef9743db38f7d Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Wed, 27 Apr 2005 12:13:45 +0000 Subject: [PATCH] Add :catch-errors, :compile keyword args to do-test, do-tests, do-extended-tests. Make out parameter of do-tests be a keyword arg. --- ansi-tests/rt.lsp | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/ansi-tests/rt.lsp b/ansi-tests/rt.lsp index 41f57a27..4c0e0ffa 100644 --- a/ansi-tests/rt.lsp +++ b/ansi-tests/rt.lsp @@ -168,7 +168,10 @@ (t (apply #'warn args))) nil) -(defun do-test (&optional (name *test*)) +(defun do-test (&optional (name *test*) + &key + ((:catch-errors *catch-errors*) *catch-errors*) + ((:compile *compile-tests*) *compile-tests*)) #-sbcl (do-entry (get-entry name)) #+sbcl (handler-bind ((sb-ext:code-deletion-note #'muffle-warning)) (do-entry (get-entry name)))) @@ -321,8 +324,9 @@ (throw '*in-test* nil) (do-entries *standard-output*))) -(defun do-tests (&optional - (out *standard-output*)) +(defun do-tests (&key (out *standard-output*) + ((:catch-errors *catch-errors*) *catch-errors*) + ((:compile *compile-tests*) *compile-tests*)) (setq *failed-tests* nil *passed-tests* nil) (dolist (entry (cdr *entries*)) @@ -407,3 +411,19 @@ (unless note (error "~A is not a note or note name." n)) (setf (note-disabled note) nil) note)) + +;;; Extended random regression + +(defun do-extended-tests (&key (tests *passed-tests*) (count nil) + ((:catch-errors *catch-errors*) *catch-errors*) + ((:compile *compile-tests*) *compile-tests*)) + "Execute randomly chosen tests from TESTS until one fails or until + COUNT is an integer and that many tests have been executed." + (let ((test-vector (coerce tests 'simple-vector))) + (let ((n (length test-vector))) + (when (= n 0) (error "Must provide at least one test.")) + (loop for i from 0 + for name = (svref test-vector (random n)) + until (eql i count) + do (print name) + unless (do-test name) return (values name (1+ i)))))) -- GitLab