transcendental-lisp/lisp/dlambda-test.lisp

112 lines
2.6 KiB
Common Lisp
Raw Normal View History

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