From d423fe99588ec8bd70f26fa270db51f53aca5b64 Mon Sep 17 00:00:00 2001 From: Mike Cifelli Date: Thu, 9 Mar 2017 11:19:15 -0500 Subject: [PATCH] Convert the lisp unit tester into a class --- fitnesse/FitNesseRoot/RecentChanges.wiki | 3 +- .../TranscendentalLisp/FinanceUnitTests.wiki | 4 +- .../TranscendentalLisp/LangUnitTests.wiki | 2 +- lisp/finance/compound-interest-test.lisp | 13 +++- lisp/finance/interest-compounder-test.lisp | 56 ++++++++------- lisp/finance/interest-compounder.lisp | 5 +- lisp/lang/dlambda-test.lisp | 24 ++++--- lisp/unit/unit-test.lisp | 34 --------- lisp/unit/unit-tester.lisp | 70 +++++++++++++++++++ 9 files changed, 134 insertions(+), 77 deletions(-) delete mode 100644 lisp/unit/unit-test.lisp create mode 100644 lisp/unit/unit-tester.lisp diff --git a/fitnesse/FitNesseRoot/RecentChanges.wiki b/fitnesse/FitNesseRoot/RecentChanges.wiki index 8447b41..a1f9e15 100644 --- a/fitnesse/FitNesseRoot/RecentChanges.wiki +++ b/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| diff --git a/fitnesse/FitNesseRoot/TranscendentalLisp/FinanceUnitTests.wiki b/fitnesse/FitNesseRoot/TranscendentalLisp/FinanceUnitTests.wiki index cac682f..33b776b 100644 --- a/fitnesse/FitNesseRoot/TranscendentalLisp/FinanceUnitTests.wiki +++ b/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$/ | diff --git a/fitnesse/FitNesseRoot/TranscendentalLisp/LangUnitTests.wiki b/fitnesse/FitNesseRoot/TranscendentalLisp/LangUnitTests.wiki index 2e0df2b..2ed8587 100644 --- a/fitnesse/FitNesseRoot/TranscendentalLisp/LangUnitTests.wiki +++ b/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$/ | diff --git a/lisp/finance/compound-interest-test.lisp b/lisp/finance/compound-interest-test.lisp index 558a95e..10b2bf8 100644 --- a/lisp/finance/compound-interest-test.lisp +++ b/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) diff --git a/lisp/finance/interest-compounder-test.lisp b/lisp/finance/interest-compounder-test.lisp index 122bdeb..0ed6f46 100644 --- a/lisp/finance/interest-compounder-test.lisp +++ b/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) diff --git a/lisp/finance/interest-compounder.lisp b/lisp/finance/interest-compounder.lisp index 65a601e..414a677 100644 --- a/lisp/finance/interest-compounder.lisp +++ b/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 :add-years years))))))))) + (call private :compound-interest years) + (call private :add-years years)))))))) diff --git a/lisp/lang/dlambda-test.lisp b/lisp/lang/dlambda-test.lisp index 33540e8..f779f9a 100644 --- a/lisp/lang/dlambda-test.lisp +++ b/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) diff --git a/lisp/unit/unit-test.lisp b/lisp/unit/unit-test.lisp deleted file mode 100644 index 4a5ca1f..0000000 --- a/lisp/unit/unit-test.lisp +++ /dev/null @@ -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)) diff --git a/lisp/unit/unit-tester.lisp b/lisp/unit/unit-tester.lisp new file mode 100644 index 0000000..7e0b87b --- /dev/null +++ b/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)))))))))