(load "../unit/unit-tester.lisp") (load "dlambda.lisp") (setq assertions (unit-tester-assertions)) (setq tests (let ((arguments (gensym))) (list (defun empty-dlambda () (call assertions :assert-gensym-equal `(lambda (&rest ,arguments) (case (first ,arguments))) (dlambda))) (defun dlambda-default-method-only () (call assertions :assert-gensym-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-gensym-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-gensym-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-gensym-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-gensym-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-gensym-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)))))))) (call (unit-tester tests))