From a456512951f9d016dd7b6428924d6fef287820ea Mon Sep 17 00:00:00 2001
From: David Pirotte <address@hidden>
Date: Fri, 13 Jan 2017 23:12:06 -0200
Subject: [PATCH] Unit-test 2 new APIs

* src/unit-test.scm: New assert-false procedure New assert macro: both
  take an expression as their respective argument; assert-false will
  throw a 'test-failed-exception unless expression returns #f; assert
  will throw a 'test-failed-exception if expression raises an exception.
---
 src/unit-test.scm | 41 ++++++++++++++++++++++++++++++-----------
 1 file changed, 30 insertions(+), 11 deletions(-)

diff --git a/src/unit-test.scm b/src/unit-test.scm
index a46b6fc..ba577c4 100644
--- a/src/unit-test.scm
+++ b/src/unit-test.scm
@@ -26,6 +26,7 @@
   #:use-module (ice-9 pretty-print)
   #:export (assert-equal
             assert-true
+	    assert-false
             assert-numeric-=
             <test-result> 
             tests-run 
@@ -46,7 +47,8 @@
             run-all-defined-test-cases
             exit-with-summary)
   
-  #:export-syntax (assert-exception))
+  #:export-syntax (assert
+		   assert-exception))
 
 
  ;; Utility method for finding an object's method given its name. The
@@ -105,6 +107,15 @@
                  (display " got: ")
                  (write got))))))
 
+(define (assert-false got)
+  (if got
+      (throw 'test-failed-exception
+             (with-output-to-string
+               (lambda ()
+                 (display "assert-false: ")
+                 (display " got: ")
+                 (write got))))))
+
 (define (assert-numeric-= expected got precision)
   (if (> (abs (- expected got)) precision)
       (throw 'test-failed-exception
@@ -117,19 +128,27 @@
                  (display " got: ")
                  (write got))))))
 
+(define-macro (assert expression)
+  `(catch #t
+     (lambda () ,expression)
+     (lambda (key . args)
+       (throw
+	'test-failed-exception
+	(format #f "assert: exception on ~S"
+		',expression)))))
 
 (define-macro (assert-exception expression)
   `(catch #t
-          (lambda ()
-            ,expression
-            (throw
-             'test-failed-exception
-             (format #f "assert-exception: no exception on ~S"
-                     ',expression)))
-          (lambda (key . args)
-            (case key
-              ((test-failed-exception) (apply throw key args))
-              (else #t)))))
+     (lambda ()
+       ,expression
+       (throw
+	'test-failed-exception
+	(format #f "assert-exception: no exception on ~S"
+		',expression)))
+     (lambda (key . args)
+       (case key
+	 ((test-failed-exception) (apply throw key args))
+	 (else #t)))))
 
 
 ;;;----------------------------------------------------------------
-- 
2.11.0