opening it up with Common Lisp

Favorite weblogs

Lisp Related

Bill Clementson

Finding Lisp


Planet Lisp



Talking Points Memo

This Modern World

Working for Change

Other home


Recent Readings

Book review: Darwinia
Reviewed: Friday, August 11, 2006

Summer reading: Spin
Reviewed: Saturday, August 5, 2006

Reviewed: Tuesday, July 18, 2006

the Omnivoire's Delimma
Reviewed: Wednesday, July 12, 2006

the Golem's Eye
Reviewed: Wednesday, May 31, 2006


ASDF and test systems or How I spent my Sunday afternoon
Saturday, January 14, 2006

(update: you should probably see this updated note)

I've been noodling around setting up tests for my ASDF systems. I'm using LIFT because that's my unit testing framework. here is an example system definition:

(defsystem moptilities-test
  :components ((:module "test"
                        :components ((:file "tests"))))
  :in-order-to ((test-op (load-op moptilities-test)))
  :depends-on (moptilities lift))

The only unusual part of the definition is the :in-order-to. It's a normal ASDF clause that can be read as "in order to perform test-op, first perform load-op on moptilities-test." ASDF already knows things like "in order to load, first compile" so that's why this clause isn't used all that often.

This definition seems OK but where do we run the tests? I've seen some systems write a custom perform method, as in:

(defmethod perform ((operation test-op)
                    (c (eql (find-system 'moptilities-test))))
   (funcall (intern "RUN-TESTS" "LIFT") 
            (intern "TEST-MOPTILITIES" "TEST-MOPTILITIES"))))

This does the trick but has to use that ugly funcall/intern thing. Worse yet, the perform method is only called the first time that one runs a test-op . An alternative to the funcall/intern bit is to put the call to run-tests in the tests.lisp file but this doesn't fix the one-time nature of perform. Generally speaking, we want ASDF to only do things once.. otherwise, we'd spend half of our lives recompiling code that hasn't changed. Testing, however, is a horse of a different color.

If we don't want to touch ASDF source code, we could add the following to our system definition file:

(defmethod asdf::traverse :around 
           ((operation test-op)
            (c (eql (find-system 'moptilities-test))))
  (let ((result (call-next-method))
        (perform-op (cons operation c)))
    (unless (find perform-op result :test #'equal)
      (setf result (append result (list perform-op))))
    (values result)))

Traverse is called by operate in order to figure out what needs to be done. Our :around method tells traverse to return what it usually would but also ensures that there is a call to perform the test-op on the system. We guard the append with the unless to make sure that we don't run the tests twice. Now that I had a solution, I looked a bit to find one that wasn't sure a hammer -- besides, it's bad form to mess with unexported methods!

At first, I tried messing with the times that ASDF records for when operations are performed. I thought that telling ASDF that test-ops were performed at time zero would suffice. This, however, was a dead end because ASDF also need to be told that the operation hasn't been done using the operation-done-p method. Thus, a simpler method for getting what I want is:

;; just my system
(defmethod operation-done-p 
           ((o test-op)
            (c (eql (find-system 'moptilities-test))))
  (values nil))
;; all test systems
(defmethod operation-done-p ((o test-op) (c system))
  (values nil))

This can either be just on my test-system (the first form) or on all test-systems (the second). My guess is that the latter is a good idea but there are probably other ways of getting tests set up so it is probably better to keep things local. My final system file (minus comments, package definitions and such) looks like:

(defsystem moptilities-test
  :components ((:module "test"
                        :components ((:file "tests"))))
  :in-order-to ((test-op (load-op moptilities-test)))
  :perform (test-op :after (op c)
                      (intern "RUN-TESTS" "LIFT") 
                      :suite (intern 
  :depends-on (moptilities lift))

(defmethod operation-done-p 
           ((o test-op)
            (c (eql (find-system 'moptilities-test))))
  (values nil))

and that's a pretty happy ending.


Home | About | Quotes | Recent | Archives

Copyright -- Gary Warren King, 2004 - 2006