From 1f1586d53ca004f0c8b79df22b49f05f968d8adf Mon Sep 17 00:00:00 2001 From: Mike Cifelli Date: Fri, 3 Mar 2017 11:56:27 -0500 Subject: [PATCH] More class examples and script unit tests were added. --- .../ExternalFunctionUnitTests.wiki | 9 ++ fitnesse/FitNesseRoot/RecentChanges.wiki | 2 + lisp/dlambda-test.lisp | 111 ++++++++++++++++++ lisp/this.lisp | 70 +++++++++++ lisp/unit-test.lisp | 33 ++++-- 5 files changed, 218 insertions(+), 7 deletions(-) create mode 100644 fitnesse/FitNesseRoot/LispInterpreter/ExternalFunctionUnitTests.wiki create mode 100644 lisp/dlambda-test.lisp create mode 100644 lisp/this.lisp diff --git a/fitnesse/FitNesseRoot/LispInterpreter/ExternalFunctionUnitTests.wiki b/fitnesse/FitNesseRoot/LispInterpreter/ExternalFunctionUnitTests.wiki new file mode 100644 index 0000000..82cdf46 --- /dev/null +++ b/fitnesse/FitNesseRoot/LispInterpreter/ExternalFunctionUnitTests.wiki @@ -0,0 +1,9 @@ +--- +Test +--- +Unit tests for the dlambda special function. + +| script | lisp interpreter fixture | +| show | evaluate | (load "lisp/unit-test.lisp") | +| show | evaluate | (load "lisp/dlambda.lisp") | +| show | evaluate | (load "lisp/dlambda-test.lisp") | diff --git a/fitnesse/FitNesseRoot/RecentChanges.wiki b/fitnesse/FitNesseRoot/RecentChanges.wiki index 43d55e0..dabce81 100644 --- a/fitnesse/FitNesseRoot/RecentChanges.wiki +++ b/fitnesse/FitNesseRoot/RecentChanges.wiki @@ -1,3 +1,5 @@ +|LispInterpreter.DlambdaUnitTests||10:16:42 Fri, Mar 03, 2017| +|LispInterpreter.dlambda||10:12:59 Fri, Mar 03, 2017| |LispInterpreter.ObjectComposition||09:05:15 Fri, Mar 03, 2017| |LispInterpreter||09:04:51 Fri, Mar 03, 2017| |LispInterpreter.LexicalClosures||16:31:40 Thu, Mar 02, 2017| diff --git a/lisp/dlambda-test.lisp b/lisp/dlambda-test.lisp new file mode 100644 index 0000000..7592428 --- /dev/null +++ b/lisp/dlambda-test.lisp @@ -0,0 +1,111 @@ +(load "unit-test.lisp") +(load "dlambda.lisp") + +(unit + (list + + (defun empty-dlambda () + (assert-equal + '(lambda (&rest arguments) (case (first arguments))) + (dlambda) + ) + ) + + (defun dlambda-default-method-only () + (assert-equal + '(lambda (&rest arguments) + (case (first arguments) + (t (apply (lambda () (print "nothing")) arguments)) + ) + ) + (dlambda + (t () (print "nothing")) + ) + ) + ) + + (defun dlambda-named-method-only () + (assert-equal + '(lambda (&rest arguments) + (case (first arguments) + (:write (apply (lambda () (print "something")) (rest arguments))) + ) + ) + (dlambda + (:write () (print "something")) + ) + ) + ) + + (defun dlambda-named-and-default-method () + (assert-equal + '(lambda (&rest arguments) + (case (first arguments) + (:write (apply (lambda () (print "something")) (rest arguments))) + (t (apply (lambda () (print "nothing")) arguments)) + ) + ) + (dlambda + (:write () (print "something")) + (t () (print "nothing")) + ) + ) + ) + + (defun dlambda-methods-with-arguments () + (assert-equal + '(lambda (&rest arguments) + (case (first arguments) + (:write (apply (lambda (message) (print message)) (rest arguments))) + (t (apply (lambda (&rest messages) (print messages)) arguments)) + ) + ) + (dlambda + (:write (message) (print message)) + (t (&rest messages) (print messages)) + ) + ) + ) + + (defun dlambda-methods-with-multiple-arguments () + (assert-equal + '(lambda (&rest arguments) + (case (first arguments) + (:write + (apply + (lambda (message &rest other-stuff) + (print message) + (print other-stuff) + ) + (rest arguments) + ) + ) + (t + (apply + (lambda (message1 message2 &rest other-stuff) + (print message1) + (print message2) + (print other-stuff) + ) + arguments + ) + ) + ) + ) + (dlambda + (:write (message &rest other-stuff) + (print message) + (print other-stuff) + ) + (t (message1 message2 &rest other-stuff) + (print message1) + (print message2) + (print other-stuff) + ) + ) + ) + ) + + ) +) + diff --git a/lisp/this.lisp b/lisp/this.lisp new file mode 100644 index 0000000..c9e6003 --- /dev/null +++ b/lisp/this.lisp @@ -0,0 +1,70 @@ +(load "dlambda.lisp") + +(defun counter (initial-count) + (let ((count initial-count) + (print-prefix nil) + (this nil)) + + (setf print-prefix "Counter") + + (setf this + (eval + (dlambda + + (:inc () + (setf count (+ count 1)) + ) + + (:inc-3 () + (funcall this :inc) + (funcall this :inc) + (funcall this :inc) + ) + + (:dec () + (setf count (- count 1)) + ) + + (:dec-3 () + (funcall this :dec) + (funcall this :dec) + (funcall this :dec) + ) + + (:get () + count + ) + + (:set (value) + (setf count value) + ) + + (t () + (cons print-prefix count) + ) + + ) + ) + ) + + ) +) + +; Create an instance +; +; usage: +; ~ (my-counter :inc-3) +; 3 +; +(let ((instance (counter 0))) + (defun my-counter (&rest args) (apply instance args)) +) + +; Another way +; +; usage: +; ~ (funcall my-counter2 :dec-3) +; 997 +; +(setf my-counter2 (counter 10000)) + diff --git a/lisp/unit-test.lisp b/lisp/unit-test.lisp index 1ea4e70..912ad3f 100644 --- a/lisp/unit-test.lisp +++ b/lisp/unit-test.lisp @@ -1,14 +1,21 @@ (defun run-unit-test (unit-test) (if (funcall unit-test) - (progn (print (cons t unit-test)) t) - (progn (print (cons 'F unit-test)) nil) + (progn + (print (cons t unit-test)) + t + ) + (progn + (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)) + (cons + (run-unit-test (car test-suite)) + (run-test-suite (cdr test-suite)) ) ) ) @@ -17,9 +24,21 @@ (eval (cons 'and (run-test-suite test-suite))) ) -(defun assert= (expected actual) - (if (= expected actual) +(defun assert (comparison expected actual) + (if (funcall comparison expected actual) t - (progn (print (list expected 'is 'not actual)) nil) + (progn + (print (list expected 'is 'not comparison actual)) + nil + ) ) ) + +(defun assert= (expected actual) + (assert '= expected actual) +) + +(defun assert-equal (expected actual) + (assert 'equal expected actual) +) +