mike
/
transcendental-lisp
1
1
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

Convert the lisp unit tester into a class

This commit is contained in:
Mike Cifelli 2017-03-09 11:19:15 -05:00
parent b47abbaad5
commit d423fe9958
9 changed files with 134 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
fitnesse/FitNesseRoot/RecentChanges.wiki
View File

@ -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|

4
fitnesse/FitNesseRoot/TranscendentalLisp/FinanceUnitTests.wiki
View File

@ -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$/ |

2
fitnesse/FitNesseRoot/TranscendentalLisp/LangUnitTests.wiki
View File

@ -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$/ |

13
lisp/finance/compound-interest-test.lisp
View File

@ -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)

56
lisp/finance/interest-compounder-test.lisp
View File

@ -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)

5
lisp/finance/interest-compounder.lisp
View File

@ -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))))))))

24
lisp/lang/dlambda-test.lisp
View File

@ -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)

34
lisp/unit/unit-test.lisp
View File

@ -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))

70
lisp/unit/unit-tester.lisp Normal file
View File

@ -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)))))))))