More class examples and script unit tests were added.

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

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|

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

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

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