From b063464bd4d0f0e9843ca948e760c04f287cf168 Mon Sep 17 00:00:00 2001
From: Raymond Toy <rtoy@chromium.org>
Date: Mon, 4 Sep 2017 17:56:58 -0700
Subject: [PATCH] Fix #9: Expose unexpected failures and successes

When `*expected-failures*` is set, RT will print out any unexpected
failures or successes.

This change adds `*unexpected-failures*` and `*unexpected-successes*`
to keep track of this failures or successes in addition to the having
them printed out.  Users can then inspect these easily to do something
based on the results.
---
 rt-package.lsp |  5 ++++-
 rt.lsp         | 15 ++++++++++++---
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/rt-package.lsp b/rt-package.lsp
index ba0eb876..c7666422 100644
--- a/rt-package.lsp
+++ b/rt-package.lsp
@@ -52,7 +52,10 @@
                                #:*catch-errors*
                                #:*passed-tests*
                                #:*failed-tests*
-                               #:disable-note))))))
+                               #:disable-note
+                               #:*expected-failures*
+                               #:*unexpected-failures*
+                               #:*unexpected-successes*))))))
 ;;  )
 
 ;; (in-package :regression-test)
diff --git a/rt.lsp b/rt.lsp
index d658243e..349fa005 100644
--- a/rt.lsp
+++ b/rt.lsp
@@ -53,6 +53,12 @@
 (defvar *expected-failures* nil
   "A list of test names that are expected to fail.")
 
+(defvar *unexpected-successes* nil
+  "A list of tests that passed but were expected to fail.")
+
+(defvar *unexpected-failures* nil
+  "A list of tests that failed but were not expected to fail.")
+
 (defvar *notes* (make-hash-table :test 'equal)
   "A mapping from names of notes to note objects.")
 
@@ -380,6 +386,7 @@
           (if (null new-failures)
               (format s "~&No unexpected failures.")
             (when *expected-failures*
+              (setf *unexpected-failures* new-failures)
               (format s "~&~A unexpected failures: ~
                    ~:@(~{~<~%   ~1:;~S~>~
                          ~^, ~}~)."
@@ -393,11 +400,13 @@
                      (loop :for ex :in *expected-failures*
                        :unless (gethash ex pending-table) :collect ex)))
                 (if unexpected-successes
-                    (format t "~&~:D unexpected successes: ~
+                    (progn
+                      (setf *unexpected-successes* unexpected-successes)
+                      (format t "~&~:D unexpected successes: ~
                    ~:@(~{~<~%   ~1:;~S~>~
                          ~^, ~}~)."
-                            (length unexpected-successes)
-                            unexpected-successes)
+                              (length unexpected-successes)
+                              unexpected-successes))
                     (format t "~&No unexpected successes.")))))
           ))
       (finish-output s)
-- 
GitLab