about summary refs log tree commit diff
path: root/third_party/lisp/mime4cl/test/rt.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/lisp/mime4cl/test/rt.lisp')
-rw-r--r--third_party/lisp/mime4cl/test/rt.lisp20
1 files changed, 12 insertions, 8 deletions
diff --git a/third_party/lisp/mime4cl/test/rt.lisp b/third_party/lisp/mime4cl/test/rt.lisp
index 06160debbe9b..3f3aa5c56cd3 100644
--- a/third_party/lisp/mime4cl/test/rt.lisp
+++ b/third_party/lisp/mime4cl/test/rt.lisp
@@ -1,5 +1,6 @@
 #|----------------------------------------------------------------------------|
  | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. |
+ | Copyright 2023 by the TVL Authors                                          |
  |                                                                            |
  | Permission  to  use,  copy, modify, and distribute this software  and  its |
  | documentation for any purpose  and without fee is hereby granted, provided |
@@ -20,10 +21,10 @@
  |----------------------------------------------------------------------------|#
 
 (defpackage #:regression-test
-  (:nicknames #:rtest #-lispworks #:rt) 
+  (:nicknames #:rtest #-lispworks #:rt)
   (:use #:cl)
   (:export #:*do-tests-when-defined* #:*test* #:continue-testing
-           #:deftest #:do-test #:do-tests #:get-test #:pending-tests
+           #:deftest #:add-test #:do-test #:do-tests #:get-test #:pending-tests
            #:rem-all-tests #:rem-test)
   (:documentation "The MIT regression tester with pfdietz's modifications"))
 
@@ -86,25 +87,28 @@
 (defmacro deftest (name form &rest values)
   `(add-entry '(t ,name ,form .,values)))
 
+(defun add-test (name form &rest values)
+  (funcall #'add-entry (append (list 't name form) values)))
+
 (defun add-entry (entry)
   (setq entry (copy-list entry))
   (do ((l *entries* (cdr l))) (nil)
     (when (null (cdr l))
       (setf (cdr l) (list entry))
       (return nil))
-    (when (equal (name (cadr l)) 
+    (when (equal (name (cadr l))
                  (name entry))
       (setf (cadr l) entry)
       (report-error nil
-        "Redefining test ~:@(~S~)"
-        (name entry))
+                    "Redefining test ~:@(~S~)"
+                    (name entry))
       (return nil)))
   (when *do-tests-when-defined*
     (do-entry entry))
   (setq *test* (name entry)))
 
 (defun report-error (error? &rest args)
-  (cond (*debug* 
+  (cond (*debug*
          (apply #'format t args)
          (if error? (throw '*debug* nil)))
         (error? (apply #'error args))
@@ -184,7 +188,7 @@
       (setf (pend entry)
             (or aborted
                 (not (equalp-with-case r (vals entry)))))
-      
+
       (when (pend entry)
         (let ((*print-circle* *print-circle-on-failure*))
           (format s "~&Test ~:@(~S~) failed~
@@ -210,7 +214,7 @@
     (setf (pend entry) t))
   (if (streamp out)
       (do-entries out)
-      (with-open-file 
+      (with-open-file
           (stream out :direction :output)
         (do-entries stream))))