X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Ftest.lisp;h=a8269c699dff7a639a6dbdd62bece8f2f9ff557c;hb=c7667c4ac1b77d7128e4c43da8f1997ea24d8921;hp=aacb11e8236f61520c961a889526cfa46cc51362;hpb=ea7021b8bc505e45fff8d226d8ab7fce6cae0f76;p=fiveam.git diff --git a/src/test.lisp b/src/test.lisp index aacb11e..a8269c6 100644 --- a/src/test.lisp +++ b/src/test.lisp @@ -1,21 +1,30 @@ -;; -*- lisp -*- +;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- -(in-package :it.bese.FiveAM) +(in-package :it.bese.fiveam) ;;;; * Tests ;;;; While executing checks and collecting the results is the core job ;;;; of a testing framework it is also important to be able to -;;;; organize checks into groups, FiveAM provides two mechanisms for +;;;; organize checks into groups, fiveam provides two mechanisms for ;;;; organizing checks: tests and test suites. A test is a named ;;;; collection of checks which can be run and a test suite is a named ;;;; collection of tests and test suites. -(deflookup-table test - :at-redefinition nil - :documentation "Lookup table mapping test (and test suite) +(defvar *test* + (make-hash-table :test 'eql) + "Lookup table mapping test (and test suite) names to objects.") +(defun get-test (key &optional default) + (gethash key *test* default)) + +(defun (setf get-test) (value key) + (setf (gethash key *test*) value)) + +(defun rem-test (key) + (remhash key *test*)) + (defun test-names () (loop for test being the hash-keys of *test* collect test)) @@ -67,20 +76,21 @@ If PROFILE is T profiling information will be collected as well." `((with-fixture ,name ,args ,@body))) body))) `(progn - (setf (get-test ',name) (make-instance 'test-case - :name ',name - :runtime-package ,*package* - :test-lambda - (lambda () - ,@ (ecase compile-at - (:run-time `((funcall - (let ((*package* (find-package ',(package-name *package*)))) - (compile nil '(lambda () - ,@effective-body)))))) - (:definition-time effective-body))) - :description ,description - :depends-on ',depends-on - :collect-profiling-info ,profile)) + (setf (get-test ',name) + (make-instance 'test-case + :name ',name + :runtime-package (find-package ,(package-name *package*)) + :test-lambda + (lambda () + ,@ (ecase compile-at + (:run-time `((funcall + (let ((*package* (find-package ',(package-name *package*)))) + (compile nil '(lambda () + ,@effective-body)))))) + (:definition-time effective-body))) + :description ,description + :depends-on ',depends-on + :collect-profiling-info ,profile)) (setf (gethash ',name (tests ,suite-form)) ',name) (when *run-test-when-defined* (run! ',name)) @@ -90,15 +100,15 @@ If PROFILE is T profiling information will be collected as well." "When non-NIL tests are run as soon as they are defined.") ;; Copyright (c) 2002-2003, Edward Marco Baringer -;; All rights reserved. -;; +;; All rights reserved. +;; ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions are ;; met: -;; +;; ;; - Redistributions of source code must retain the above copyright ;; notice, this list of conditions and the following disclaimer. -;; +;; ;; - Redistributions in binary form must reproduce the above copyright ;; notice, this list of conditions and the following disclaimer in the ;; documentation and/or other materials provided with the distribution. @@ -106,7 +116,7 @@ If PROFILE is T profiling information will be collected as well." ;; - Neither the name of Edward Marco Baringer, nor BESE, nor the names ;; of its contributors may be used to endorse or promote products ;; derived from this software without specific prior written permission. -;; +;; ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR