X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Ffixture.lisp;h=26e993304fd95518bddc0813b8f66deb70832e01;hb=35dc0e063d9f601afdc1202e4724628525e723f0;hp=a3de037d246b5d95a2bb286ca056181e1ef1021e;hpb=1b24abf09e9fbb2a23c25a9583e5547514482f1b;p=fiveam.git diff --git a/src/fixture.lisp b/src/fixture.lisp index a3de037..26e9933 100644 --- a/src/fixture.lisp +++ b/src/fixture.lisp @@ -1,6 +1,6 @@ ;; -*- lisp -*- -(in-package :it.bese.FiveAM) +(in-package :it.bese.fiveam) ;;;; ** Fixtures @@ -13,11 +13,21 @@ ;;;; 'fixture' is so common in testing frameworks we've provided a ;;;; wrapper around defmacro for this purpose. -(deflookup-table fixture - :documentation "Lookup table mapping fixture names to fixture +(defvar *fixture* + (make-hash-table :test 'eql) + "Lookup table mapping fixture names to fixture objects.") -(defmacro def-fixture (name args &body body) +(defun get-fixture (key &optional default) + (gethash key *fixture* default)) + +(defun (setf get-fixture) (value key) + (setf (gethash key *fixture*) value)) + +(defun rem-fixture (key) + (remhash key *fixture*)) + +(defmacro def-fixture (name (&rest args) &body body) "Defines a fixture named NAME. A fixture is very much like a macro but is used only for simple templating. A fixture created with DEF-FIXTURE is a macro which can use the special macrolet @@ -29,16 +39,17 @@ See Also: WITH-FIXTURE (setf (get-fixture ',name) (cons ',args ',body)) ',name)) -(defmacro with-fixture (fixture-name args &body body) +(defmacro with-fixture (fixture-name (&rest args) &body body) "Insert BODY into the fixture named FIXTURE-NAME. See Also: DEF-FIXTURE" (assert (get-fixture fixture-name) (fixture-name) "Unknown fixture ~S." fixture-name) - (destructuring-bind (largs &rest lbody) (get-fixture fixture-name) + (destructuring-bind ((&rest largs) &rest lbody) + (get-fixture fixture-name) `(macrolet ((&body () '(progn ,@body))) - (funcall (lambda ,largs ,@lbody) ,@args)))) + (funcall (lambda (,@largs) ,@lbody) ,@args)))) ;; Copyright (c) 2002-2003, Edward Marco Baringer ;; All rights reserved.