(load "unit-test.lisp")
(load "dlambda.lisp")

(defun test-dlambda ()

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

    )
  )

)