97 lines
3.2 KiB
Common Lisp
97 lines
3.2 KiB
Common Lisp
(load "../unit/unit-tester.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))
|