If I try to check a macro spec with clojure.spec.test.alpha, no tests are run, but if I define the same macro as a function with the same spec, a sequence of tests are run against the function. I can always generate parameters to unit test the macro, but is there a way to get that for free with spec? Here is an example:
(ns private.tmp.spec-test
(:require [clojure.spec.alpha :as spec]
[clojure.spec.test.alpha :as stest]))
;;; Macro
(defmacro twice' [x]
`(* 2.0 ~x))
(spec/fdef twice'
:args (spec/cat :x double?)
:ret double?
:fn (fn [{{:keys [x]} :args, x2 :ret}]
(or (and
(Double/isNaN x)
(Double/isNaN x2))
(= x2 (+ x x)))))
(println (stest/summarize-results (stest/check `twice'))) ;; {:total 0}
;;; Function
(defn twice [x]
(* 2.0 x))
(spec/fdef twice
:args (spec/cat :x double?)
:ret double?
:fn (fn [{{:keys [x]} :args, x2 :ret}]
(or (and
(Double/isNaN x)
(Double/isNaN x2))
(= x2 (+ x x)))))
(println (stest/summarize-results (stest/check `twice))) ;; {:total 1, :check-passed 1}
I asked this question on the Clojure, Google Group and the consensus is that checking macros is not supported. The preferred method of testing is by generating params for unit tests by test.check.
https://groups.google.com/forum/#!topic/clojure/RxnwKcha0cE
Related
I've been struggling to create a macro that'll allow me to dynamically bind whatever is in the &env into a binding form and then delegate to a pry like function to open a REPL that can see those bound &env symbols.
My simplistic pry func, which works as expected
(defn pry []
(print (str "pry(" *ns* ")> "))
(flush)
(let [expr (read)]
(when-not (= expr :exit)
(println (eval expr))
(recur))))
Using the pry func:
clojure-noob.core=> (def a 1)
#'clojure-noob.core/a
clojure-noob.core=> (pry)
pry(clojure-noob.core)> (+ a 1)
2
pry(clojure-noob.core)> :exit
nil
clojure-noob.core=>
My attempt at creating a dynamic invocation of binding:
(defmacro binding-pry []
(let [ks (keys &env)]
`(let [ks# '~ks
vs# [~#ks]
bs# (vec (interleave ks# vs#))]
(binding bs# (pry)))))
However, this fails because the inner symbol bs# is not expanded to an actual vector but instead is the generated symbol and binding tosses a clojure.core/binding requires a vector for its binding exception.
clojure-noob.core=> (let [a 1 b 2] (binding-pry))
Syntax error macroexpanding clojure.core/binding at (/tmp/form-init14332359378145135257.clj:1:16).
clojure.core/binding requires a vector for its binding in clojure-noob.core:
clojure-noob.core=>
The code quoted form with a debug print, the bs# symbol is resolved when printing but I don't know how to make it resolve to a vector when constructing the binding form.
(defmacro binding-pry []
(let [ks (keys &env)]
`(let [ks# '~ks
vs# [~#ks]
bs# (vec (interleave ks# vs#))]
(println bs#)
`(binding bs# (pry)))))
clojure-noob.core=> (let [a 1 b 2] (binding-pry))
[a 1 b 2]
(clojure.core/binding clojure-noob.core/bs__2464__auto__ (clojure-noob.core/pry))
clojure-noob.core=>
I'm very confident I'm tackling this incorrectly but I don't see another approach.
The Joy of Clojure demonstrates a break macro that does this already. I can't reproduce its source here, because it's EPL and not CC. But you can see its source at https://github.com/joyofclojure/book-source/blob/b76ef15/first-edition/src/joy/breakpoint.clj. It refers to a contextual-eval function as well: https://github.com/joyofclojure/book-source/blob/b76ef15/first-edition/src/joy/macros.clj#L4-L7.
A first step towards improving your attempt could be writing:
(defmacro binding-pry []
(let [ks (keys &env)]
`(binding [~#(interleave ks ks)] (pry))))
This still doesn't work because binding expects that the symbols can be resolved to existing dynamic vars. To tackle this problem you could make binding-pry introduce such vars as shown below:
(defmacro binding-pry []
(let [ks (keys &env)]
`(do
~#(map (fn [k] `(def ~(with-meta k {:dynamic true}))) ks)
(binding [~#(interleave ks ks)] (pry)))))
But this can have undesirable side-effects, like polluting the namespace with new var-names or making existing vars dynamic. So I would prefer an approach like the one mentioned in amalloy's answer but with a better implementation of eval-in-context (see my comment there).
To write a self-contained answer based on your pry function, let's first define eval-in which evaluates a form in an environment:
(defn eval-in [env form]
(apply
(eval `(fn* [~#(keys env)] ~form))
(vals env)))
Then let's modify pry to take an environment as an argument and use eval-in instead of eval:
(defn pry [env]
(let [prompt (str "pry(" *ns* ")> ")]
(loop []
(print prompt)
(flush)
(let [expr (read)]
(when-not (= expr :exit)
(println (eval-in env expr))
(recur))))))
An equivalent, less primitive version could be:
(defn pry [env]
(->> (repeatedly (let [prompt (str "pry(" *ns* ")> ")]
#(do (print prompt) (flush) (read))))
(take-while (partial not= :exit))
(run! (comp println (partial eval-in env)))))
Now we can define binding-pry as follows:
(defmacro binding-pry []
`(pry ~(into {}
(map (juxt (partial list 'quote) identity))
(keys &env))))
Finally, here is a direct/"spaghetti" implementation of binding-pry:
(defmacro binding-pry []
(let [ks (keys &env)]
`(->> (repeatedly (let* [prompt# (str "pry(" *ns* ")> ")]
#(do (print prompt#) (flush) (read))))
(take-while (partial not= :exit))
(run! (comp println
#((eval `(fn* [~~#(map (partial list 'quote) ks)] ~%))
~#ks))))))
This question might be very basic, but I am new to clojure and could not figure out how to proceed with this.
abc.clj :
(ns abc)
(defn foo
[i]
(+ i 20))
I am writing clojure spec for this function in another file abc_test.clj.
(ns abc_test
(:require [clojure.spec :as s]
[clojure.spec.test :as stest]
[clojure.test :refer [deftest is run-tests]]
[abc :refer [foo]]
))
(s/fdef foo
:args (s/cat :i string?)
:ret string?
:fn #(> (:ret %) (-> % :args :i)))
(deftest test_foo
(is (empty? (stest/check `foo))))
(run-tests)
This test works absolutely fine (test should fail) if I put the function (foo) in abc_test namespace but if I require it (like above), then the test gives incorrect result.
Not sure what is going wrong here. Any heads up shall be helpful.
Thanks.
In the s/fdef, the symbol name needs to resolve to a fully-qualified symbol. The way you have it, foo is resolving to abc_test/foo. You want it to refer to foo in the other namespace:
(s/fdef abc/foo
:args (s/cat :i string?)
:ret string?
:fn #(> (:ret %) (-> % :args :i)))
Or another trick is to leverage syntax quote (which will resolve symbols inside it given the current namespace mappings):
(s/fdef `foo
:args (s/cat :i string?)
:ret string?
:fn #(> (:ret %) (-> % :args :i)))
Is there anyway to include clojure.spec'd functions in a generalized test suite? I know we can register specs and directly spec functions.
(ns foo
(:require [clojure.spec :as s]
[clojure.spec.test :as stest]))
(defn average [list-sum list-count]
(/ list-sum list-count))
(s/fdef average
:args (s/and (s/cat :list-sum float? :list-count integer?)
#(not (zero? (:list-count %))))
:ret number?)
And later, if I want to run generative tests against that spec'd function, I can use stest/check.
=> (stest/check `average)
({:spec #object[clojure.spec$fspec_impl$reify__14282 0x68e9f37c "clojure.spec$fspec_impl$reify__14282#68e9f37c"], :clojure.spec.test.check/ret {:result true, :num-tests 1000, :seed 1479587517232}, :sym edgar.core.analysis.lagging/average})
But i) is there anyway to include these test runs in my general test suite? I'm thinking of the kind of clojure.test integration that test.check has. The closest thing that I can see ii) is the stest/instrument (see here) function. But that seems to just let us turn on checking at the repl. Not quite what I want. Also, iii) are function specs registered?
(defspec foo-test
100
;; NOT this
#_(prop/for-all [v ...]
(= v ...))
;; but THIS
(stest/some-unknown-spec-fn foo))
Ok, solved this one. Turns out there's no solution out of the box. But some people on the clojure-spec slack channel have put together a defspec-test solution for clojure.spec.test and clojure.test.
So given the code in the question. You can A) define the defspec-test macro that takes your test name and a list of spec'd functions. You can then B) use it in your test suite.
Thanks Clojure community!! And hopefully such a utility function makes it into the core library.
A)
(ns foo.test
(:require [clojure.test :as t]
[clojure.string :as str]))
(defmacro defspec-test
([name sym-or-syms] `(defspec-test ~name ~sym-or-syms nil))
([name sym-or-syms opts]
(when t/*load-tests*
`(def ~(vary-meta name assoc
:test `(fn []
(let [check-results# (clojure.spec.test/check ~sym-or-syms ~opts)
checks-passed?# (every? nil? (map :failure check-results#))]
(if checks-passed?#
(t/do-report {:type :pass
:message (str "Generative tests pass for "
(str/join ", " (map :sym check-results#)))})
(doseq [failed-check# (filter :failure check-results#)
:let [r# (clojure.spec.test/abbrev-result failed-check#)
failure# (:failure r#)]]
(t/do-report
{:type :fail
:message (with-out-str (clojure.spec/explain-out failure#))
:expected (->> r# :spec rest (apply hash-map) :ret)
:actual (if (instance? Throwable failure#)
failure#
(:clojure.spec.test/val failure#))})))
checks-passed?#)))
(fn [] (t/test-var (var ~name)))))))
B)
(ns foo-test
(:require [foo.test :refer [defspec-test]]
[foo]))
(defspec-test test-average [foo/average])
The above example can fail in the case where :failure is false due to how stest/abbrev-result tests for failure. See CLJ-2246 for more details. You can work around this by defining your own version of abbrev-result. Also, the formatting of failure data has changed.
(require
'[clojure.string :as str]
'[clojure.test :as test]
'[clojure.spec.alpha :as s]
'[clojure.spec.test.alpha :as stest])
;; extracted from clojure.spec.test.alpha
(defn failure-type [x] (::s/failure (ex-data x)))
(defn unwrap-failure [x] (if (failure-type x) (ex-data x) x))
(defn failure? [{:keys [:failure]}] (not (or (true? failure) (nil? failure))))
;; modified from clojure.spec.test.alpha
(defn abbrev-result [x]
(let [failure (:failure x)]
(if (failure? x)
(-> (dissoc x ::stc/ret)
(update :spec s/describe)
(update :failure unwrap-failure))
(dissoc x :spec ::stc/ret))))
(defn throwable? [x]
(instance? Throwable x))
(defn failure-report [failure]
(let [expected (->> (abbrev-result failure) :spec rest (apply hash-map) :ret)]
(if (throwable? failure)
{:type :error
:message "Exception thrown in check"
:expected expected
:actual failure}
(let [data (ex-data (get-in failure
[::stc/ret
:result-data
:clojure.test.check.properties/error]))]
{:type :fail
:message (with-out-str (s/explain-out data))
:expected expected
:actual (::s/value data)}))))
(defn check?
[msg [_ body :as form]]
`(let [results# ~body
failures# (filter failure? results#)]
(if (empty? failures#)
[{:type :pass
:message (str "Generative tests pass for "
(str/join ", " (map :sym results#)))}]
(map failure-report failures#))))
(defmethod test/assert-expr 'check?
[msg form]
`(dorun (map test/do-report ~(check? msg form))))
Here's a slightly modified version of grzm's excellent answer that works with [org.clojure/test.check "0.10.0-alpha4"]. It uses the new :pass? key that comes from this PR: https://github.com/clojure/test.check/commit/09927b64a60c8bfbffe2e4a88d76ee4046eef1bc#diff-5eb045ad9cf20dd057f8344a877abd89R1184.
(:require [clojure.test :as t]
[clojure.string :as str]
[clojure.spec.alpha :as s]
[clojure.spec.test.alpha :as stest])
(alias 'stc 'clojure.spec.test.check)
;; extracted from clojure.spec.test.alpha
(defn failure-type [x] (::s/failure (ex-data x)))
(defn unwrap-failure [x] (if (failure-type x) (ex-data x) x))
;; modified from clojure.spec.test.alpha
(defn abbrev-result [x]
(if (-> x :stc/ret :pass?)
(dissoc x :spec ::stc/ret)
(-> (dissoc x ::stc/ret)
(update :spec s/describe)
(update :failure unwrap-failure))))
(defn throwable? [x]
(instance? Throwable x))
(defn failure-report [failure]
(let [abbrev (abbrev-result failure)
expected (->> abbrev :spec rest (apply hash-map) :ret)
reason (:failure abbrev)]
(if (throwable? reason)
{:type :error
:message "Exception thrown in check"
:expected expected
:actual reason}
(let [data (ex-data (get-in failure
[::stc/ret
:shrunk
:result-data
:clojure.test.check.properties/error]))]
{:type :fail
:message (with-out-str (s/explain-out data))
:expected expected
:actual (::s/value data)}))))
(defn check?
[msg [_ body :as form]]
`(let [results# ~body
failures# (remove (comp :pass? ::stc/ret) results#)]
(if (empty? failures#)
[{:type :pass
:message (str "Generative tests pass for "
(str/join ", " (map :sym results#)))}]
(map failure-report failures#))))
(defmethod t/assert-expr 'check?
[msg form]
`(dorun (map t/do-report ~(check? msg form))))
Usage:
(deftest whatever-test
(is (check? (stest/check `whatever
;; optional
{:clojure.spec.test.check/opts {:num-tests 10000}})))
One of the examples in the clojure.spec Guide is a simple option-parsing spec:
(require '[clojure.spec :as s])
(s/def ::config
(s/* (s/cat :prop string?
:val (s/alt :s string? :b boolean?))))
(s/conform ::config ["-server" "foo" "-verbose" true "-user" "joe"])
;;=> [{:prop "-server", :val [:s "foo"]}
;; {:prop "-verbose", :val [:b true]}
;; {:prop "-user", :val [:s "joe"]}]
Later, in the validation section, a function is defined that internally conforms its input using this spec:
(defn- set-config [prop val]
(println "set" prop val))
(defn configure [input]
(let [parsed (s/conform ::config input)]
(if (= parsed ::s/invalid)
(throw (ex-info "Invalid input" (s/explain-data ::config input)))
(doseq [{prop :prop [_ val] :val} parsed]
(set-config (subs prop 1) val)))))
(configure ["-server" "foo" "-verbose" true "-user" "joe"])
;; set server foo
;; set verbose true
;; set user joe
;;=> nil
Since the guide is meant to be easy to follow from the REPL, all of this code is evaluated in the same namespace. In this answer, though, #levand recommends putting specs in separate namespaces:
I usually put specs in their own namespace, alongside the namespace that they are describing.
This would break the usage of ::config above, but that problem can be remedied:
It is preferable for spec key names to be in the namespace of the code, however, not the namespace of the spec. This is still easy to do by using a namespace alias on the keyword:
(ns my.app.foo.specs
(:require [my.app.foo :as f]))
(s/def ::f/name string?)
He goes on to explain that specs and implementations could be put in the same namespace, but it wouldn't be ideal:
While I certainly could put them right alongside the spec'd code in the same file, that hurts readability IMO.
However, I'm having trouble seeing how this can work with destructuring. As an example, I put together a little Boot project with the above code translated into multiple namespaces.
boot.properties:
BOOT_CLOJURE_VERSION=1.9.0-alpha7
src/example/core.clj:
(ns example.core
(:require [clojure.spec :as s]))
(defn- set-config [prop val]
(println "set" prop val))
(defn configure [input]
(let [parsed (s/conform ::config input)]
(if (= parsed ::s/invalid)
(throw (ex-info "Invalid input" (s/explain-data ::config input)))
(doseq [{prop :prop [_ val] :val} parsed]
(set-config (subs prop 1) val)))))
src/example/spec.clj:
(ns example.spec
(:require [clojure.spec :as s]
[example.core :as core]))
(s/def ::core/config
(s/* (s/cat :prop string?
:val (s/alt :s string? :b boolean?))))
build.boot:
(set-env! :source-paths #{"src"})
(require '[example.core :as core])
(deftask run []
(with-pass-thru _
(core/configure ["-server" "foo" "-verbose" true "-user" "joe"])))
But of course, when I actually run this, I get an error:
$ boot run
clojure.lang.ExceptionInfo: Unable to resolve spec: :example.core/config
I could fix this problem by adding (require 'example.spec) to build.boot, but that's ugly and error-prone, and will only become more so as my number of spec namespaces increases. I can't require the spec namespace from the implementation namespace, for several reasons. Here's an example that uses fdef.
boot.properties:
BOOT_CLOJURE_VERSION=1.9.0-alpha7
src/example/spec.clj:
(ns example.spec
(:require [clojure.spec :as s]))
(alias 'core 'example.core)
(s/fdef core/divisible?
:args (s/cat :x integer? :y (s/and integer? (complement zero?)))
:ret boolean?)
(s/fdef core/prime?
:args (s/cat :x integer?)
:ret boolean?)
(s/fdef core/factor
:args (s/cat :x (s/and integer? pos?))
:ret (s/map-of (s/and integer? core/prime?) (s/and integer? pos?))
:fn #(== (-> % :args :x) (apply * (for [[a b] (:ret %)] (Math/pow a b)))))
src/example/core.clj:
(ns example.core
(:require [example.spec]))
(defn divisible? [x y]
(zero? (rem x y)))
(defn prime? [x]
(and (< 1 x)
(not-any? (partial divisible? x)
(range 2 (inc (Math/floor (Math/sqrt x)))))))
(defn factor [x]
(loop [x x y 2 factors {}]
(let [add #(update factors % (fnil inc 0))]
(cond
(< x 2) factors
(< x (* y y)) (add x)
(divisible? x y) (recur (/ x y) y (add y))
:else (recur x (inc y) factors)))))
build.boot:
(set-env!
:source-paths #{"src"}
:dependencies '[[org.clojure/test.check "0.9.0" :scope "test"]])
(require '[clojure.spec.test :as stest]
'[example.core :as core])
(deftask run []
(with-pass-thru _
(prn (stest/run-all-tests))))
The first problem is the most obvious:
$ boot run
clojure.lang.ExceptionInfo: No such var: core/prime?
data: {:file "example/spec.clj", :line 16}
java.lang.RuntimeException: No such var: core/prime?
In my spec for factor, I want to use my prime? predicate to validate the returned factors. The cool thing about this factor spec is that, assuming prime? is correct, it both completely documents the factor function and eliminates the need for me to write any other tests for that function. But if you think that's just too cool, you can replace it with pos? or something.
Unsurprisingly, though, you'll still get an error when you try boot run again, this time complaining that the :args spec for either #'example.core/divisible? or #'example.core/prime? or #'example.core/factor (whichever it happens to try first) is missing. This is because, regardless of whether you alias a namespace or not, fdef won't use that alias unless the symbol you give it names a var that already exists. If the var doesn't exist, the symbol doesn't get expanded. (For even more fun, remove the :as core from build.boot and see what happens.)
If you want to keep that alias, you need to remove the (:require [example.spec]) from example.core and add a (require 'example.spec) to build.boot. Of course, that require needs to come after the one for example.core, or it won't work. And at that point, why not just put the require directly into example.spec?
All of these problems would be solved by putting the specs in the same file as the implementations. So, should I really put specs in separate namespaces from implementations? If so, how can the problems I've detailed above be solved?
This question demonstrates an important distinction between specs used within an application and specs used to test the application.
Specs used within the app to conform or validate input — like :example.core/config here — are part of the application code. They may be in the same file where they are used or in a separate file. In the latter case, the application code must :require the specs, just like any other code.
Specs used as tests are loaded after the code they specify. These are your fdefs and generators. You can put these in a separate namespace from the code — even in a separate directory, not packaged with your application — and they will :require the code.
It's possible you have some predicates or utility functions that are used by both kinds of specs. These would go in a separate namespace all of their own.
When I re-implement a macro written in Scheme with Clojure, I get into a trouble.
The macro tries to load pairs of testing data into a all-tests var for later use.
Because the arguments for the macro is variable-length and contains special undefined symbol, i.e. =>, I simply don't know how to parse it like what Scheme syntax-rules does.
Scheme Version:
(define all-tests '())
;;; load tests into all-tests
(define-syntax add-tests-with-string-output
(syntax-rules (=>)
[(_ test-name [expr => output-string] ...)
(set! all-tests
(cons
'(test-name [expr string output-string] ...)
all-tests))]))
(add-tests-with-string-output "integers"
[0 => "0\n"]
[1 => "1\n"]
[-1 => "-1\n"]
[10 => "10\n"]
[-10 => "-10\n"]
[2736 => "2736\n"]
[-2736 => "-2736\n"]
[536870911 => "536870911\n"]
[-536870912 => "-536870912\n"]
)
My current unsuccessful Clojure Version:
(def all-tests (atom '()))
(defmacro add-tests-with-string-output
[test-name & body]
`(loop [bds# (list body)]
(when-not (empty? bds#)
(println (first bds#))
(recur (rest bds#)))))
Ps: I am using println to test my code right now. When it works, I will try to do the parsing and loading work.
The first macro forms a loop and the second one a doseq (so is simpler). Both should behave the same. Also I find it a good idea to extract as much logic out of macros into auxiliary functions. Functions are easier to debug, test and write. If the macro were a bit more complicated I might have left even less logic in it.
(def all-tests (atom '()))
(defn add-test [test-name expr output-string]
(swap! all-tests #(cons (list test-name [expr output-string]) %)))
(defmacro add-tests-with-string-output
[test-name & body]
;`(loop [bds# '(~#body)]
`(loop [bds# '~body] ; edit
(when-not (empty? bds#)
(let [bd# (first bds#)
expr# (first bd#)
output-string# (last bd#)]
(add-test ~test-name expr# output-string#)
(recur (rest bds#))
))))
(defmacro add-tests-with-string-output2
[test-name & body]
;`(doseq [bd# '(~#body)]
`(doseq [bd# '~body] ; edit
(let [expr# (first bd#)
output-string# (last bd#)]
(add-test ~test-name expr# output-string#))))
user=> (add-tests-with-string-output "test1" [0 => "0\n"] [1 => "1\n"])
nil
user=> (add-tests-with-string-output2 "test2" [0 => "0\n"] [1 => "1\n"])
nil
user=> #all-tests
(("test2" [1 "1\n"]) ("test2" [0 "0\n"]) ("test1" [1 "1\n"]) ("test1" [0 "0\n"]))
After trials and errors, finally I figure out how to solve it.
First use Destructuring to tackle the arguments of variable-length;
later do not use Syntax-Quoting, i.e. backquote `, inside the macro, because if so, once you need to unquote ~ the argument, i.e. body, you will get error msg like this due to the special symbol =>:
CompilerException java.lang.RuntimeException: Unable to resolve
symbol: => in this context
Below is my solution.
If you get better one, or you know the reason why Syntax-Quote and Unquote go wrong, please let me know.
;;; load tests into all-tests
(def all-tests (atom '()))
(defmacro add-tests-with-string-output
[test-name & body]
(loop [bds body, tests '()]
(if (empty? bds)
(do
(swap! all-tests #(cons (cons test-name tests) %))
nil)
(let [pair (first bds),
input (first pair)
output (last pair)]
(recur (rest bds) (cons (list input ''string output) tests))))))