X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fsuite.lisp;h=5928227aa41a48b0a2ecb7e99450a903f1369807;hb=a3a3f45f2473649d64411e6e099c533c6c309fdd;hp=14427c64482c1807af0103ab7617ff0971a2f833;hpb=77155f18a3fd45a228f240599174098aa5751ce3;p=fiveam.git diff --git a/src/suite.lisp b/src/suite.lisp index 14427c6..5928227 100644 --- a/src/suite.lisp +++ b/src/suite.lisp @@ -1,6 +1,6 @@ ;; -*- lisp -*- -(in-package :it.bese.FiveAM) +(in-package :it.bese.fiveam) ;;;; * Test Suites @@ -42,20 +42,20 @@ Overides any existing suite named NAME." (when description (setf (description suite) description)) (loop for i in (ensure-list in) - for in-suite = (get-test i) - do (progn - (when (null in-suite) - (cerror "Create a new suite named ~A." "Unknown suite ~A." i) - (setf (get-test in-suite) (make-suite i) - in-suite (get-test in-suite))) - (setf (gethash name (tests in-suite)) suite))) + for in-suite = (get-test i) + do (progn + (when (null in-suite) + (cerror "Create a new suite named ~A." "Unknown suite ~A." i) + (setf (get-test in-suite) (make-suite i) + in-suite (get-test in-suite))) + (setf (gethash name (tests in-suite)) suite))) (setf (get-test name) suite) suite)) ;;;; ** Managing the Current Suite (defvar *suite* (setf (get-test 'NIL) - (make-suite 'NIL :description "Global Suite")) + (make-suite 'NIL :description "Global Suite")) "The current test suite object") (defmacro in-suite (suite-name) @@ -72,28 +72,28 @@ See also: DEF-SUITE *SUITE*" `(%in-suite ,suite-name :in ,in :fail-on-error nil)) (defmacro %in-suite (suite-name &key (fail-on-error t) in) - (with-unique-names (suite) + (with-gensyms (suite) `(progn - (if-bind ,suite (get-test ',suite-name) - (setf *suite* ,suite) - (progn - (when ,fail-on-error - (cerror "Create a new suite named ~A." - "Unkown suite ~A." ',suite-name)) - (setf (get-test ',suite-name) (make-suite ',suite-name :in ',in) - *suite* (get-test ',suite-name)))) + (if-let (,suite (get-test ',suite-name)) + (setf *suite* ,suite) + (progn + (when ,fail-on-error + (cerror "Create a new suite named ~A." + "Unkown suite ~A." ',suite-name)) + (setf (get-test ',suite-name) (make-suite ',suite-name :in ',in) + *suite* (get-test ',suite-name)))) ',suite-name))) ;; 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. @@ -101,7 +101,7 @@ See also: DEF-SUITE *SUITE*" ;; - 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