Permalink
Browse files

fix shuffle, make c.t/is play nice in generative tests

  • Loading branch information...
stuarthalloway committed Aug 24, 2012
1 parent d1aeae8 commit 1afc5a6befa1e92dbad22ca336a1188b37d6bd11
@@ -1,88 +0,0 @@
-; Copyright (c) Rich Hickey, Stuart Halloway, and contributors.
-; 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 clojure.test.generative.clojure-test-adapter
- (:require [clojure.test.generative.event :as event]
- [clojure.test.generative.config :as config]
- [clojure.test.generative.io :as testio]
- [clojure.tools.namespace :as ns]
- [clojure.test :as ctest]))
-
-(defmulti ctevent->event
- "Convert a clojure.test reporting event to an event."
- :type)
-
-(defmethod ctevent->event :default
- [e]
- (event/create :clojure.test/unknown e))
-
-(defmethod ctevent->event :pass
- [e]
- (event/create :type :assert/pass))
-
-(defmethod ctevent->event :fail
- [e]
- (event/create :type :assert/fail
- :level :warn
- :message (:message e)
- :test/actual (:actual e)
- :test/expected (:expected e)
- :file (:file e)
- :line (:line e)
- ::ctest/contexts (seq ctest/*testing-contexts*)
- ::ctest/vars (reverse (map #(:name (meta %)) ctest/*testing-vars*))))
-
-(defmethod ctevent->event :error
- [e]
- (event/create :level :error
- :type :error
- ::ctest/contexts (seq ctest/*testing-contexts*)
- :message (:message e)
- :test/expected (:expected e)
- :exception (:actual e)
- :file (:file e)
- :line (:line e)
- ::ctest/vars (reverse (map #(:name (meta %)) ctest/*testing-vars*))))
-
-(defmethod ctevent->event :summary
- [e]
- nil)
-
-(defmethod ctevent->event :begin-test-ns
- [e]
- (event/create :type :test/group
- :tags #{:begin}
- :name (ns-name (:ns e))))
-
-(defmethod ctevent->event :end-test-ns
- [e]
- (event/create :type :test/group
- :tags #{:end}
- :name (ns-name (:ns e))))
-
-(defmethod ctevent->event :begin-test-var
- [e]
- (event/create :type :test/test
- :tags #{:begin}
- :name (event/fqname (:var e))))
-
-(defmethod ctevent->event :end-test-var
- [e]
- (event/create :type :test/test
- :tags #{:end}
- :name (event/fqname (:var e))))
-
-(defn report-adapter
- "Adapt clojure.test event model to fire c.t.g events."
- [m]
- (when-let [e (ctevent->event m)]
- (event/report-fn e)))
-
-
-
@@ -277,7 +277,7 @@ instance you can get a repeatable basis for tests."
(defn shuffle
"Shuffle coll"
[coll]
- (sort-by double coll))
+ (sort-by (fn [_] (long)) coll))
@@ -63,7 +63,7 @@
(comment
(require :reload '[clojure.test.generative.event :as event])
(require :reload '[clojure.test.generative.event.logback :as la])
- (in-ns 'clojure.test.generative.event.logback-adapter)
+ (in-ns 'clojure.test.generative.event.logback)
(set! *warn-on-reflection* true)
(def l (LoggerFactory/getLogger "stu"))
(.info l "hi")
@@ -16,11 +16,90 @@
[clojure.test.generative.event :as event]
[clojure.test.generative.generators :as gen]
[clojure.test.generative.io :as io]
- [clojure.test.generative.clojure-test-adapter :as cta]
[clojure.test :as ctest]))
(set! *warn-on-reflection* true)
+;; non-nil binding means running inside the framework
+(def ^:dynamic *failed* nil)
+
+(defn failed!
+ "Tell the runner that a test failed"
+ []
+ (when *failed*
+ (deliver *failed* :failed)))
+
+(defmulti ctevent->event
+ "Convert a clojure.test reporting event to an event."
+ :type)
+
+(defmethod ctevent->event :default
+ [e]
+ (event/create :clojure.test/unknown e))
+
+(defmethod ctevent->event :pass
+ [e]
+ (event/create :type :assert/pass))
+
+(defmethod ctevent->event :fail
+ [e]
+ (failed!)
+ (event/create :type :assert/fail
+ :level :warn
+ :message (:message e)
+ :test/actual (:actual e)
+ :test/expected (:expected e)
+ :file (:file e)
+ :line (:line e)
+ ::ctest/contexts (seq ctest/*testing-contexts*)
+ ::ctest/vars (reverse (map #(:name (meta %)) ctest/*testing-vars*))))
+
+(defmethod ctevent->event :error
+ [e]
+ (event/create :level :error
+ :type :error
+ ::ctest/contexts (seq ctest/*testing-contexts*)
+ :message (:message e)
+ :test/expected (:expected e)
+ :exception (:actual e)
+ :file (:file e)
+ :line (:line e)
+ ::ctest/vars (reverse (map #(:name (meta %)) ctest/*testing-vars*))))
+
+(defmethod ctevent->event :summary
+ [e]
+ nil)
+
+(defmethod ctevent->event :begin-test-ns
+ [e]
+ (event/create :type :test/group
+ :tags #{:begin}
+ :name (ns-name (:ns e))))
+
+(defmethod ctevent->event :end-test-ns
+ [e]
+ (event/create :type :test/group
+ :tags #{:end}
+ :name (ns-name (:ns e))))
+
+(defmethod ctevent->event :begin-test-var
+ [e]
+ (event/create :type :test/test
+ :tags #{:begin}
+ :name (event/fqname (:var e))))
+
+(defmethod ctevent->event :end-test-var
+ [e]
+ (event/create :type :test/test
+ :tags #{:end}
+ :name (event/fqname (:var e))))
+
+(defn ct-adapter
+ "Adapt clojure.test event model to fire c.t.g events."
+ [m]
+ (when-let [e (ctevent->event m)]
+ (event/report-fn e)))
+
(defprotocol Test
(test-name [_])
(test-fn [_])
@@ -41,9 +120,6 @@
[v]
(map #(%) (:clojure.test.generative/inputs (meta v)))))
-;; non-nil binding means running inside the framework
-(def ^:dynamic *failed* nil)
-
(defn run-iter
"Run a single test iteration"
[test]
@@ -99,12 +175,6 @@
(doseq [test tests]
(run-for test nthreads test-msec))))
-(defn failed!
- "Tell the runner that a test failed"
- []
- (when *failed*
- (deliver *failed* :failed)))
-
#_(defn set-seed
[n]
(set! gen/*rnd* (java.util.Random. n)))
@@ -160,24 +230,24 @@
(defn run-all-tests
"Run generative tests and clojure.test tests"
[nses threads msec]
- (let [run-with-counts
- (fn [lib f]
- (let [event-counts (atom {})
- event-counter #(when-not (contains? (:tags %) :begin)
- (when-let [type (:type %)]
- (swap! event-counts update-in [type] (fnil inc 0))))]
- (event/report :test/library :name lib)
- (event/with-handler event-counter (f))
- @event-counts))
- ct-results (run-with-counts 'clojure.test
- #(binding [ctest/report cta/report-adapter]
- (when-let [ctnses (seq (filter has-clojure-test-tests? nses))]
- (apply ctest/run-tests ctnses))))
- ctg-results (run-with-counts 'clojure.test.generative
- #(run-generative-tests nses threads msec))]
- (io/await)
- {'clojure.test ct-results
- 'clojure.test.generative ctg-results}))
+ (binding [ctest/report ct-adapter]
+ (let [run-with-counts
+ (fn [lib f]
+ (let [event-counts (atom {})
+ event-counter #(when-not (contains? (:tags %) :begin)
+ (when-let [type (:type %)]
+ (swap! event-counts update-in [type] (fnil inc 0))))]
+ (event/report :test/library :name lib)
+ (event/with-handler event-counter (f))
+ @event-counts))
+ ct-results (run-with-counts 'clojure.test
+ #(when-let [ctnses (seq (filter has-clojure-test-tests? nses))]
+ (apply ctest/run-tests ctnses)))
+ ctg-results (run-with-counts 'clojure.test.generative
+ #(run-generative-tests nses threads msec))]
+ (io/await)
+ {'clojure.test ct-results
+ 'clojure.test.generative ctg-results})))
(defn failed?
[result]
@@ -1,6 +1,6 @@
(ns clojure.test.generative.generators-test
(:use clojure.test.generative
- [clojure.test :only (deftest)])
+ [clojure.test :only (deftest) :as ct])
(:require [clojure.test.generative.generators :as gen]))
(defspec test-repeatable-generation
@@ -22,3 +22,7 @@
(is (= (+ (count longs) (count bools))
(count %)))))
+(defspec test-shuffle
+ gen/shuffle
+ [^{:tag (vec long)} input]
+ (is (= (sort input) (sort %))))

0 comments on commit 1afc5a6

Please sign in to comment.