-;; -*- lisp -*-
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
(defpackage :it.bese.FiveAM.system
(:use :common-lisp
;;;; ** Types of test results
-;;;; Every check produces a result object.
+;;;; Every check produces a result object.
(defclass test-result ()
((reason :accessor reason :initarg :reason :initform "no reason given")
(defmacro process-failure (&rest args)
`(progn
- (with-simple-restart (ignore-failure "Continue the test run.")
- (error 'check-failure ,@args))
- (add-result 'test-failure ,@args)))
+ (with-simple-restart (ignore-failure "Continue the test run.")
+ (error 'check-failure ,@args))
+ (add-result 'test-failure ,@args)))
(defclass test-failure (test-result)
()
(let ((result (apply #'make-instance result-type
(append make-instance-args (list :test-case current-test)))))
(etypecase result
- (test-passed (format *test-dribble* "."))
+ (test-passed (format *test-dribble* "."))
(unexpected-test-failure (format *test-dribble* "X"))
- (test-failure (format *test-dribble* "f"))
- (test-skipped (format *test-dribble* "s")))
+ (test-failure (format *test-dribble* "f"))
+ (test-skipped (format *test-dribble* "s")))
(push result result-list))))
;;;; ** The check operators
(setf bindings (list (list e expected)
(list a actual))))
(setf effective-test `(progn
- ,@setf-forms
- ,(if negatedp
- `(not (,predicate ,e ,a))
- `(,predicate ,e ,a)))))))
+ ,@setf-forms
+ ,(if negatedp
+ `(not (,predicate ,e ,a))
+ `(,predicate ,e ,a)))))))
(list-match-case test
((not (?predicate ?expected ?actual))
(process-entry ?predicate ?expected ?actual t)
"The input is either a list of lists, or a list of pairs. Generates (is (,predicate ,expr ,value))
for each pair of elements or (is (,predicate ,expr ,value) ,@reason) for each list."
`(progn
- ,@(if (every #'consp clauses)
- (loop for (expected actual . reason) in clauses
- collect `(is (,predicate ,expected ,actual) ,@reason))
- (progn
- (assert (evenp (list-length clauses)))
- (loop for (expr value) on clauses by #'cddr
- collect `(is (,predicate ,expr ,value)))))))
+ ,@(if (every #'consp clauses)
+ (loop for (expected actual . reason) in clauses
+ collect `(is (,predicate ,expected ,actual) ,@reason))
+ (progn
+ (assert (evenp (list-length clauses)))
+ (loop for (expr value) on clauses by #'cddr
+ collect `(is (,predicate ,expr ,value)))))))
(defmacro is-true (condition &rest reason-args)
"Like IS this check generates a pass if CONDITION returns true
does not inspect CONDITION to determine how to report the
failure."
`(if ,condition
- (add-result 'test-passed :test-expr ',condition)
- (process-failure
- :reason ,(if reason-args
- `(format nil ,@reason-args)
- `(format nil "~S did not return a true value" ',condition))
- :test-expr ',condition)))
+ (add-result 'test-passed :test-expr ',condition)
+ (process-failure
+ :reason ,(if reason-args
+ `(format nil ,@reason-args)
+ `(format nil "~S did not return a true value" ',condition))
+ :test-expr ',condition)))
(defmacro is-false (condition &rest reason-args)
"Generates a pass if CONDITION returns false, generates a
(handler-bind ((,condition (lambda (c)
(declare (ignore c))
;; ok, body threw condition
- (add-result 'test-passed
+ (add-result 'test-passed
:test-expr ',condition)
(return-from ,block-name t))))
(block nil
fails."
`(let ((ok nil))
(unwind-protect
- (progn
- ,@body
- (setf ok t))
+ (progn
+ ,@body
+ (setf ok t))
(if ok
- (add-result 'test-passed :test-expr ',body)
+ (add-result 'test-passed :test-expr ',body)
(process-failure
:reason (format nil "Test didn't finish")
:test-expr ',body)))))
(defmacro pass (&rest message-args)
"Simply generate a PASS."
- `(add-result 'test-passed
+ `(add-result 'test-passed
:test-expr ',message-args
,@(when message-args
`(:reason (format nil ,@message-args)))))
`(:reason (format nil ,@message-args)))))
;; 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.
;; - 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
(in-package :it.bese.FiveAM)
(defclass testable-object ()
- ((name :initarg :name :accessor name
- :documentation "A symbol naming this test object.")
+ ((name :initarg :name :accessor name
+ :documentation "A symbol naming this test object.")
(description :initarg :description :accessor description :initform nil
- :documentation "The textual description of this test object.")
+ :documentation "The textual description of this test object.")
(depends-on :initarg :depends-on :accessor depends-on :initform nil
- :documentation "The list of AND, OR, NOT forms specifying when to run this test.")
+ :documentation "The list of AND, OR, NOT forms specifying when to run this test.")
(status :initarg :status :accessor status :initform :unknown
- :documentation "A symbol specifying the current status
+ :documentation "A symbol specifying the current status
of this test. Either: T - this test (and all its
dependencies, have passed. NIL - this test
failed (either it failed or its dependecies weren't
(defclass test-suite (testable-object)
((tests :accessor tests :initform (make-hash-table :test 'eql)
- :documentation "The hash table mapping names to test
+ :documentation "The hash table mapping names to test
objects in this suite. The values in this hash table
can be either test-cases or other test-suites."))
(:documentation "A test suite is a collection of tests or test suites.
(defclass test-case (testable-object)
((test-lambda :initarg :test-lambda :accessor test-lambda
- :documentation "The function to run.")
+ :documentation "The function to run.")
(runtime-package :initarg :runtime-package :accessor runtime-package
:documentation "By default it stores *package* from the time this test was defined (macroexpanded)."))
(:documentation "A test case is a single, named, collection of
())
;; 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.
;; - 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
(defmethod explain ((exp detailed-text-explainer) results
&optional (stream *test-dribble*) (recursive-depth 0))
#| "Given a list of test results report write to stream detailed
- human readable statistics regarding the results." |#
+ human readable statistics regarding the results." |#
(multiple-value-bind (num-checks passed num-passed passed%
- skipped num-skipped skipped%
- failed num-failed failed%
- unknown num-unknown unknown%)
+ skipped num-skipped skipped%
+ failed num-failed failed%
+ unknown num-unknown unknown%)
(partition-results results)
(declare (ignore passed))
(flet ((output (&rest format-args)
(format stream "~&~vT" recursive-depth)
(apply #'format stream format-args)))
-
+
(when (zerop num-checks)
(output "Didn't run anything...huh?")
(return-from explain nil))
(output "Failure Details:~%")
(dolist (f (reverse failed))
(output "--------------------------------~%")
- (output "~A ~@{[~A]~}: ~%"
+ (output "~A ~@{[~A]~}: ~%"
(name (test-case f))
(description (test-case f)))
(output " ~A.~%" (reason f))
(when skipped
(output "Skip Details:~%")
(dolist (f skipped)
- (output "~A ~@{[~A]~}: ~%"
+ (output "~A ~@{[~A]~}: ~%"
(name (test-case f))
(description (test-case f)))
(output " ~A.~%" (reason f)))
(defmethod explain ((exp simple-text-explainer) results
&optional (stream *test-dribble*) (recursive-depth 0))
(multiple-value-bind (num-checks passed num-passed passed%
- skipped num-skipped skipped%
- failed num-failed failed%
- unknown num-unknown unknown%)
+ skipped num-skipped skipped%
+ failed num-failed failed%
+ unknown num-unknown unknown%)
(partition-results results)
(declare (ignore passed passed% skipped skipped% failed failed% unknown unknown%))
(format stream "~&~vTRan ~D checks, ~D passed" recursive-depth num-checks num-passed)
(defun partition-results (results-list)
(let ((num-checks (length results-list)))
(destructuring-bind (passed skipped failed unknown)
- (partitionx results-list
- (lambda (res)
- (typep res 'test-passed))
- (lambda (res)
- (typep res 'test-skipped))
- (lambda (res)
- (typep res 'test-failure))
- t)
+ (partitionx results-list
+ (lambda (res)
+ (typep res 'test-passed))
+ (lambda (res)
+ (typep res 'test-skipped))
+ (lambda (res)
+ (typep res 'test-failure))
+ t)
(if (zerop num-checks)
- (values 0
- nil 0 0
- nil 0 0
- nil 0 0
- nil 0 0)
- (values
- num-checks
- passed (length passed) (floor (* 100 (/ (length passed) num-checks)))
- skipped (length skipped) (floor (* 100 (/ (length skipped) num-checks)))
- failed (length failed) (floor (* 100 (/ (length failed) num-checks)))
- unknown (length unknown) (floor (* 100 (/ (length failed) num-checks))))))))
+ (values 0
+ nil 0 0
+ nil 0 0
+ nil 0 0
+ nil 0 0)
+ (values
+ num-checks
+ passed (length passed) (floor (* 100 (/ (length passed) num-checks)))
+ skipped (length skipped) (floor (* 100 (/ (length skipped) num-checks)))
+ failed (length failed) (floor (* 100 (/ (length failed) num-checks)))
+ unknown (length unknown) (floor (* 100 (/ (length failed) num-checks))))))))
;; 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.
;; - 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
(funcall (lambda ,largs ,@lbody) ,@args))))
;; 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.
;; - 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
(defpackage :it.bese.FiveAM
(:use :common-lisp :it.bese.arnesi)
(:nicknames :5am :fiveam)
- (:export ;; creating tests and test-suites
- #:make-suite
- #:def-suite
- #:in-suite
- #:in-suite*
- #:make-test
- #:test
- #:get-test
- #:rem-test
- #:test-names
- ;; fixtures
- #:make-fixture
- #:def-fixture
- #:with-fixture
- #:get-fixture
- #:rem-fixture
- ;; running checks
- #:is
- #:is-every
- #:is-true
- #:is-false
- #:signals
- #:finishes
- #:skip
- #:pass
- #:fail
- #:*test-dribble*
- #:for-all
- #:gen-integer
- #:gen-float
- #:gen-character
- #:gen-string
- #:gen-list
- #:gen-tree
- #:gen-buffer
- #:gen-one-element
- ;; running tests
- #:run
- #:run-all-tests
- #:explain
- #:explain!
- #:run!
- #:debug!
- #:!
- #:!!
- #:!!!
- #:*run-test-when-defined*
- #:*debug-on-error*
- #:*debug-on-failure*
- #:*verbose-failures*
- #:results-status))
+ (:export
+ ;; creating tests and test-suites
+ #:make-suite
+ #:def-suite
+ #:in-suite
+ #:in-suite*
+ #:make-test
+ #:test
+ #:get-test
+ #:rem-test
+ #:test-names
+ ;; fixtures
+ #:make-fixture
+ #:def-fixture
+ #:with-fixture
+ #:get-fixture
+ #:rem-fixture
+ ;; running checks
+ #:is
+ #:is-every
+ #:is-true
+ #:is-false
+ #:signals
+ #:finishes
+ #:skip
+ #:pass
+ #:fail
+ #:*test-dribble*
+ #:for-all
+ #:gen-integer
+ #:gen-float
+ #:gen-character
+ #:gen-string
+ #:gen-list
+ #:gen-tree
+ #:gen-buffer
+ #:gen-one-element
+ ;; running tests
+ #:run
+ #:run-all-tests
+ #:explain
+ #:explain!
+ #:run!
+ #:debug!
+ #:!
+ #:!!
+ #:!!!
+ #:*run-test-when-defined*
+ #:*debug-on-error*
+ #:*debug-on-failure*
+ #:*verbose-failures*
+ #:results-status))
;;;; You can use #+5am to put your test-defining code inline with your
;;;; other code - and not require people to have fiveam to run your
;;;; ** COPYRIGHT
;;;; 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.
;;;; - 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
(throw 'run-once
(list :guard-conditions-failed))))))))
-;;;; *** Implementation
+;;;; *** Implementation
;;;; We could just make FOR-ALL a monster macro, but having FOR-ALL be
;;;; a preproccessor for the perform-random-testing function is
(double-float most-positive-double-float)
(long-float most-positive-long-float)))
(bound (or bound (max most-positive (- most-negative)))))
- (coerce
+ (coerce
(ecase (random 2)
(0 ;; generate a positive number
(random (min most-positive bound)))
(defun import-testing-symbols (package-designator)
(import '(5am::is 5am::is-true 5am::is-false 5am::signals 5am::finishes)
- package-designator))
+ package-designator))
(defparameter *run-queue* '()
"List of test waiting to be run.")
:test-case test
:reason "Dependencies not satisfied")
result-list)
- (setf (status test) :depends-not-satisfied)))))
+ (setf (status test) :depends-not-satisfied)))))
(:resolving
(restart-case
(error 'circular-dependency :test-case test)
(skip ()
- :report (lambda (s)
- (format s "Skip the test ~S and all its dependencies." (name test)))
- (with-run-state (result-list)
- (push (make-instance 'test-skipped :reason "Circular dependencies" :test-case test)
- result-list))
- (setf (status test) :circular))))
+ :report (lambda (s)
+ (format s "Skip the test ~S and all its dependencies." (name test)))
+ (with-run-state (result-list)
+ (push (make-instance 'test-skipped :reason "Circular dependencies" :test-case test)
+ result-list))
+ (setf (status test) :circular))))
(t (status test))))
(defmethod resolve-dependencies ((depends-on symbol))
(if (null depends-on)
t
(flet ((satisfies-depends-p (test)
- (funcall test (lambda (dep)
- (eql t (resolve-dependencies dep)))
- (cdr depends-on))))
- (ecase (car depends-on)
- (and (satisfies-depends-p #'every))
- (or (satisfies-depends-p #'some))
- (not (satisfies-depends-p #'notany))
+ (funcall test (lambda (dep)
+ (eql t (resolve-dependencies dep)))
+ (cdr depends-on))))
+ (ecase (car depends-on)
+ (and (satisfies-depends-p #'every))
+ (or (satisfies-depends-p #'some))
+ (not (satisfies-depends-p #'notany))
(:before (every #'(lambda (dep)
(let ((status (status (get-test dep))))
(eql :unknown status)))
- (cdr depends-on)))))))
+ (cdr depends-on)))))))
(defun results-status (result-list)
"Given a list of test results (generated while running a test)
return true if all of the results are of type TEST-PASSED,
faile otherwise."
(every (lambda (res)
- (typep res 'test-passed))
- result-list))
+ (typep res 'test-passed))
+ result-list))
(defun return-result-list (test-lambda)
"Run the test function TEST-LAMBDA and return a list of all
test results generated, does not modify the special environment
variable RESULT-LIST."
- (bind-run-state ((result-list '()))
+ (bind-run-state ((result-list '()))
(funcall test-lambda)
result-list))
(defgeneric %run (test-spec)
(:documentation "Internal method for running a test. Does not
- update the status of the tests nor the special vairables !,
+ update the status of the tests nor the special variables !,
!!, !!!"))
(defmethod %run ((test test-case))
*!!!* *!!*)
(funcall *!*))
-(defun ! ()
+(defun ! ()
"Rerun the most recently run test and explain the results."
(explain! (funcall *!*)))
-(defun !! ()
+(defun !! ()
"Rerun the second most recently run test and explain the results."
(explain! (funcall *!!*)))
-
+
(defun !!! ()
"Rerun the third most recently run test and explain the results."
(explain! (funcall *!!!*)))
;; 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.
;; - 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
(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)
(with-unique-names (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))))
+ (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.
;; - 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
;;;; 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.
`((with-fixture ,name ,args ,@body)))
body)))
`(progn
- (setf (get-test ',name) (make-instance 'test-case
- :name ',name
- :runtime-package
- #-ecl ,*package*
- #+ecl (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 (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))
"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.
;; - 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
projects / fiveam.git / commitdiff