From d742c5227ba591922c150fe613c9adacec910012 Mon Sep 17 00:00:00 2001
From: =?utf8?q?David=20V=C3=A1zquez?= <davazp@gmail.com>
Date: Fri, 26 Apr 2013 22:20:47 +0100
Subject: [PATCH] Expected test failures and unexpected passes

---
 src/boot.lisp     |    1 +
 tests-report.lisp |   22 +++++++++++++++-------
 tests.lisp        |   32 +++++++++++++++++++++++++-------
 tests/read.lisp   |    3 ++-
 4 files changed, 43 insertions(+), 15 deletions(-)

diff --git a/src/boot.lisp b/src/boot.lisp
index 2149308..0af19f4 100644
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -82,6 +82,7 @@
 
 (defmacro defun (name args &rest body)
   `(progn
+     
      (fset ',name
            (named-lambda ,(symbol-name name) ,args
              ,@(if (and (stringp (car body)) (not (null (cdr body))))
diff --git a/tests-report.lisp b/tests-report.lisp
index d4a5275..45c7f7c 100644
--- a/tests-report.lisp
+++ b/tests-report.lisp
@@ -4,12 +4,20 @@
 (write-line " seconds.")
 
 (cond
-  ((zerop *failed-tests*)
-   (write-string "All tests (")
-   (write-string (prin1-to-string *passed-tests*))
-   (write-line ") passed successfully"))
+  ((= *passed-tests* *total-tests*)
+   (write-line "All the tests (")
+   (write-string (prin1-to-string *total-tests*))
+   (write-line ") passed successfully."))
   (t
-   (write-string (prin1-to-string *failed-tests*))
+   (write-string (prin1-to-string *passed-tests*))
    (write-string "/")
-   (write-string (prin1-to-string (+ *passed-tests* *failed-tests*)))
-   (write-line " failed.")))
+   (write-string (prin1-to-string *total-tests*))
+   (write-line " test(s) passed successfully.")))
+
+(unless (zerop *expected-failures*)
+  (write-string (prin1-to-string *expected-failures*))
+  (write-line " test(s) failed expectedly."))
+
+(unless (zerop *unexpected-passes*)
+  (write-string (prin1-to-string *unexpected-passes*))
+  (write-line " test(s) passed unexpectedly."))
diff --git a/tests.lisp b/tests.lisp
index d383dc0..8fcd862 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -1,15 +1,33 @@
+(defvar *total-tests* 0)
 (defvar *passed-tests* 0)
 (defvar *failed-tests* 0)
+
+(defvar *expected-failures* 0)
+(defvar *unexpected-passes* 0)
+
 (defvar *timestamp* nil)
 
 (defmacro test (condition)
-  `(cond
-     (,condition
-      (write-line ,(concat "Test `" (prin1-to-string condition) "' passed"))
-      (incf *passed-tests*))
-     (t
-      (write-line ,(concat "Test `" (prin1-to-string condition) "' failed."))
-      (incf *failed-tests*))))
+  `(progn
+     (cond
+       (,condition
+        (write-line ,(concat "Test `" (prin1-to-string condition) "' passed"))
+        (incf *passed-tests*))
+       (t
+        (write-line ,(concat "Test `" (prin1-to-string condition) "' failed."))
+        (incf *failed-tests*)))
+     (incf *total-tests*)))
+
+(defmacro expected-failure (condition)
+  `(progn
+     (cond
+       (,condition
+        (write-line ,(concat "Test `" (prin1-to-string condition) "' passed unexpectedly!"))
+        (incf *unexpected-passes*))
+       (t
+        (write-line ,(concat "Test `" (prin1-to-string condition) "' failed expectedly."))
+        (incf *expected-failures*)))
+     (incf *total-tests*)))
 
 (write-line "Running tests...")
 (write-line "")
diff --git a/tests/read.lisp b/tests/read.lisp
index 6f10ca2..b8e851c 100644
--- a/tests/read.lisp
+++ b/tests/read.lisp
@@ -1,4 +1,5 @@
 ;; TODO: Uncomment when either read-from-string supports all these parameters
 ;; or when test macro supports error handling, whichever comes first
 ;; (test (equal (read-from-string " 1 3 5" t nil :start 2) (values 3 5)))
-(test (equal (read-from-string "(a b c)") (values '(A B C) 7)))
+(expected-failure
+ (equal (read-from-string "(a b c)") (values '(A B C) 7)))
-- 
1.7.10.4