From b7f1f824f7bde9330b9f279bdf17a28c9294c886 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sat, 23 Apr 2005 17:29:28 +0000
Subject: [PATCH] Added *passing-tests*, *failing-tests* vars, which are set by
 do-tests

---
 ansi-tests/rt-package.lsp |  2 ++
 ansi-tests/rt.lsp         | 17 ++++++++++++-----
 2 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/ansi-tests/rt-package.lsp b/ansi-tests/rt-package.lsp
index 358a9516..bedd7138 100644
--- a/ansi-tests/rt-package.lsp
+++ b/ansi-tests/rt-package.lsp
@@ -48,6 +48,8 @@
 			       #:defnote
 			       #:my-aref
 			       #:*catch-errors*
+			       #:*passed-tests*
+			       #:*failed-tests*
 			       #:disable-note))))))
 ;;  )
 
diff --git a/ansi-tests/rt.lsp b/ansi-tests/rt.lsp
index 2ed4d86f..41f57a27 100644
--- a/ansi-tests/rt.lsp
+++ b/ansi-tests/rt.lsp
@@ -47,6 +47,9 @@
 (defvar *expanded-eval* nil "When true, convert the tests into a form that is less likely to have compiler optimizations.")
 (defvar *optimization-settings* '((safety 3)))
 
+(defvar *failed-tests* nil "After DO-TESTS, becomes the list of names of tests that have failed")
+(defvar *passed-tests* nil "After DO-TESTS, becomes the list of names of tests that have passed")
+
 (defvar *expected-failures* nil
   "A list of test names that are expected to fail.")
 
@@ -270,12 +273,11 @@
 	  (handler-case
 	   (let ((st (format nil "Actual value~P: ~
                       ~{~S~^~%~15t~}.~%"
-			    (length r) r)))
+			     (length r) r)))
 	     (format s "~A" st))
 	   (error () (format s "Actual value: #<error during printing>~%")
 		  ))
-	  (finish-output s)
-	  ))))
+	  (finish-output s)))))
   (when (not (pend entry)) *test*))
 
 (defun expanded-eval (form)
@@ -321,6 +323,8 @@
 
 (defun do-tests (&optional
 		 (out *standard-output*))
+  (setq *failed-tests* nil
+	*passed-tests* nil)
   (dolist (entry (cdr *entries*))
     (setf (pend entry) t))
   (if (streamp out)
@@ -338,8 +342,11 @@
   (dolist (entry (cdr *entries*))
     (when (and (pend entry)
 	       (not (has-disabled-note entry)))
-      (format s "~@[~<~%~:; ~:@(~S~)~>~]"
-	      (do-entry entry s))
+      (let ((success? (do-entry entry s)))
+	(if success?
+	  (push (name entry) *passed-tests*)
+	  (push (name entry) *failed-tests*))
+	(format s "~@[~<~%~:; ~:@(~S~)~>~]" success?))
       (finish-output s)
       ))
   (let ((pending (pending-tests))
-- 
GitLab