Convert the lisp unit tester into a class

fitnesse/FitNesseRoot/RecentChanges.wiki

@@ -1,4 +1,5 @@
-|TranscendentalLisp.FinanceUnitTests||11:03:11 Wed, Mar 08, 2017|
+|TranscendentalLisp.FinanceUnitTests||11:07:42 Thu, Mar 09, 2017|
+|TranscendentalLisp.LangUnitTests||11:04:17 Thu, Mar 09, 2017|
 |TranscendentalLisp.LexicalClosures||16:39:59 Tue, Mar 07, 2017|
 |FrontPage||10:19:45 Tue, Mar 07, 2017|
 |TranscendentalLisp||10:14:02 Tue, Mar 07, 2017|

fitnesse/FitNesseRoot/TranscendentalLisp/FinanceUnitTests.wiki

@@ -5,10 +5,10 @@ Unit tests for the interest-compounder class.
 
 | script | lisp interpreter fixture                                   |
 | clear functions and symbols                                         |
-| check  | evaluate file | lisp/finance/interest-compounder-test.lisp | =~/T$/ |
+| check  | evaluate file | lisp/finance/interest-compounder-test.lisp | =~/\nT$/ |
 
 Unit tests for the compound-interest function.
 
 | script | lisp interpreter fixture                                 |
 | clear functions and symbols                                       |
-| check  | evaluate file | lisp/finance/compound-interest-test.lisp | =~/T$/ |
+| check  | evaluate file | lisp/finance/compound-interest-test.lisp | =~/\nT$/ |

fitnesse/FitNesseRoot/TranscendentalLisp/LangUnitTests.wiki

@@ -4,4 +4,4 @@ Test
 Unit tests for the dlambda special function.
 
 | script | lisp interpreter fixture                    |
-| check  | evaluate file | lisp/lang/dlambda-test.lisp | =~/T$/ |
+| check  | evaluate file | lisp/lang/dlambda-test.lisp | =~/\nT$/ |

lisp/finance/compound-interest-test.lisp

@@ -1,7 +1,12 @@
-(load "../unit/unit-test.lisp")
+(load "../unit/unit-tester.lisp")
 (load "compound-interest.lisp")
 
-(unit
+(setq assertions (unit-tester-assertions))
+
+(defun assert= (expected actual)
+  (call assertions :assert= expected actual))
+
+(setq tests
   (list
 
     (defun many-years-with-no-interest-rate ()
@@ -36,3 +41,7 @@
 
     (defun negative-number-of-years ()
       (assert= 100000 (compound-interest 100000 5 -4)))))
+
+
+(setq tester (unit-tester tests))
+(call tester :run)

lisp/finance/interest-compounder-test.lisp

@@ -1,118 +1,120 @@
-(load "../unit/unit-test.lisp")
+(load "../unit/unit-tester.lisp")
 (load "interest-compounder.lisp")
 
-(unit
+(setq assertions (unit-tester-assertions))
+
+(setq tests
   (let ((compounder))
     (list
 
       (defun principal-initialized ()
         (setq compounder (interest-compounder 1000 0))
-        (assert= 1000 (call compounder :get-principal)))
+        (call assertions :assert= 1000 (call compounder :get-principal)))
 
       (defun interest-rate-initialized ()
         (setq compounder (interest-compounder 0 10))
-        (assert= 10 (call compounder :get-interest-rate)))
+        (call assertions :assert= 10 (call compounder :get-interest-rate)))
 
       (defun many-years-with-no-interest-rate ()
         (setq compounder (interest-compounder 1000 0))
         (call compounder :move-forward-years 83)
-        (assert= 1000 (call compounder :get-principal)))
+        (call assertions :assert= 1000 (call compounder :get-principal)))
 
       (defun no-years-with-positive-interest-rate ()
         (setq compounder (interest-compounder 1000 10))
-        (assert= 1000 (call compounder :get-principal)))
+        (call assertions :assert= 1000 (call compounder :get-principal)))
 
       (defun one-year-with-positive-interest-rate ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :move-forward-years 1)
-        (assert= 105000 (call compounder :get-principal)))
+        (call assertions :assert= 105000 (call compounder :get-principal)))
 
       (defun two-years-with-positive-interest-rate ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :move-forward-years 2)
-        (assert= 110250 (call compounder :get-principal)))
+        (call assertions :assert= 110250 (call compounder :get-principal)))
 
       (defun three-years-with-positive-interest-rate ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :move-forward-years 3)
-        (assert= 115763 (call compounder :get-principal)))
+        (call assertions :assert= 115763 (call compounder :get-principal)))
 
       (defun four-years-with-positive-interest-rate ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :move-forward-years 4)
-        (assert= 121551 (call compounder :get-principal)))
+        (call assertions :assert= 121551 (call compounder :get-principal)))
 
       (defun one-year-with-negative-interest-rate ()
         (setq compounder (interest-compounder 100000 -5))
         (call compounder :move-forward-years 1)
-        (assert= 95000 (call compounder :get-principal)))
+        (call assertions :assert= 95000 (call compounder :get-principal)))
 
       (defun two-years-with-negative-interest-rate ()
         (setq compounder (interest-compounder 100000 -5))
         (call compounder :move-forward-years 2)
-        (assert= 90250 (call compounder :get-principal)))
+        (call assertions :assert= 90250 (call compounder :get-principal)))
 
       (defun three-years-with-negative-interest-rate ()
         (setq compounder (interest-compounder 100000 -5))
         (call compounder :move-forward-years 3)
-        (assert= 85737 (call compounder :get-principal)))
+        (call assertions :assert= 85737 (call compounder :get-principal)))
 
       (defun four-years-with-negative-interest-rate ()
         (setq compounder (interest-compounder 100000 -5))
         (call compounder :move-forward-years 4)
-        (assert= 81450 (call compounder :get-principal)))
+        (call assertions :assert= 81450 (call compounder :get-principal)))
 
       (defun negative-number-of-years-does-nothing ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :move-forward-years -4)
-        (assert= 100000 (call compounder :get-principal))
+        (call assertions :assert= 100000 (call compounder :get-principal))
         (call compounder :move-forward-years 1)
         (call compounder :move-forward-years -4)
-        (assert= 105000 (call compounder :get-principal)))
+        (call assertions :assert= 105000 (call compounder :get-principal)))
 
       (defun zero-number-of-years-does-nothing ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :move-forward-years 0)
-        (assert= 100000 (call compounder :get-principal))
+        (call assertions :assert= 100000 (call compounder :get-principal))
         (call compounder :move-forward-years 1)
         (call compounder :move-forward-years 0)
-        (assert= 105000 (call compounder :get-principal)))
+        (call assertions :assert= 105000 (call compounder :get-principal)))
 
       (defun variable-interest-rate ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :move-forward-years 2)
         (call compounder :set-interest-rate 10)
         (call compounder :move-forward-years 2)
-        (assert= 133403 (call compounder :get-principal)))
+        (call assertions :assert= 133403 (call compounder :get-principal)))
 
       (defun years-are-updated ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :move-forward-years 27)
-        (assert= 27 (call compounder :get-years-passed)))
+        (call assertions :assert= 27 (call compounder :get-years-passed)))
 
       (defun negative-number-of-years-does-not-update-years ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :move-forward-years 27)
         (call compounder :move-forward-years -2)
-        (assert= 27 (call compounder :get-years-passed)))
+        (call assertions :assert= 27 (call compounder :get-years-passed)))
 
       (defun zero-number-of-years-does-not-update-years ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :move-forward-years 27)
         (call compounder :move-forward-years 0)
-        (assert= 27 (call compounder :get-years-passed)))
+        (call assertions :assert= 27 (call compounder :get-years-passed)))
 
       (defun make-contribution ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :make-contribution 2000)
-        (assert= 102000 (call compounder :get-principal)))
+        (call assertions :assert= 102000 (call compounder :get-principal)))
 
       (defun make-several-contributions ()
         (setq compounder (interest-compounder 100000 5))
         (call compounder :make-contribution 2000)
         (call compounder :make-contribution 2000)
         (call compounder :make-contribution 1000)
-        (assert= 105000 (call compounder :get-principal)))
+        (call assertions :assert= 105000 (call compounder :get-principal)))
 
       (defun make-several-contributions-and-earn-interest ()
         (setq compounder (interest-compounder 100000 5))
@@ -120,4 +122,8 @@
         (call compounder :move-forward-years 2)
         (call compounder :make-contribution 2000)
         (call compounder :move-forward-years 2)
-        (assert= 126187 (call compounder :get-principal))))))
+        (call assertions :assert= 126187 (call compounder :get-principal))))))
+
+
+(setq tester (unit-tester tests))
+(call tester :run)

lisp/finance/interest-compounder.lisp

@@ -53,6 +53,5 @@
               (setq principal (+ principal contribution)))
 
             (:move-forward-years (years)
-              (begin
+              (call private :compound-interest years)
-                (call private :compound-interest years)
+              (call private :add-years years))))))))
-                (call private :add-years years)))))))))

lisp/lang/dlambda-test.lisp

@@ -1,17 +1,19 @@
-(load "../unit/unit-test.lisp")
+(load "../unit/unit-tester.lisp")
 (load "dlambda.lisp")
 
-(unit
+(setq assertions (unit-tester-assertions))
+
+(setq tests
   (list
 
     (defun empty-dlambda ()
-      (assert-equal
+      (call assertions :assert-equal
        '(lambda (&rest arguments) (case (first arguments)))
 
         (dlambda)))
 
     (defun dlambda-default-method-only ()
-      (assert-equal
+      (call assertions :assert-equal
        '(lambda (&rest arguments)
           (case (first arguments)
             (t (apply (lambda () (print "nothing")) arguments))))
@@ -20,7 +22,7 @@
           (t () (print "nothing")))))
 
     (defun dlambda-named-method-only ()
-      (assert-equal
+      (call assertions :assert-equal
        '(lambda (&rest arguments)
           (case (first arguments)
             (:write (apply (lambda () (print "something")) (rest arguments)))))
@@ -29,7 +31,7 @@
           (:write () (print "something")))))
 
     (defun dlambda-many-named-methods ()
-      (assert-equal
+      (call assertions :assert-equal
        '(lambda (&rest arguments)
           (case (first arguments)
             (:write1 (apply (lambda () (print "something")) (rest arguments)))
@@ -42,7 +44,7 @@
           (:write3 () (print "something")))))
 
     (defun dlambda-named-and-default-method ()
-      (assert-equal
+      (call assertions :assert-equal
        '(lambda (&rest arguments)
           (case (first arguments)
             (:write (apply (lambda () (print "something")) (rest arguments)))
@@ -53,7 +55,7 @@
           (t () (print "nothing")))))
 
     (defun dlambda-methods-with-arguments ()
-      (assert-equal
+      (call assertions :assert-equal
        '(lambda (&rest arguments)
           (case (first arguments)
             (:write (apply (lambda (message) (print message)) (rest arguments)))
@@ -64,7 +66,7 @@
           (t (&rest messages) (print messages)))))
 
     (defun dlambda-methods-with-multiple-arguments ()
-      (assert-equal
+      (call assertions :assert-equal
        '(lambda (&rest arguments)
           (case (first arguments)
             (:write
@@ -89,3 +91,7 @@
             (print message1)
             (print message2)
             (print other-stuff)))))))
+
+
+(setq tester (unit-tester tests))
+(call tester :run)

lisp/unit/unit-test.lisp

@@ -1,34 +0,0 @@
-(defun run-unit-test (unit-test)
-  (if (call unit-test)
-    (begin
-      (print (cons t unit-test))
-      t)
-    (begin
-      (print (cons 'f unit-test))
-      nil)))
-
-(defun run-test-suite (test-suite)
-  (if test-suite
-    (cons
-      (run-unit-test (car test-suite))
-      (run-test-suite (cdr test-suite)))))
-
-(defun unit (test-suite)
-  (apply 'and (run-test-suite test-suite)))
-
-(defun assert (comparison operand1 operand2)
-  (if (call comparison operand1 operand2)
-    t
-    (begin
-      (print '==================================================)
-      (print (list comparison 'comparison 'failed))
-      (print operand1)
-      (print operand2)
-      (print '--------------------------------------------------)
-      nil)))
-
-(defun assert= (expected actual)
-  (assert '= expected actual))
-
-(defun assert-equal (expected actual)
-  (assert 'equal expected actual))

lisp/unit/unit-tester.lisp

@@ -0,0 +1,70 @@
+(load "../lang/dlambda.lisp")
+
+(let ((private-static) (public-static))
+
+  (defun unit-tester-assertions ()
+    public-static)
+
+  (setq private-static
+    (eval
+      (dlambda
+
+        (:assertion-failed (comparison operand1 operand2)
+          (call private-static :print-failure comparison operand1 operand2)
+          nil)
+
+        (:print-failure (comparison operand1 operand2)
+          (print '==================================================)
+          (print (list comparison 'comparison 'failed))
+          (print operand1)
+          (print operand2)
+          (print '--------------------------------------------------)))))
+
+  (setq public-static
+    (eval
+      (dlambda
+
+        (:assert= (expected actual)
+          (call public-static :assert '= expected actual))
+
+        (:assert-equal (expected actual)
+          (call public-static :assert 'equal expected actual))
+
+        (:assert (comparison operand1 operand2)
+          (if (call comparison operand1 operand2)
+            t
+            (call private-static :assertion-failed comparison operand1 operand2))))))
+
+  (defun unit-tester (suite)
+    (let ((private) (public)
+          (suite suite))
+
+      (setq private
+        (eval
+          (dlambda
+
+            (:run-suite (suite)
+              (if suite
+                (cons
+                  (call private :run-test (car suite))
+                  (call private :run-suite (cdr suite)))))
+
+            (:run-test (test)
+              (if (call test)
+                (call private :indicate-success test)
+                (call private :indicate-failure test)))
+
+            (:indicate-success (test)
+              (print (cons t test))
+              t)
+
+            (:indicate-failure (test)
+              (print (cons 'f test))
+              nil))))
+
+      (setq public
+        (eval
+          (dlambda
+
+            (:run ()
+              (apply 'and (call private :run-suite suite)))))))))