79 lines
2.3 KiB
Common Lisp
79 lines
2.3 KiB
Common Lisp
(load "../unit/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)))))))
|