(load "../unit/unit-tester.lisp") (load "dlambda.lisp") (setq assertions (unit-tester-assertions)) (setq tests (list (defun empty-dlambda () (call assertions :assert-equal '(lambda (&rest arguments) (case (first arguments))) (dlambda))) (defun dlambda-default-method-only () (call assertions :assert-equal '(lambda (&rest arguments) (case (first arguments) (t (apply (lambda () (print "nothing")) arguments)))) (dlambda (t () (print "nothing"))))) (defun dlambda-named-method-only () (call assertions :assert-equal '(lambda (&rest arguments) (case (first arguments) (:write (apply (lambda () (print "something")) (rest arguments))))) (dlambda (:write () (print "something"))))) (defun dlambda-many-named-methods () (call assertions :assert-equal '(lambda (&rest arguments) (case (first arguments) (:write1 (apply (lambda () (print "something")) (rest arguments))) (:write2 (apply (lambda () (print "something")) (rest arguments))) (:write3 (apply (lambda () (print "something")) (rest arguments))))) (dlambda (:write1 () (print "something")) (:write2 () (print "something")) (:write3 () (print "something"))))) (defun dlambda-named-and-default-method () (call assertions :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 () (call assertions :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 () (call assertions :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))))))) (setq tester (unit-tester tests)) (call tester :run)