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