Permalink
Browse files

Adds support for singleton fixtures.

  • Loading branch information...
1 parent 28d7f94 commit 66953a605572460ba1537506faed1d3d6ad71c6c @pjstadig committed Mar 12, 2013
Showing with 109 additions and 29 deletions.
  1. +67 −29 src/conjecture/core.clj
  2. +18 −0 test/conjecture/singleton_fixtures.clj
  3. +24 −0 test/conjecture/test/singleton_fixtures.clj
View
@@ -236,7 +236,8 @@
"}
conjecture.core
(:require [clojure.template :as temp]
- [clojure.stacktrace :as stack]))
+ [clojure.stacktrace :as stack])
+ (:import (java.io FileNotFoundException)))
;; Nothing is marked "private" here, so you can rebind things to plug
;; in your own testing or reporting frameworks.
@@ -676,6 +677,20 @@
(defmethod use-fixtures :once [fixture-type & args]
(add-ns-meta ::once-fixtures args))
+(defonce singleton-fixtures (atom []))
+(def ^:dynamic *singletons-run?* false)
+
+(defn load-singletons! []
+ (try
+ (require 'conjecture.singleton-fixtures)
+ (catch FileNotFoundException _)))
+
+(defn use-singleton-fixtures [& args]
+ (when-not (= (ns-name *ns*) 'conjecture.singleton-fixtures)
+ (throw (Exception. (str "Singletons fixtures may only be defined in the "
+ "conjecture.singleton-fixtures namespace"))))
+ (reset! singleton-fixtures args))
+
(defn- default-fixture
"The default, empty, fixture function. Just calls its argument."
{:added "0.1.0"}
@@ -705,6 +720,9 @@
;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS
+(defn singleton-fixture-fn []
+ (join-fixtures @singleton-fixtures))
+
(defn once-fixture-fn [ns]
(join-fixtures (::once-fixtures (meta ns))))
@@ -715,42 +733,61 @@
(def ^{:dynamic true} *each-fixtures* #{})
+(defmacro with-singleton-fixtures [& body]
+ `(let [f# (fn [] ~@body)]
+ (load-singletons!)
+ (if *singletons-run?*
+ (f#)
+ (let [fixtures# (singleton-fixture-fn)]
+ (binding [*singletons-run?* true]
+ (fixtures# f#))))))
+
+(defmacro with-once-fixtures [ns & body]
+ `(let [f# (fn [] ~@body)]
+ (if (contains? *once-fixtures* ~ns)
+ (f#)
+ (let [fixtures# (once-fixture-fn ~ns)]
+ (binding [*once-fixtures* (conj *once-fixtures* ~ns)]
+ (fixtures# f#))))))
+
+(defmacro with-each-fixtures [ns & body]
+ `(let [f# (fn [] ~@body)]
+ (if (contains? *each-fixtures* ~ns)
+ (f#)
+ (let [fixtures# (each-fixture-fn ~ns)]
+ (binding [*each-fixtures* (conj *each-fixtures* ~ns)]
+ (fixtures# f#))))))
+
(defn test-var
"If v has a function in its :test metadata, calls that function,
with *testing-vars* bound to (conj *testing-vars* v)."
{:dynamic true, :added "0.1.0"}
[v]
(let [ns (:ns (meta v))]
(when-let [t (:test (meta v))]
- (if (contains? *once-fixtures* ns)
- (if (contains? *each-fixtures* ns)
- (binding [*testing-vars* (conj *testing-vars* v)]
- (do-report {:type :begin-test-var, :var v})
- (inc-report-counter :test)
- (try (t)
- (catch Throwable e
- (do-report {:type :error,
- :message "Uncaught exception, not in assertion."
- :expected nil, :actual e})))
- (do-report {:type :end-test-var, :var v}))
- (let [fixtures (each-fixture-fn ns)]
- (binding [*each-fixtures* (conj *each-fixtures* ns)]
- (fixtures (fn [] (test-var v))))))
- (let [fixtures (once-fixture-fn ns)]
- (binding [*once-fixtures* (conj *once-fixtures* ns)]
- (fixtures (fn [] (test-var v)))))))))
+ (with-singleton-fixtures
+ (with-once-fixtures ns
+ (with-each-fixtures ns
+ (binding [*testing-vars* (conj *testing-vars* v)]
+ (do-report {:type :begin-test-var, :var v})
+ (inc-report-counter :test)
+ (try
+ (t)
+ (catch Throwable e
+ (do-report {:type :error,
+ :message "Uncaught exception, not in assertion."
+ :expected nil, :actual e})))
+ (do-report {:type :end-test-var, :var v}))))))))
(defn test-all-vars
"Calls test-var on every var interned in the namespace, with fixtures."
{:added "0.1.0"}
[ns]
- (if (contains? *once-fixtures* ns)
- (doseq [v (vals (ns-interns ns))]
- (when (:test (meta v))
- (test-var v)))
- (let [fixtures (once-fixture-fn ns)]
- (binding [*once-fixtures* (conj *once-fixtures* ns)]
- (fixtures (fn [] (test-all-vars ns)))))))
+ (with-singleton-fixtures
+ (with-once-fixtures ns
+ (doseq [v (vals (ns-interns ns))]
+ (when (:test (meta v))
+ (test-var v))))))
(defn test-ns
"If the namespace defines a function named test-ns-hook, calls that.
@@ -784,10 +821,11 @@
{:added "0.1.0"}
([] (run-tests *ns*))
([& namespaces]
- (let [summary (assoc (apply merge-with + (map test-ns namespaces))
- :type :summary)]
- (do-report summary)
- summary)))
+ (with-singleton-fixtures
+ (let [summary (assoc (apply merge-with + (map test-ns namespaces))
+ :type :summary)]
+ (do-report summary)
+ summary))))
(defn run-all-tests
"Runs all tests in all namespaces; prints results.
@@ -0,0 +1,18 @@
+;;;; Copyright © Paul Stadig. All rights reserved.
+;;;;
+;;;; The use and distribution terms for this software are covered by the Eclipse
+;;;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which
+;;;; can be found in the file epl-v10.html at the root of this distribution.
+;;;;
+;;;; By using this software in any fashion, you are agreeing to be bound by the
+;;;; terms of this license.
+;;;;
+;;;; You must not remove this notice, or any other, from this software.
+(ns conjecture.singleton-fixtures
+ (:use conjecture.core))
+
+(def called (atom 0))
+
+(use-singleton-fixtures (fn [f]
+ (swap! called inc)
+ (f)))
@@ -0,0 +1,24 @@
+;;;; Copyright © Paul Stadig. All rights reserved.
+;;;;
+;;;; The use and distribution terms for this software are covered by the Eclipse
+;;;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which
+;;;; can be found in the file epl-v10.html at the root of this distribution.
+;;;;
+;;;; By using this software in any fashion, you are agreeing to be bound by the
+;;;; terms of this license.
+;;;;
+;;;; You must not remove this notice, or any other, from this software.
+(ns conjecture.test.singleton-fixtures
+ (:require [conjecture.test.core]
+ [conjecture.test.fixtures])
+ (:use [conjecture.core])
+ (:import (java.io PrintWriter StringWriter)))
+
+(deftest test-singleton-fixtures
+ (is (= 1 @conjecture.singleton-fixtures/called)))
+
+(defn test-ns-hook []
+ (binding [*test-out* (PrintWriter. (StringWriter.))]
+ (run-tests 'conjecture.test.core)
+ (run-tests 'conjecture.test.fixtures))
+ (test-all-vars 'conjecture.test.singleton-fixtures))

0 comments on commit 66953a6

Please sign in to comment.