transcendental-lisp/lisp/lang/dlambda-test.lisp

(load "../unit/unit-tester.lisp")
(load "dlambda.lisp")

(setq assertions (unit-tester-assertions))

(setq tests
  (list

    (defun empty-dlambda ()
      (call assertions :assert-equal
       '(lambda (&rest arguments) (case (first arguments)))

        (dlambda)))

    (defun dlambda-default-method-only ()
      (call assertions :assert-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-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-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-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-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-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)))))))


(setq tester (unit-tester tests))
(call tester :run)