From d5708425995e8c83157ad49007ec2f8f43d8eac8 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 19 Jan 2016 13:29:20 -0600 Subject: [PATCH 001/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 1a5e65bb..5140e9da 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.8.0 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From 3394bbe616c6202618983ec87185a3ed25d0f557 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 23 May 2016 11:38:00 -0400 Subject: [PATCH 002/246] added spec --- build.xml | 1 + pom.xml | 2 +- src/clj/clojure/spec.clj | 1415 ++++++++++++++++++++++++++++ src/clj/clojure/spec/gen.clj | 175 ++++ src/clj/clojure/spec/test.clj | 147 +++ test/clojure/test_clojure/spec.clj | 180 ++++ 6 files changed, 1919 insertions(+), 1 deletion(-) create mode 100644 src/clj/clojure/spec.clj create mode 100644 src/clj/clojure/spec/gen.clj create mode 100644 src/clj/clojure/spec/test.clj create mode 100644 test/clojure/test_clojure/spec.clj diff --git a/build.xml b/build.xml index cae30b21..f9764b36 100644 --- a/build.xml +++ b/build.xml @@ -81,6 +81,7 @@ + diff --git a/pom.xml b/pom.xml index 5140e9da..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -64,7 +64,7 @@ org.clojure test.check - 0.5.9 + 0.9.0 test diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj new file mode 100644 index 00000000..386a765d --- /dev/null +++ b/src/clj/clojure/spec.clj @@ -0,0 +1,1415 @@ +; Copyright (c) Rich Hickey. 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.spec + (:refer-clojure :exclude [+ * and or cat def keys]) + (:require [clojure.walk :as walk] + [clojure.spec.gen :as gen] + [clojure.string :as str])) + +(alias 'c 'clojure.core) + +(set! *warn-on-reflection* true) + +(def ^:dynamic *recursion-limit* + "A soft limit on how many times a branching spec (or/alt/*/opt-keys) + can be recursed through during generation. After this a + non-recursive branch will be chosen." + 10) + +(def ^:dynamic *fspec-iterations* + "The number of times an anonymous fn specified by fspec will be (generatively) tested during conform" + 21) + +(def ^:dynamic *coll-check-limit* + "The number of items validated in a collection spec'ed with 'coll'" + 100) + +(def ^:private ^:dynamic *instrument-enabled* + "if false, instrumented fns call straight through" + true) + +(defprotocol Spec + (conform* [spec x]) + (explain* [spec path via x]) + (gen* [spec overrides path rmap]) + (with-gen* [spec gfn]) + (describe* [spec])) + +(defonce ^:private registry-ref (atom {})) + +(defn- named? [x] (instance? clojure.lang.Named x)) + +(defn- with-name [spec name] + (with-meta spec (assoc (meta spec) ::name name))) + +(defn- spec-name [spec] + (when (instance? clojure.lang.IObj spec) + (-> (meta spec) ::name))) + +(defn- reg-resolve + "returns the spec/regex at end of alias chain starting with k, nil if not found, k if k not Named" + [k] + (if (named? k) + (let [reg @registry-ref] + (loop [spec k] + (if (named? spec) + (recur (get reg spec)) + (when spec + (with-name spec k))))) + k)) + +(defn spec? + "returns x if x is a spec object, else logical false" + [x] + (c/and (extends? Spec (class x)) x)) + +(defn regex? + "returns x if x is a (clojure.spec) regex op, else logical false" + [x] + (c/and (::op x) x)) + +(declare spec-impl) +(declare regex-spec-impl) + +(defn- maybe-spec + "spec-or-k must be a spec, regex or resolvable kw/sym, else returns nil." + [spec-or-k] + (let [s (c/or (spec? spec-or-k) + (regex? spec-or-k) + (c/and (named? spec-or-k) (reg-resolve spec-or-k)) + nil)] + (if (regex? s) + (with-name (regex-spec-impl s nil) (spec-name s)) + s))) + +(defn- the-spec + "spec-or-k must be a spec, regex or kw/sym, else returns nil. Throws if unresolvable kw/sym" + [spec-or-k] + (c/or (maybe-spec spec-or-k) + (when (named? spec-or-k) + (throw (Exception. (str "Unable to resolve spec: " spec-or-k)))))) + +(defn- specize [s] + (c/or (the-spec s) (spec-impl ::unknown s nil nil))) + +(defn conform + "Given a spec and a value, returns :clojure.spec/invalid if value does not match spec, + else the (possibly destructured) value." + [spec x] + (conform* (specize spec) x)) + +(defn form + "returns the spec as data" + [spec] + ;;TODO - incorporate gens + (describe* (specize spec))) + +(defn abbrev [form] + (cond + (seq? form) + (walk/postwalk (fn [form] + (cond + (c/and (symbol? form) (namespace form)) + (-> form name symbol) + + (c/and (seq? form) (= 'fn (first form)) (= '[%] (second form))) + (last form) + + :else form)) + form) + + (c/and (symbol? form) (namespace form)) + (-> form name symbol) + + :else form)) + +(defn describe + "returns an abbreviated description of the spec as data" + [spec] + (abbrev (form spec))) + +(defn with-gen + "Takes a spec and a no-arg, generator-returning fn and returns a version of that spec that uses that generator" + [spec gen-fn] + (with-gen* (specize spec) gen-fn)) + +(defn explain-data* [spec path via x] + (when-let [probs (explain* (specize spec) path via x)] + {::problems probs})) + +(defn explain-data + "Given a spec and a value x which ought to conform, returns nil if x + conforms, else a map with at least the key ::problems whose value is + a path->problem-map, where problem-map has at least :pred and :val + keys describing the predicate and the value that failed at that + path." + [spec x] + (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) x)) + +(defn- explain-out + "prints an explanation to *out*." + [ed] + (if ed + (do + ;;(prn {:ed ed}) + (doseq [[path {:keys [pred val reason via] :as prob}] (::problems ed)] + (when-not (empty? path) + (print "At:" path "")) + (print "val: ") + (pr val) + (print " fails") + (when-let [specname (last via)] + (print " spec:" specname)) + (print " predicate: ") + (pr pred) + (when reason (print ", " reason)) + (doseq [[k v] prob] + (when-not (#{:pred :val :reason :via} k) + (print "\n\t" k " ") + (pr v))) + (newline)) + (doseq [[k v] ed] + (when-not (#{::problems} k) + (print k " ") + (pr v) + (newline)))) + (println "Success!"))) + +(defn explain + "Given a spec and a value that fails to conform, prints an explanation to *out*." + [spec x] + (explain-out (explain-data spec x))) + +(declare valid?) + +(defn- gensub + [spec overrides path rmap form] + ;;(prn {:spec spec :over overrides :path path :form form}) + (if-let [spec (specize spec)] + (if-let [g (c/or (get overrides path) (gen* spec overrides path rmap))] + (gen/such-that #(valid? spec %) g 100) + (throw (Exception. (str "Unable to construct gen at: " path " for: " (abbrev form))))) + (throw (Exception. (str "Unable to construct gen at: " path ", " (abbrev form) " can not be made a spec"))))) + +(defn gen + "Given a spec, returns the generator for it, or throws if none can + be constructed. Optionally an overrides map can be provided which + should map paths (vectors of keywords) to generators. These will be + used instead of the generators at those paths. Note that parent + generator (in the spec or overrides map) will supersede those of any + subtrees. A generator for a regex op must always return a + sequential collection (i.e. a generator for s/? should return either + an empty sequence/vector or a sequence/vector with one item in it)" + ([spec] (gen spec nil)) + ([spec overrides] (gensub spec overrides [] nil spec))) + +(defn- ->sym + "Returns a symbol from a symbol or var" + [x] + (if (var? x) + (let [^clojure.lang.Var v x] + (symbol (str (.name (.ns v))) + (str (.sym v)))) + x)) + +(defn- unfn [expr] + (if (c/and (seq? expr) + (symbol? (first expr)) + (= "fn*" (name (first expr)))) + (let [[[s] & form] (rest expr)] + (conj (walk/postwalk-replace {s '%} form) '[%] 'fn)) + expr)) + +(defn- res [form] + (cond + (keyword? form) form + (symbol? form) (c/or (-> form resolve ->sym) form) + (sequential? form) (walk/postwalk #(if (symbol? %) (res %) %) (unfn form)) + :else form)) + +(defn ^:skip-wiki def-impl + "Do not call this directly, use 'def'" + [k form spec] + (assert (c/and (named? k) (namespace k)) "k must be namespaced keyword/symbol") + (let [spec (if (c/or (spec? spec) (regex? spec) (get @registry-ref spec)) + spec + (spec-impl form spec nil nil))] + (swap! registry-ref assoc k spec) + k)) + +(defmacro def + "Given a namespace-qualified keyword or symbol k, and a spec, spec-name, predicate or regex-op + makes an entry in the registry mapping k to the spec" + [k spec-form] + `(def-impl ~k '~(res spec-form) ~spec-form)) + +(defn registry + "returns the registry map" + [] + @registry-ref) + +(declare map-spec) + +(defmacro spec + "Takes a single predicate form, e.g. can be the name of a predicate, + like even?, or a fn literal like #(< % 42). Note that it is not + generally necessary to wrap predicates in spec when using the rest + of the spec macros, only to attach a unique generator + + Can also be passed the result of one of the regex ops - + cat, alt, *, +, ?, in which case it will return a regex-conforming + spec, useful when nesting an independent regex. + --- + + Optionally takes :gen generator-fn, which must be a fn of no args that + returns a test.check generator. + + Returns a spec." + [form & {:keys [gen]}] + `(spec-impl '~(res form) ~form ~gen nil)) + +(defmacro multi-spec + "Takes the name of a spec/predicate-returning multimethod and a + tag-restoring keyword or fn (retag). Returns a spec that when + conforming or explaining data will pass it to the multimethod to get + an appropriate spec. You can e.g. use multi-spec to dynamically and + extensibly associate specs with 'tagged' data (i.e. data where one + of the fields indicates the shape of the rest of the structure). + + The multimethod must use :clojure.spec/invalid as its default value + and should return nil from that dispatch value: + + (defmulti mspec :tag :default :clojure.spec/invalid) + (defmethod mspec :clojure.spec/invalid [_] nil) + + The methods should ignore their argument and return a predicate/spec: + (defmethod mspec :int [_] (s/keys :req-un [::i])) + + retag is used during generation to retag generated values with + matching tags. retag can either be a keyword, at which key the + dispatch-tag will be assoc'ed, or a fn of generated value and + dispatch-tag that should return an appropriately retagged value. + + Note that because the tags themselves comprise an open set, + the tag keys cannot be :req in the specs. +" + [mm retag] + `(multi-spec-impl '~(res mm) (var ~mm) ~retag)) + +(defmacro keys + "Creates and returns a map validating spec. :req and :opt are both + vectors of namespaced-qualified keywords. The validator will ensure + the :req keys are present. The :opt keys serve as documentation and + may be used by the generator. + + The :req key vector supports 'and' and 'or' for key groups: + + (s/keys :req [::x ::y (or ::secret (and ::user ::pwd))] :opt [::z]) + + There are also -un versions of :req and :opt. These allow + you to connect unqualified keys to specs. In each case, fully + qualfied keywords are passed, which name the specs, but unqualified + keys (with the same name component) are expected and checked at + conform-time, and generated during gen: + + (s/keys :req-un [:my.ns/x :my.ns/y]) + + The above says keys :x and :y are required, and will be validated + and generated by specs (if they exist) named :my.ns/x :my.ns/y + respectively. + + In addition, the values of *all* namespace-qualified keys will be validated + (and possibly destructured) by any registered specs. Note: there is + no support for inline value specification, by design. + + Optionally takes :gen generator-fn, which must be a fn of no args that + returns a test.check generator." + [& {:keys [req req-un opt opt-un gen]}] + (let [unk #(-> % name keyword) + req-keys (filterv keyword? (flatten req)) + req-un-specs (filterv keyword? (flatten req-un)) + _ (assert (every? #(c/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un)) + "all keys must be namespace-qualified keywords") + req-specs (into req-keys req-un-specs) + req-keys (into req-keys (map unk req-un-specs)) + opt-keys (into (vec opt) (map unk opt-un)) + opt-specs (into (vec opt) opt-un) + parse-req (fn [rk f] + (map (fn [x] + (if (keyword? x) + `#(contains? % ~(f x)) + (let [gx (gensym)] + `(fn* [~gx] + ~(walk/postwalk + (fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y)) + x))))) + rk)) + pred-exprs [`map?] + pred-exprs (into pred-exprs (parse-req req identity)) + pred-exprs (into pred-exprs (parse-req req-un unk)) + pred-forms (walk/postwalk res pred-exprs)] + ;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen) + `(map-spec-impl {:req '~req :opt '~opt :req-un '~req-un :opt-un '~opt-un + :req-keys '~req-keys :req-specs '~req-specs + :opt-keys '~opt-keys :opt-specs '~opt-specs + :pred-forms '~pred-forms + :pred-exprs ~pred-exprs + :gfn ~gen}))) + +(defmacro or + "Takes key+pred pairs, e.g. + + (s/or :even even? :small #(< % 42)) + + Returns a destructuring spec that + returns a vector containing the key of the first matching pred and the + corresponding value." + [& key-pred-forms] + (let [pairs (partition 2 key-pred-forms) + keys (mapv first pairs) + pred-forms (mapv second pairs) + pf (mapv res pred-forms)] + (assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords") + `(or-spec-impl ~keys '~pf ~pred-forms nil))) + +(defmacro and + "Takes predicate/spec-forms, e.g. + + (s/and even? #(< % 42)) + + Returns a spec that returns the conformed value. Successive + conformed values propagate through rest of predicates." + [& pred-forms] + `(and-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) + +(defmacro * + "Returns a regex op that matches zero or more values matching + pred. Produces a vector of matches iff there is at least one match" + [pred-form] + `(rep-impl '~(res pred-form) ~pred-form)) + +(defmacro + + "Returns a regex op that matches one or more values matching + pred. Produces a vector of matches" + [pred-form] + `(rep+impl '~(res pred-form) ~pred-form)) + +(defmacro ? + "Returns a regex op that matches zero or one value matching + pred. Produces a single value (not a collection) if matched." + [pred-form] + `(maybe-impl ~pred-form '~pred-form)) + +(defmacro alt + "Takes key+pred pairs, e.g. + + (s/alt :even even? :small #(< % 42)) + + Returns a regex op that returns a vector containing the key of the + first matching pred and the corresponding value." + [& key-pred-forms] + (let [pairs (partition 2 key-pred-forms) + keys (mapv first pairs) + pred-forms (mapv second pairs) + pf (mapv res pred-forms)] + (assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords") + `(alt-impl ~keys ~pred-forms '~pf))) + +(defmacro cat + "Takes key+pred pairs, e.g. + + (s/cat :e even? :o odd?) + + Returns a regex op that matches (all) values in sequence, returning a map + containing the keys of each pred and the corresponding value." + [& key-pred-forms] + (let [pairs (partition 2 key-pred-forms) + keys (mapv first pairs) + pred-forms (mapv second pairs) + pf (mapv res pred-forms)] + ;;(prn key-pred-forms) + (assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords") + `(cat-impl ~keys ~pred-forms '~pf))) + +(defmacro & + "takes a regex op re, and predicates. Returns a regex-op that consumes + input as per re but subjects the resulting value to the + conjunction of the predicates, and any conforming they might perform." + [re & preds] + (let [pv (vec preds)] + `(amp-impl ~re ~pv '~pv))) + +(defmacro conformer + "takes a predicate function with the semantics of conform i.e. it should return either a + (possibly converted) value or :clojure.spec/invalid, and returns a + spec that uses it as a predicate/conformer" + [f] + `(spec-impl '~f ~f nil true)) + +(defmacro fspec + "takes :args :ret and (optional) :fn kwargs whose values are preds + and returns a spec whose conform/explain take a fn and validates it + using generative testing. The conformed value is always the fn itself. + + Optionally takes :gen generator-fn, which must be a fn of no args + that returns a test.check generator." + [& {:keys [args ret fn gen]}] + `(fspec-impl ~args '~(res args) ~ret '~(res ret) ~fn '~(res fn) ~gen)) + +(defmacro tuple + "takes one or more preds and returns a spec for a tuple, a vector + where each element conforms to the corresponding pred. Each element + will be referred to in paths using its ordinal." + [& preds] + (assert (not (empty? preds))) + `(tuple-impl '~(mapv res preds) ~(vec preds))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- ns-qualify + "Qualify symbol s by resolving it or using the current *ns*." + [s] + (if-let [resolved (resolve s)] + (->sym resolved) + (if (namespace s) + s + (symbol (str (.name *ns*)) (str s))))) + +(defn- fn-spec-sym + [sym role] + (symbol (str (ns-qualify sym) "$" (name role)))) + +(def ^:private fn-spec-roles [:args :ret :fn]) + +(defn- expect + "Returns nil if v conforms to spec, else throws ex-info with explain-data." + [spec v] + ) + +(defn- fn-specs? + "Fn-specs must include at least :args or :ret specs." + [m] + (c/or (:args m) (:ret m))) + +(defn fn-specs + "Returns :args/:ret/:fn map of specs for var or symbol v." + [v] + (let [s (->sym v) + reg (registry)] + (reduce + (fn [m role] + (assoc m role (get reg (fn-spec-sym s role)))) + {} + fn-spec-roles))) + +(defmacro with-instrument-disabled + "Disables instrument's checking of calls, within a scope." + [& body] + `(binding [*instrument-enabled* nil] + ~@body)) + +(defn- spec-checking-fn + [v f] + (let [conform! (fn [v role spec data args] + (let [conformed (conform spec data)] + (if (= ::invalid conformed) + (let [ed (assoc (explain-data* spec [role] [] data) + ::args args)] + (throw (ex-info + (str "Call to " v " did not conform to spec:\n" (with-out-str (explain-out ed))) + ed))) + conformed)))] + (c/fn + [& args] + (if *instrument-enabled* + (with-instrument-disabled + (let [specs (fn-specs v)] + (let [cargs (when (:args specs) (conform! v :args (:args specs) args args)) + ret (binding [*instrument-enabled* true] + (.applyTo ^clojure.lang.IFn f args)) + cret (when (:ret specs) (conform! v :ret (:ret specs) ret args))] + (when (c/and (:args specs) (:ret specs) (:fn specs)) + (conform! v :fn (:fn specs) {:args cargs :ret cret} args)) + ret))) + (.applyTo ^clojure.lang.IFn f args))))) + +(defn- macroexpand-check + [v args] + (let [specs (fn-specs v)] + (when-let [arg-spec (:args specs)] + (when (= ::invalid (conform arg-spec args)) + (let [ed (assoc (explain-data* arg-spec [:args] + (if-let [name (spec-name arg-spec)] [name] []) args) + ::args args)] + (throw (IllegalArgumentException. + (str + "Call to " (->sym v) " did not conform to spec:\n" + (with-out-str (explain-out ed)))))))))) + +(defmacro fdef + "Takes a symbol naming a function, and one or more of the following: + + :args A regex spec for the function arguments as they were a list to be + passed to apply - in this way, a single spec can handle functions with + multiple arities + :ret A spec for the function's return value + :fn A spec of the relationship between args and ret - the + value passed is {:args conformed-args :ret conformed-ret} and is + expected to contain predicates that relate those values + + Qualifies fn-sym with resolve, or using *ns* if no resolution found. + Registers specs in the global registry, where they can be retrieved + by calling fn-specs. + + Once registered, function specs are included in doc, checked by + instrument, tested by the runner clojure.spec.test/run-tests, and (if + a macro) used to explain errors during macroexpansion. + + Note that :fn specs require the presence of :args and :ret specs to + conform values, and so :fn specs will be ignored if :args or :ret + are missing. + + Returns the qualified fn-sym. + + For example, to register function specs for the symbol function: + + (s/fdef clojure.core/symbol + :args (s/alt :separate (s/cat :ns string? :n string?) + :str string? + :sym symbol?) + :ret symbol?)" + [fn-sym & {:keys [args ret fn] :as m}] + (let [qn (ns-qualify fn-sym)] + `(do ~@(reduce + (c/fn [defns role] + (if (contains? m role) + (let [s (fn-spec-sym qn (name role))] + (conj defns `(clojure.spec/def '~s ~(get m role)))) + defns)) + [] [:args :ret :fn]) + '~qn))) + +(defn- no-fn-specs + [v specs] + (ex-info (str "Fn at " v " is not spec'ed.") + {:var v :specs specs})) + +(def ^:private instrumented-vars + "Map for instrumented vars to :raw/:wrapped fns" + (atom {})) + +(defn- ->var + [s-or-v] + (if (var? s-or-v) + s-or-v + (let [v (c/and (symbol? s-or-v) (resolve s-or-v))] + (if (var? v) + v + (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var"))))))) + +(defn instrument + "Instruments the var at v, a var or symbol, to check specs +registered with fdef. Wraps the fn at v to check :args/:ret/:fn +specs, if they exist, throwing an ex-info with explain-data if a +check fails. Idempotent." + [v] + (let [v (->var v) + specs (fn-specs v)] + (if (fn-specs? specs) + (locking instrumented-vars + (let [{:keys [raw wrapped]} (get @instrumented-vars v) + current @v] + (when-not (= wrapped current) + (let [checked (spec-checking-fn v current)] + (alter-var-root v (constantly checked)) + (swap! instrumented-vars assoc v {:raw current :wrapped checked})))) + v) + (throw (no-fn-specs v specs))))) + +(defn unstrument + "Undoes instrument on the var at v, a var or symbol. Idempotent." + [v] + (let [v (->var v)] + (locking instrumented-vars + (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] + (let [current @v] + (when (= wrapped current) + (alter-var-root v (constantly raw)))) + (swap! instrumented-vars dissoc v)) + v))) + +(defn speced-vars + "Returns the set of vars whose namespace is in ns-syms AND +whose vars have been speced with fdef. If no ns-syms are +specified, return speced vars from all namespaces." + [& ns-syms] + (let [ns-match? (if (seq ns-syms) + (set (map str ns-syms)) + (constantly true))] + (reduce-kv + (fn [s k _] + (if (c/and (symbol? k) + (re-find #"\$(args|ret)$" (name k)) + (ns-match? (namespace k))) + (if-let [v (resolve (symbol (str/replace (str k) #"\$(args|ret)$" "")))] + (conj s v) + s) + s)) + #{} + (registry)))) + +(defn instrument-ns + "Call instrument for all speced-vars in namespaces named +by ns-syms. Idempotent." + [& ns-syms] + (when (seq ns-syms) + (locking instrumented-vars + (doseq [v (apply speced-vars ns-syms)] + (instrument v))))) + +(defn unstrument-ns + "Call unstrument for all speced-vars in namespaces named +by ns-syms. Idempotent." + [& ns-syms] + (when (seq ns-syms) + (locking instrumented-vars + (doseq [v (apply speced-vars ns-syms)] + (unstrument v))))) + +(defn instrument-all + "Call instrument for all speced-vars. Idempotent." + [] + (locking instrumented-vars + (doseq [v (speced-vars)] + (instrument v)))) + +(defn unstrument-all + "Call unstrument for all speced-vars. Idempotent" + [] + (locking instrumented-vars + (doseq [v (speced-vars)] + (unstrument v)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defn- recur-limit? [rmap id path k] + (c/and (> (get rmap id) *recursion-limit*) + (contains? (set path) k))) + +(defn- inck [m k] + (assoc m k (inc (c/or (get m k) 0)))) + +(defn- dt + ([pred x form] (dt pred x form nil)) + ([pred x form cpred?] + (if pred + (if-let [spec (the-spec pred)] + (conform spec x) + (if (ifn? pred) + (if cpred? + (pred x) + (if (pred x) x ::invalid)) + (throw (Exception. (str (pr-str form) " is not a fn, expected predicate fn"))))) + x))) + +(defn valid? + "Helper function that returns true when x is valid for spec." + ([spec x] + (not= ::invalid (dt spec x ::unknown))) + ([spec x form] + (not= ::invalid (dt spec x form)))) + +(defn- explain-1 [form pred path via v] + (let [pred (maybe-spec pred)] + (if (spec? pred) + (explain* pred path (if-let [name (spec-name pred)] (conj via name) via) v) + {path {:pred (abbrev form) :val v :via via}}))) + +(defn ^:skip-wiki map-spec-impl + "Do not call this directly, use 'spec' with a map argument" + [{:keys [req-un opt-un pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn] + :as argm}] + (let [keys-pred (apply every-pred pred-exprs) + k->s (zipmap (concat req-keys opt-keys) (concat req-specs opt-specs)) + keys->specs #(c/or (k->s %) %) + id (java.util.UUID/randomUUID)] + (reify + clojure.lang.IFn + (invoke [this x] (valid? this x)) + Spec + (conform* [_ m] + (if (keys-pred m) + (let [reg (registry)] + (loop [ret m, [k & ks :as keys] (c/keys m)] + (if keys + (if (contains? reg (keys->specs k)) + (let [v (get m k) + cv (conform (keys->specs k) v)] + (if (= cv ::invalid) + ::invalid + (recur (if (identical? cv v) ret (assoc ret k cv)) + ks))) + (recur ret ks)) + ret))) + ::invalid)) + (explain* [_ path via x] + (if-not (map? x) + {path {:pred 'map? :val x :via via}} + (let [reg (registry)] + (apply merge + (when-let [probs (->> (map (fn [pred form] (when-not (pred x) (abbrev form))) + pred-exprs pred-forms) + (keep identity) + seq)] + {path {:pred (vec probs) :val x :via via}}) + (map (fn [[k v]] + (when-not (c/or (not (contains? reg (keys->specs k))) + (valid? (keys->specs k) v k)) + (explain-1 (keys->specs k) (keys->specs k) (conj path k) via v))) + (seq x)))))) + (gen* [_ overrides path rmap] + (if gfn + (gfn) + (let [rmap (inck rmap id) + gen (fn [k s] (gensub s overrides (conj path k) rmap k)) + ogen (fn [k s] + (when-not (recur-limit? rmap id path k) + [k (gensub s overrides (conj path k) rmap k)])) + req-gens (map gen req-keys req-specs) + opt-gens (remove nil? (map ogen opt-keys opt-specs))] + (when (every? identity (concat req-gens opt-gens)) + (let [reqs (zipmap req-keys req-gens) + opts (into {} opt-gens)] + (gen/bind (gen/choose 0 (count opts)) + #(let [args (concat (seq reqs) (when (seq opts) (shuffle (seq opts))))] + (->> args + (take (c/+ % (count reqs))) + (apply concat) + (apply gen/hash-map))))))))) + (with-gen* [_ gfn] (map-spec-impl (assoc argm :gfn gfn))) + (describe* [_] (cons `keys + (cond-> [] + req (conj :req req) + opt (conj :opt opt) + req-un (conj :req-un req-un) + opt-un (conj :opt-un opt-un))))))) + + + + +(defn ^:skip-wiki spec-impl + "Do not call this directly, use 'spec'" + [form pred gfn cpred?] + (cond + (spec? pred) (cond-> pred gfn (with-gen gfn)) + (regex? pred) (regex-spec-impl pred gfn) + (named? pred) (cond-> (the-spec pred) gfn (with-gen gfn)) + :else + (reify + clojure.lang.IFn + (invoke [this x] (valid? this x)) + Spec + (conform* [_ x] (dt pred x form cpred?)) + (explain* [_ path via x] + (when (= ::invalid (dt pred x form cpred?)) + {path {:pred (abbrev form) :val x :via via}})) + (gen* [_ _ _ _] (if gfn + (gfn) + (gen/gen-for-pred pred))) + (with-gen* [_ gfn] (spec-impl form pred gfn cpred?)) + (describe* [_] form)))) + +(defn ^:skip-wiki multi-spec-impl + "Do not call this directly, use 'multi-spec'" + ([form mmvar retag] (multi-spec-impl form mmvar retag nil)) + ([form mmvar retag gfn] + (assert (when-let [dm (-> (methods @mmvar) ::invalid)] + (nil? (dm nil))) + (str "Multimethod :" form " does not contain nil-returning default method for :clojure.spec/invalid" )) + (let [predx #(@mmvar %) + tag (if (keyword? retag) + #(assoc %1 retag %2) + retag)] + (reify + clojure.lang.IFn + (invoke [this x] (valid? this x)) + Spec + (conform* [_ x] (if-let [pred (predx x)] + (dt pred x form) + ::invalid)) + (explain* [_ path via x] + (if-let [pred (predx x)] + (explain-1 form pred path via x) + {path {:pred form :val x :reason "no method" :via via}})) + (gen* [_ overrides path rmap] + (if gfn + (gfn) + (let [gen (fn [[k f]] + (let [p (f nil)] + (gen/fmap + #(tag % k) + (gensub p overrides path rmap (list 'method form k))))) + gs (->> (methods @mmvar) + (remove (fn [[k]] (= k ::invalid))) + (map gen) + (remove nil?))] + (when (every? identity gs) + (gen/one-of gs))))) + (with-gen* [_ gfn] (multi-spec-impl form mmvar retag gfn)) + (describe* [_] `(multi-spec ~form)))))) + +(defn ^:skip-wiki tuple-impl + "Do not call this directly, use 'tuple'" + ([forms preds] (tuple-impl forms preds nil)) + ([forms preds gfn] + (reify + clojure.lang.IFn + (invoke [this x] (valid? this x)) + Spec + (conform* [_ x] + (if-not (c/and (vector? x) + (= (count x) (count preds))) + ::invalid + (loop [ret x, i 0] + (if (= i (count x)) + ret + (let [v (x i) + cv (dt (preds i) v (forms i))] + (if (= ::invalid cv) + ::invalid + (recur (if (identical? cv v) ret (assoc ret i cv)) + (inc i)))))))) + (explain* [_ path via x] + (cond + (not (vector? x)) + {path {:pred 'vector? :val x :via via}} + + (not= (count x) (count preds)) + {path {:pred `(= (count ~'%) ~(count preds)) :val x :via via}} + + :else + (apply merge + (map (fn [i form pred] + (let [v (x i)] + (when-not (valid? pred v) + (explain-1 form pred (conj path i) via v)))) + (range (count preds)) forms preds)))) + (gen* [_ overrides path rmap] + (if gfn + (gfn) + (let [gen (fn [i p f] + (gensub p overrides (conj path i) rmap f)) + gs (map gen (range (count preds)) preds forms)] + (when (every? identity gs) + (apply gen/tuple gs))))) + (with-gen* [_ gfn] (tuple-impl forms preds gfn)) + (describe* [_] `(tuple ~@forms))))) + + +(defn ^:skip-wiki or-spec-impl + "Do not call this directly, use 'or'" + [keys forms preds gfn] + (let [id (java.util.UUID/randomUUID) + cform (fn [x] + (loop [i 0] + (if (< i (count preds)) + (let [pred (preds i)] + (let [ret (dt pred x (nth forms i))] + (if (= ::invalid ret) + (recur (inc i)) + [(keys i) ret]))) + ::invalid)))] + (reify + clojure.lang.IFn + (invoke [this x] (valid? this x)) + Spec + (conform* [_ x] (cform x)) + (explain* [this path via x] + (when-not (valid? this x) + (apply merge + (map (fn [k form pred] + (when-not (valid? pred x) + (explain-1 form pred (conj path k) via x))) + keys forms preds)))) + (gen* [_ overrides path rmap] + (if gfn + (gfn) + (let [gen (fn [k p f] + (let [rmap (inck rmap id)] + (when-not (recur-limit? rmap id path k) + (gensub p overrides (conj path k) rmap f)))) + gs (remove nil? (map gen keys preds forms))] + (when-not (empty? gs) + (gen/one-of gs))))) + (with-gen* [_ gfn] (or-spec-impl keys forms preds gfn)) + (describe* [_] `(or ~@(mapcat vector keys forms)))))) + +(defn- and-preds [x preds forms] + (loop [ret x + [pred & preds] preds + [form & forms] forms] + (if pred + (let [nret (dt pred ret form)] + (if (= ::invalid nret) + ::invalid + ;;propagate conformed values + (recur nret preds forms))) + ret))) + +(defn- explain-pred-list + [forms preds path via x] + (loop [ret x + [form & forms] forms + [pred & preds] preds] + (when pred + (let [nret (dt pred ret form)] + (if (not= ::invalid nret) + (recur nret forms preds) + (explain-1 form pred path via ret)))))) + +(defn ^:skip-wiki and-spec-impl + "Do not call this directly, use 'and'" + [forms preds gfn] + (reify + clojure.lang.IFn + (invoke [this x] (valid? this x)) + Spec + (conform* [_ x] (and-preds x preds forms)) + (explain* [_ path via x] (explain-pred-list forms preds path via x)) + (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms)))) + (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) + (describe* [_] `(and ~@forms)))) + +;;;;;;;;;;;;;;;;;;;;;;; regex ;;;;;;;;;;;;;;;;;;; +;;See: +;; http://matt.might.net/articles/implementation-of-regular-expression-matching-in-scheme-with-derivatives/ +;; http://www.ccs.neu.edu/home/turon/re-deriv.pdf + +;;ctors +(defn- accept [x] {::op ::accept :ret x}) + +(defn- accept? [{:keys [::op]}] + (= ::accept op)) + +(defn- pcat* [{[p1 & pr :as ps] :ps, [k1 & kr :as ks] :ks, [f1 & fr :as forms] :forms, ret :ret}] + (when (every? identity ps) + (if (accept? p1) + (let [rp (:ret p1) + ret (conj ret (if ks {k1 rp} rp))] + (if pr + (pcat* {:ps pr :ks kr :forms fr :ret ret}) + (accept ret))) + {::op ::pcat, :ps ps, :ret ret, :ks ks, :forms forms}))) + +(defn- pcat [& ps] (pcat* {:ps ps :ret []})) + +(defn ^:skip-wiki cat-impl + "Do not call this directly, use 'cat'" + [ks ps forms] + (pcat* {:ks ks, :ps ps, :forms forms, :ret {}})) + +(defn- rep* [p1 p2 ret splice form] + (when p1 + (let [r {::op ::rep, :p2 p2, :splice splice, :forms form :id (java.util.UUID/randomUUID)}] + (if (accept? p1) + (assoc r :p1 p2 :ret (conj ret (:ret p1))) + (assoc r :p1 p1, :ret ret))))) + +(defn ^:skip-wiki rep-impl + "Do not call this directly, use '*'" + [form p] (rep* p p [] false form)) + +(defn ^:skip-wiki rep+impl + "Do not call this directly, use '+'" + [form p] + (pcat* {:ps [p (rep* p p [] true form)] :forms `[~form (* ~form)] :ret []})) + +(defn ^:skip-wiki amp-impl + "Do not call this directly, use '&'" + [re preds pred-forms] + {::op ::amp :p1 re :ps preds :forms pred-forms}) + +(defn- filter-alt [ps ks forms f] + (if (c/or ks forms) + (let [pks (->> (map vector ps + (c/or (seq ks) (repeat nil)) + (c/or (seq forms) (repeat nil))) + (filter #(-> % first f)))] + [(seq (map first pks)) (when ks (seq (map second pks))) (when forms (seq (map #(nth % 2) pks)))]) + [(seq (filter f ps)) ks forms])) + +(defn- alt* [ps ks forms] + (let [[[p1 & pr :as ps] [k1 :as ks] forms] (filter-alt ps ks forms identity)] + (when ps + (let [ret {::op ::alt, :ps ps, :ks ks :forms forms}] + (if (nil? pr) + (if k1 + (if (accept? p1) + (accept [k1 (:ret p1)]) + ret) + p1) + ret))))) + +(defn- alts [& ps] (alt* ps nil nil)) +(defn- alt2 [p1 p2] (if (c/and p1 p2) (alts p1 p2) (c/or p1 p2))) + +(defn ^:skip-wiki alt-impl + "Do not call this directly, use 'alt'" + [ks ps forms] (assoc (alt* ps ks forms) :id (java.util.UUID/randomUUID))) + +(defn ^:skip-wiki maybe-impl + "Do not call this directly, use '?'" + [p form] (alt* [p (accept ::nil)] nil [form ::nil])) + +(defn- noret? [p1 pret] + (c/or (= pret ::nil) + (c/and (#{::rep ::pcat} (::op (reg-resolve p1))) ;;hrm, shouldn't know these + (empty? pret)) + nil)) + +(declare preturn) + +(defn- accept-nil? [p] + (let [{:keys [::op ps p1 p2 forms] :as p} (reg-resolve p)] + (case op + ::accept true + nil nil + ::amp (c/and (accept-nil? p1) + (c/or (noret? p1 (preturn p1)) + (let [ret (-> (preturn p1) (and-preds ps (next forms)))] + (if (= ret ::invalid) + nil + ret)))) + ::rep (c/or (identical? p1 p2) (accept-nil? p1)) + ::pcat (every? accept-nil? ps) + ::alt (c/some accept-nil? ps)))) + +(declare add-ret) + +(defn- preturn [p] + (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms] :as p} (reg-resolve p)] + (case op + ::accept ret + nil nil + ::amp (let [pret (preturn p1)] + (if (noret? p1 pret) + ::nil + (and-preds pret ps forms))) + ::rep (add-ret p1 ret k) + ::pcat (add-ret p0 ret k) + ::alt (let [[[p0] [k0]] (filter-alt ps ks forms accept-nil?) + r (if (nil? p0) ::nil (preturn p0))] + (if k0 [k0 r] r))))) + +(defn- add-ret [p r k] + (let [{:keys [::op ps splice] :as p} (reg-resolve p) + prop #(let [ret (preturn p)] + (if (empty? ret) r ((if splice into conj) r (if k {k ret} ret))))] + (case op + nil r + (::alt ::accept ::amp) + (let [ret (preturn p)] + ;;(prn {:ret ret}) + (if (= ret ::nil) r (conj r (if k {k ret} ret)))) + + (::rep ::pcat) (prop)))) + +(defn- deriv + [p x] + (let [{[p0 & pr :as ps] :ps, [k0 & kr :as ks] :ks, :keys [::op p1 p2 ret splice forms] :as p} (reg-resolve p)] + (when p + (case op + ::accept nil + nil (let [ret (dt p x p)] + (when-not (= ::invalid ret) (accept ret))) + ::amp (when-let [p1 (deriv p1 x)] + (amp-impl p1 ps forms)) + ::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret}) + (when (accept-nil? p0) (deriv (pcat* {:ps pr, :ks kr, :forms (next forms), :ret (add-ret p0 ret k0)}) x))) + ::alt (alt* (map #(deriv % x) ps) ks forms) + ::rep (rep* (deriv p1 x) p2 ret splice forms))))) + +(defn- op-describe [p] + ;;(prn {:op op :ks ks :forms forms}) + (let [{:keys [::op ps ks forms splice p1] :as p} (reg-resolve p)] + (when p + (case op + ::accept nil + nil p + ::amp (list* 'clojure.spec/& (op-describe p1) forms) + ::pcat (cons `cat (mapcat vector ks forms)) + ::alt (cons `alt (mapcat vector ks forms)) + ::rep (list (if splice `+ `*) forms))))) + +(defn- op-explain [form p path via input] + ;;(prn {:form form :p p :path path :input input}) + (let [[x :as input] input + via (if-let [name (spec-name p)] (conj via name) via) + {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve p) + insufficient (fn [path form] + {path {:reason "Insufficient input" + :pred (abbrev form) + :val () + :via via}})] + (when p + (case op + nil (if (empty? input) + (insufficient path form) + (explain-1 form p path via x)) + ::amp (if (empty? input) + (if (accept-nil? p1) + (explain-pred-list forms ps path via (preturn p1)) + (insufficient path (op-describe p1))) + (if-let [p1 (deriv p1 x)] + (explain-pred-list forms ps path via (preturn p1)) + (op-explain (op-describe p1) p1 path via input))) + ::pcat (let [[pred k form] (->> (map vector + ps + (c/or (seq ks) (repeat nil)) + (c/or (seq forms) (repeat nil))) + (remove (fn [[p]] + (accept-nil? p))) + first) + path (if k (conj path k) path) + form (c/or form (op-describe pred))] + (if (c/and (empty? input) (not pred)) + (insufficient path form) + (op-explain form pred path via input))) + ::alt (if (empty? input) + (insufficient path (op-describe p)) + (apply merge + (map (fn [k form pred] + (op-explain (c/or form (op-describe pred)) + pred + (if k (conj path k) path) + via + input)) + (c/or (seq ks) (repeat nil)) + (c/or (seq forms) (repeat nil)) + ps))) + ::rep (op-explain (if (identical? p1 p2) + forms + (op-describe p1)) + p1 path via input))))) + +(defn- re-gen [p overrides path rmap f] + ;;(prn {:op op :ks ks :forms forms}) + (let [{:keys [::op ps ks p1 p2 forms splice ret id] :as p} (reg-resolve p) + rmap (if id (inck rmap id) rmap) + ggens (fn [ps ks forms] + (let [gen (fn [p k f] + ;;(prn {:k k :path path :rmap rmap :op op :id id}) + (when-not (c/and rmap id k (recur-limit? rmap id path k)) + (re-gen p overrides (if k (conj path k) path) rmap (c/or f p))))] + (map gen ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)))))] + (c/or (when-let [g (get overrides path)] + (case op + (:accept nil) (gen/fmap vector g) + g)) + (when p + (case op + ::accept (if (= ret ::nil) + (gen/return []) + (gen/return [ret])) + nil (when-let [g (gensub p overrides path rmap f)] + (gen/fmap vector g)) + ::amp (re-gen p1 overrides path rmap (op-describe p1)) + ::pcat (let [gens (ggens ps ks forms)] + (when (every? identity gens) + (apply gen/cat gens))) + ::alt (let [gens (remove nil? (ggens ps ks forms))] + (when-not (empty? gens) + (gen/one-of gens))) + ::rep (if (recur-limit? rmap id [id] id) + (gen/return []) + (when-let [g (re-gen p2 overrides path rmap forms)] + (gen/fmap #(apply concat %) + (gen/vector g))))))))) + +(defn- re-conform [p [x & xs :as data]] + ;;(prn {:p p :x x :xs xs}) + (if (empty? data) + (if (accept-nil? p) + (let [ret (preturn p)] + (if (= ret ::nil) + nil + ret)) + ::invalid) + (if-let [dp (deriv p x)] + (recur dp xs) + ::invalid))) + +(defn- re-explain [path via re input] + (loop [p re [x & xs :as data] input] + ;;(prn {:p p :x x :xs xs}) (prn) + (if (empty? data) + (if (accept-nil? p) + nil ;;success + (op-explain (op-describe p) p path via nil)) + (if-let [dp (deriv p x)] + (recur dp xs) + (if (accept? p) + {path {:reason "Extra input" + :pred (abbrev (op-describe re)) + :val data + :via via}} + (c/or (op-explain (op-describe p) p path via (seq data)) + {path {:reason "Extra input" + :pred (abbrev (op-describe p)) + :val data + :via via}})))))) + +(defn ^:skip-wiki regex-spec-impl + "Do not call this directly, use 'spec' with a regex op argument" + [re gfn] + (reify + clojure.lang.IFn + (invoke [this x] (valid? this x)) + Spec + (conform* [_ x] + (if (c/or (nil? x) (coll? x)) + (re-conform re (seq x)) + ::invalid)) + (explain* [_ path via x] + (if (c/or (nil? x) (coll? x)) + (re-explain path via re (seq x)) + {path {:pred (abbrev (op-describe re)) :val x :via via}})) + (gen* [_ overrides path rmap] + (if gfn + (gfn) + (re-gen re overrides path rmap (op-describe re)))) + (describe* [_] (op-describe re)))) + +;;;;;;;;;;;;;;;;; HOFs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- call-valid? + [f specs args] + (let [cargs (conform (:args specs) args)] + (when-not (= cargs ::invalid) + (let [ret (apply f args) + cret (conform (:ret specs) ret)] + (c/and (not= cret ::invalid) + (if (:fn specs) + (valid? (:fn specs) {:args cargs :ret cret}) + true)))))) + +(defn- validate-fn + "returns f if valid, else smallest" + [f specs iters] + (let [g (gen (:args specs)) + prop (gen/for-all* [g] #(call-valid? f specs %))] + (let [ret (gen/quick-check iters prop)] + (if-let [[smallest] (-> ret :shrunk :smallest)] + smallest + f)))) + +(defn ^:skip-wiki fspec-impl + "Do not call this directly, use 'fspec'" + [argspec aform retspec rform fnspec fform gfn] + (assert (c/and argspec retspec)) + (let [specs {:args argspec :ret retspec :fn fnspec}] + (reify + clojure.lang.IFn + (invoke [this x] (valid? this x)) + Spec + (conform* [_ f] (if (fn? f) + (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) + ::invalid)) + (explain* [_ path via f] + (if (fn? f) + (let [args (validate-fn f specs 100)] + (if (identical? f args) ;;hrm, we might not be able to reproduce + nil + (let [ret (try (apply f args) (catch Throwable t t))] + (if (instance? Throwable ret) + ;;TODO add exception data + {path {:pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via}} + + (let [cret (dt retspec ret rform)] + (if (= ::invalid cret) + (explain-1 rform retspec (conj path :ret) via ret) + (when fnspec + (let [cargs (conform argspec args)] + (explain-1 fform fnspec (conj path :fn) via {:args cargs :ret cret}))))))))) + {path {:pred 'fn? :val f :via via}})) + (gen* [_ _ _ _] (if gfn + (gfn) + (when-not fnspec + (gen/return + (fn [& args] + (assert (valid? argspec args) (with-out-str (explain argspec args))) + (gen/generate (gen retspec))))))) + (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn)) + (describe* [_] `(fspec ~aform ~rform ~fform))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(clojure.spec/def ::any (spec (constantly true) :gen gen/any)) +(clojure.spec/def ::kvs->map (conformer #(zipmap (map ::k %) (map ::v %)))) + +(defmacro keys* + "takes the same arguments as spec/keys and returns a regex op that matches sequences of key/values, + converts them into a map, and conforms that map with a corresponding + spec/keys call: + + user=> (s/conform (s/keys :req-un [::a ::c]) {:a 1 :c 2}) + {:a 1, :c 2} + user=> (s/conform (s/keys* :req-un [::a ::c]) [:a 1 :c 2]) + {:a 1, :c 2} + + the resulting regex op can be composed into a larger regex: + + user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99]) + {:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}" + [& kspecs] + `(clojure.spec/& (* (cat ::k keyword? ::v ::any)) ::kvs->map (keys ~@kspecs))) + +(defmacro nilable + "returns a spec that accepts nil and values satisfiying pred" + [pred] + `(and (or ::nil nil? ::pred ~pred) (conformer second))) + +(defn exercise + "generates a number (default 10) of values compatible with spec and maps conform over them, + returning a sequence of [val conformed-val] tuples. Optionally takes + a generator overrides map as per gen" + ([spec] (exercise spec 10)) + ([spec n] (exercise spec n nil)) + ([spec n overrides] + (map #(vector % (conform spec %)) (gen/sample (gen spec overrides) n)))) + +(defn coll-checker + "returns a predicate function that checks *coll-check-limit* items in a collection with pred" + [pred] + (let [check? #(valid? pred %)] + (fn [coll] + (c/or (nil? coll) + (c/and + (coll? coll) + (every? check? (take *coll-check-limit* coll))))))) + +(defn coll-gen + "returns a function of no args that returns a generator of + collections of items conforming to pred, with the same shape as + init-coll" + [pred init-coll] + (let [init (empty init-coll)] + (fn [] + (gen/fmap + #(if (vector? init) % (into init %)) + (gen/vector (gen pred)))))) + +(defmacro coll-of + "Returns a spec for a collection of items satisfying pred. The generator will fill an empty init-coll." + [pred init-coll] + `(spec (coll-checker ~pred) :gen (coll-gen ~pred ~init-coll))) + +(defmacro map-of + "Returns a spec for a map whose keys satisfy kpred and vals satisfy vpred." + [kpred vpred] + `(and (coll-of (tuple ~kpred ~vpred) {}) map?)) + + diff --git a/src/clj/clojure/spec/gen.clj b/src/clj/clojure/spec/gen.clj new file mode 100644 index 00000000..b986790e --- /dev/null +++ b/src/clj/clojure/spec/gen.clj @@ -0,0 +1,175 @@ +; Copyright (c) Rich Hickey. 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.spec.gen + (:refer-clojure :exclude [boolean cat hash-map list map not-empty set vector + char double int keyword symbol string uuid])) + +(alias 'c 'clojure.core) + +(defn- dynaload + [s] + (let [ns (namespace s)] + (assert ns) + (require (c/symbol ns)) + (let [v (resolve s)] + (if v + @v + (throw (RuntimeException. (str "Var " s " is not on the classpath"))))))) + +(def ^:private quick-check-ref + (delay (dynaload 'clojure.test.check/quick-check))) +(defn quick-check + [& args] + (apply @quick-check-ref args)) + +(def ^:private for-all*-ref + (delay (dynaload 'clojure.test.check.properties/for-all*))) +(defn for-all* + "Dynamically loaded clojure.test.check.properties/for-all*." + [& args] + (apply @for-all*-ref args)) + +(let [g? (delay (dynaload 'clojure.test.check.generators/generator?)) + g (delay (dynaload 'clojure.test.check.generators/generate))] + (defn- generator? + [x] + (@g? x)) + (defn generate + "Generate a single value using generator." + [generator] + (@g generator))) + +(defn gen-for-name + "Dynamically loads test.check generator named s." + [s] + (let [g (dynaload s)] + (if (generator? g) + g + (throw (RuntimeException. (str "Var " s " is not a generator")))))) + +(defmacro ^:skip-wiki lazy-combinator + "Implementation macro, do not call directly." + [s] + (let [fqn (c/symbol "clojure.test.check.generators" (name s)) + doc (str "Lazy loaded version of " fqn)] + `(let [g# (delay (dynaload '~fqn))] + (defn ~s + ~doc + [& ~'args] + (apply @g# ~'args))))) + +(defmacro ^:skip-wiki lazy-combinators + "Implementation macro, do not call directly." + [& syms] + `(do + ~@(c/map + (fn [s] (c/list 'lazy-combinator s)) + syms))) + +(lazy-combinators hash-map list map not-empty set vector fmap elements + bind choose fmap one-of such-that tuple sample return) + +(defmacro ^:skip-wiki lazy-prim + "Implementation macro, do not call directly." + [s] + (let [fqn (c/symbol "clojure.test.check.generators" (name s)) + doc (str "Fn returning " fqn)] + `(let [g# (delay (dynaload '~fqn))] + (defn ~s + ~doc + [& ~'args] + @g#)))) + +(defmacro ^:skip-wiki lazy-prims + "Implementation macro, do not call directly." + [& syms] + `(do + ~@(c/map + (fn [s] (c/list 'lazy-prim s)) + syms))) + +(lazy-prims any any-printable boolean char char-alpha char-alphanumeric char-ascii double + int keyword keyword-ns large-integer ratio simple-type simple-type-printable + string string-ascii string-alphanumeric symbol symbol-ns uuid) + +(defn cat + "Returns a generator of a sequence catenated from results of +gens, each of which should generate something sequential." + [& gens] + (fmap #(apply concat %) + (apply tuple gens))) + +(def ^:private + gen-builtins + (delay + (let [simple (simple-type-printable)] + {number? (one-of [(large-integer) (double)]) + integer? (large-integer) + float? (double) + string? (string-alphanumeric) + keyword? (keyword-ns) + symbol? (symbol-ns) + map? (map simple simple) + vector? (vector simple) + list? (list simple) + seq? (list simple) + char? (char) + set? (set simple) + nil? (return nil) + false? (return false) + true? (return true) + zero? (return 0) + rational? (one-of [(large-integer) (ratio)]) + coll? (one-of [(map simple simple) + (list simple) + (vector simple) + (set simple)]) + empty? (elements [nil '() [] {} #{}]) + associative? (one-of [(map simple simple) (vector simple)]) + sequential? (one-of [(list simple) (vector simple)]) + ratio? (such-that ratio? (ratio))}))) + +(defn gen-for-pred + "Given a predicate, returns a built-in generator if one exists." + [pred] + (if (set? pred) + (elements pred) + (get @gen-builtins pred))) + +(comment + (require :reload 'clojure.spec.gen) + (in-ns 'clojure.spec.gen) + + ;; combinators, see call to lazy-combinators above for complete list + (generate (one-of [(gen-for-pred integer?) (gen-for-pred string?)])) + (generate (such-that #(< 10000 %) (gen-for-pred integer?))) + (let [reqs {:a (gen-for-pred number?) + :b (gen-for-pred ratio?)} + opts {:c (gen-for-pred string?)}] + (generate (bind (choose 0 (count opts)) + #(let [args (concat (seq reqs) (shuffle (seq opts)))] + (->> args + (take (+ % (count reqs))) + (mapcat identity) + (apply hash-map)))))) + (generate (cat (list (gen-for-pred string?)) + (list (gen-for-pred ratio?)))) + + ;; load your own generator + (gen-for-name 'clojure.test.check.generators/int) + + ;; failure modes + (gen-for-name 'unqualified) + (gen-for-name 'clojure.core/+) + (gen-for-name 'clojure.core/name-does-not-exist) + (gen-for-name 'ns.does.not.exist/f) + + ) + + diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj new file mode 100644 index 00000000..ebe3dd88 --- /dev/null +++ b/src/clj/clojure/spec/test.clj @@ -0,0 +1,147 @@ +; Copyright (c) Rich Hickey. 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.spec.test + (:require + [clojure.spec :as spec] + [clojure.spec.gen :as gen])) + +;; wrap spec/explain-data until specs always return nil for ok data +(defn- explain-data* + [spec v] + (when-not (spec/valid? spec v nil) + (spec/explain-data spec v))) + +;; wrap and unwrap spec failure data in an exception so that +;; quick-check will treat it as a failure. +(defn- wrap-failing + [explain-data step] + (ex-info "Wrapper" {::check-call (assoc explain-data :failed-on step)})) + +(defn- unwrap-failing + [ret] + (let [ret (if-let [explain (-> ret :result ex-data ::check-call)] + (assoc ret :result explain) + ret)] + (if-let [shrunk-explain (-> ret :shrunk :result ex-data ::check-call)] + (assoc-in ret [:shrunk :result] shrunk-explain)))) + +(defn- check-call + "Returns true if call passes specs, otherwise *returns* an exception +with explain-data plus a :failed-on key under ::check-call." + [f specs args] + (let [cargs (when (:args specs) (spec/conform (:args specs) args))] + (if (= cargs ::spec/invalid) + (wrap-failing (explain-data* (:args specs) args) :args) + (let [ret (apply f args) + cret (when (:ret specs) (spec/conform (:ret specs) ret))] + (if (= cret ::spec/invalid) + (wrap-failing (explain-data* (:ret specs) ret) :ret) + (if (and (:args specs) (:ret specs) (:fn specs)) + (if (spec/valid? (:fn specs) {:args cargs :ret cret}) + true + (wrap-failing (explain-data* (:fn specs) {:args cargs :ret cret}) :fn)) + true)))))) + +(defn check-fn + "Check a function using provided specs and test.check. +Same options and return as check-var" + [f specs + & {:keys [num-tests seed max-size reporter-fn] + :or {num-tests 100 max-size 200 reporter-fn (constantly nil)}}] + (let [g (spec/gen (:args specs)) + prop (gen/for-all* [g] #(check-call f specs %))] + (let [ret (gen/quick-check num-tests prop :seed seed :max-size max-size :reporter-fn reporter-fn)] + (if-let [[smallest] (-> ret :shrunk :smallest)] + (unwrap-failing ret) + ret)))) + +(defn check-var + "Checks a var's specs using test.check. Optional args are +passed through to test.check/quick-check: + + num-tests number of tests to run, default 100 + seed random seed + max-size how large an input to generate, max 200 + reporter-fn reporting fn + +Returns a map as quick-check, with :explain-data added if +:result is false." + [v & opts] + (let [specs (spec/fn-specs v)] + (if (:args specs) + (apply check-fn @v specs opts) + (throw (IllegalArgumentException. (str "No :args spec for " v)))))) + +(defn- run-var-tests + "Helper for run-tests, run-all-tests." + [vs] + (let [reporter-fn println] + (reduce + (fn [totals v] + (let [_ (println "Checking" v) + ret (check-var v :reporter-fn reporter-fn)] + (prn ret) + (cond-> totals + true (update :test inc) + (true? (:result ret)) (update :pass inc) + (::spec/problems (:result ret)) (update :fail inc) + (instance? Throwable (:result ret)) (update :error inc)))) + {:test 0, :pass 0, :fail 0, :error 0} + vs))) + +(defn run-tests + "Like run-all-tests, but scoped to specific namespaces, or to +*ns* if no ns-sym are specified." + [& ns-syms] + (if (seq ns-syms) + (run-var-tests (->> (apply spec/speced-vars ns-syms) + (filter (fn [v] (:args (spec/fn-specs v)))))) + (run-tests (.name ^clojure.lang.Namespace *ns*)))) + +(defn run-all-tests + "Like clojure.test/run-all-tests, but runs test.check tests +for all speced vars. Prints per-test results to *out*, and +returns a map with :test,:pass,:fail, and :error counts." + [] + (run-var-tests (spec/speced-vars))) + +(comment + (require '[clojure.pprint :as pp] + '[clojure.spec :as s] + '[clojure.spec.gen :as gen] + '[clojure.test :as ctest]) + + (require :reload '[clojure.spec.test :as test]) + + (load-file "examples/broken_specs.clj") + (load-file "examples/correct_specs.clj") + + ;; discover speced vars for your own test runner + (s/speced-vars) + + ;; check a single var + (test/check-var #'-) + (test/check-var #'+) + (test/check-var #'clojure.spec.broken-specs/throwing-fn) + + ;; old style example tests + (ctest/run-all-tests) + + (s/speced-vars 'clojure.spec.correct-specs) + ;; new style spec tests return same kind of map + (test/check-var #'subs) + (clojure.spec.test/run-tests 'clojure.core) + (test/run-all-tests) + + ) + + + + + diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj new file mode 100644 index 00000000..58ba334a --- /dev/null +++ b/test/clojure/test_clojure/spec.clj @@ -0,0 +1,180 @@ +(ns clojure.test-clojure.spec + (:require [clojure.spec :as s] + [clojure.spec.gen :as gen] + [clojure.spec.test :as stest] + [clojure.test :refer :all])) + +(set! *warn-on-reflection* true) + +(defmacro result-or-ex [x] + `(try + ~x + (catch Throwable t# + (.getName (class t#))))) + +(def even-count? #(even? (count %))) + +(deftest conform-explain + (let [a (s/and #(> % 5) #(< % 10)) + o (s/or :s string? :k keyword?) + c (s/cat :a string? :b keyword?) + either (s/alt :a string? :b keyword?) + star (s/* keyword?) + plus (s/+ keyword?) + opt (s/? keyword?) + andre (s/& (s/* keyword?) even-count?) + m (s/map-of keyword? string?) + coll (s/coll-of keyword? [])] + (are [spec x conformed ed] + (let [co (result-or-ex (s/conform spec x)) + e (result-or-ex (::s/problems (s/explain-data spec x)))] + (when (not= conformed co) (println "conform fail\n\texpect=" conformed "\n\tactual=" co)) + (when (not= ed e) (println "explain fail\n\texpect=" ed "\n\tactual=" e)) + (and (= conformed co) (= ed e))) + + keyword? :k :k nil + keyword? nil ::s/invalid {[] {:pred ::s/unknown :val nil :via []}} + keyword? "abc" ::s/invalid {[] {:pred ::s/unknown :val "abc" :via []}} + + a 6 6 nil + a 3 ::s/invalid '{[] {:pred (> % 5), :val 3 :via []}} + a 20 ::s/invalid '{[] {:pred (< % 10), :val 20 :via []}} + a nil "java.lang.NullPointerException" "java.lang.NullPointerException" + a :k "java.lang.ClassCastException" "java.lang.ClassCastException" + + o "a" [:s "a"] nil + o :a [:k :a] nil + o 'a ::s/invalid '{[:s] {:pred string?, :val a :via []}, [:k] {:pred keyword?, :val a :via []}} + + c nil ::s/invalid '{[:a] {:reason "Insufficient input", :pred string?, :val (), :via []}} + c [] ::s/invalid '{[:a] {:reason "Insufficient input", :pred string?, :val (), :via []}} + c [:a] ::s/invalid '{[:a] {:pred string?, :val :a, :via []}} + c ["a"] ::s/invalid '{[:b] {:reason "Insufficient input", :pred keyword?, :val (), :via []}} + c ["s" :k] '{:a "s" :b :k} nil + c ["s" :k 5] ::s/invalid '{[] {:reason "Extra input", :pred (cat :a string? :b keyword?), :val (5), :via []}} + + either nil ::s/invalid '{[] {:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}} + either [] ::s/invalid '{[] {:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}} + either [:k] [:b :k] nil + either ["s"] [:a "s"] nil + either [:b "s"] ::s/invalid '{[] {:reason "Extra input", :pred (alt :a string? :b keyword?), :val ("s") :via []}} + + star nil [] nil + star [] [] nil + star [:k] [:k] nil + star [:k1 :k2] [:k1 :k2] nil + star [:k1 :k2 "x"] ::s/invalid '{[] {:pred keyword?, :val "x" :via []}} + star ["a"] ::s/invalid {[] '{:pred keyword?, :val "a" :via []}} + + plus nil ::s/invalid '{[] {:reason "Insufficient input", :pred keyword?, :val () :via []}} + plus [] ::s/invalid '{[] {:reason "Insufficient input", :pred keyword?, :val () :via []}} + plus [:k] [:k] nil + plus [:k1 :k2] [:k1 :k2] nil + plus [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (cat), :val ("x") :via []}} + plus ["a"] ::s/invalid '{[] {:pred keyword?, :val "a" :via []}} + + opt nil nil nil + opt [] nil nil + opt :k ::s/invalid '{[] {:pred (alt), :val :k, :via []}} + opt [:k] :k nil + opt [:k1 :k2] ::s/invalid '{[] {:reason "Extra input", :pred (alt), :val (:k2), :via []}} + opt [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (alt), :val (:k2 "x"), :via []}} + opt ["a"] ::s/invalid "java.lang.IllegalArgumentException" + + andre nil nil nil + andre [] nil nil + andre :k :clojure.spec/invalid '{[] {:pred (& (* keyword?) even-count?), :val :k, :via []}} + andre [:k] ::s/invalid '{[] {:pred even-count?, :val [:k], :via []}} + andre [:j :k] [:j :k] nil + + m nil ::s/invalid '{[] {:pred map?, :val nil, :via []}} + m {} {} nil + m {:a "b"} {:a "b"} nil + m {:a :b} ::s/invalid '{[] {:pred (coll-checker (tuple keyword? string?)), :val {:a :b}, :via []}} + + coll nil nil nil + coll [] [] nil + coll [:a] [:a] nil + coll [:a :b] [:a :b] nil + ;;coll [:a "b"] ::s/invalid '{[] {:pred (coll-checker keyword?), :val [:a b], :via []}} + ))) + +(s/fdef flip-nums + :args (s/cat :arg1 integer? :arg2 integer?) + :ret vector? + :fn (fn [{:keys [args ret]}] + (= ret [(:arg2 args) (:arg1 args)]))) + +(def ^:dynamic *break-flip-nums* false) +(defn flip-nums + "Set *break-flip-nums* to break this fns compatibility with +its spec for test purposes." + [a b] + (if *break-flip-nums* + (when-not (= a b) + (vec (sort [a b]))) + [b a])) + +(defmacro get-ex-data + [x] + `(try + ~x + nil + (catch Throwable t# + (ex-data t#)))) + +;; Note the the complicated equality comparisons below are exactly the +;; kind of thing that spec helps you avoid, used here only because we +;; are near the bottom, testing spec itself. +(deftest test-instrument-flip-nums + (when-not (= "true" (System/getProperty "clojure.compiler.direct-linking")) + (binding [*break-flip-nums* true] + (try + (= [1 2] (flip-nums 2 1)) + (= [:a :b] (flip-nums :a :b)) + (= [1 2] (flip-nums 1 2)) + (is (nil? (flip-nums 1 1))) + (s/instrument `flip-nums) + (is (= [1 2] (flip-nums 2 1))) + (is (= '{:clojure.spec/problems {[:args :arg1] {:pred integer?, :val :a, :via []}}, :clojure.spec/args (:a :b)} + (get-ex-data (flip-nums :a :b)))) + (is (= '{:clojure.spec/problems {[:fn] {:pred (fn [{:keys [args ret]}] (= ret [(:arg2 args) (:arg1 args)])), :val {:args {:arg1 1, :arg2 2}, :ret [1 2]}, :via []}}, :clojure.spec/args (1 2)} + (get-ex-data (flip-nums 1 2)))) + (is (= '{:clojure.spec/problems {[:ret] {:pred vector?, :val nil, :via []}}, :clojure.spec/args (1 1)} + (get-ex-data (flip-nums 1 1)))) + (s/unstrument `flip-nums) + (= [1 2] (flip-nums 2 1)) + (= [:a :b] (flip-nums :a :b)) + (= [1 2] (flip-nums 1 2)) + (is (nil? (flip-nums 1 1))) + (s/unstrument `flip-nums))))) + +(def core-pred-syms + (into #{} + (comp (map first) (filter (fn [s] (.endsWith (name s) "?")))) + (ns-publics 'clojure.core))) + +(def generatable-core-pred-syms + (into #{} + (filter #(gen/gen-for-pred @ (resolve %))) + core-pred-syms)) + +(s/fdef generate-from-core-pred + :args (s/cat :s generatable-core-pred-syms) + :ret ::s/any + :fn (fn [{:keys [args ret]}] + (@(resolve (:s args)) ret))) + +(defn generate-from-core-pred + [s] + (gen/generate (gen/gen-for-pred @(resolve s)))) + +(comment + (require '[clojure.test :refer (run-tests)]) + (in-ns 'test-clojure.spec) + (run-tests) + + (stest/run-all-tests) + (stest/check-var #'generate-from-core-pred :num-tests 10000) + + ) From 4c8efbc42efa22ec1d08a1e9fa5dd25db99766a9 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Sat, 21 May 2016 12:13:50 -0500 Subject: [PATCH 003/246] Enhance doc to include spec and to doc registered specs Signed-off-by: Rich Hickey --- src/clj/clojure/repl.clj | 49 ++++++++++++++++++++++++++-------------- 1 file changed, 32 insertions(+), 17 deletions(-) diff --git a/src/clj/clojure/repl.clj b/src/clj/clojure/repl.clj index 70ea94f5..f38e2f49 100644 --- a/src/clj/clojure/repl.clj +++ b/src/clj/clojure/repl.clj @@ -12,6 +12,7 @@ ^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim" :doc "Utilities meant to be used interactively at the REPL"} clojure.repl + (:require [clojure.spec :as spec]) (:import (java.io LineNumberReader InputStreamReader PushbackReader) (clojure.lang RT Reflector))) @@ -79,27 +80,39 @@ itself (not its value) is returned. The reader macro #'x expands to (var x)."}}) (defn- namespace-doc [nspace] (assoc (meta nspace) :name (ns-name nspace))) -(defn- print-doc [m] +(defn- print-doc [{n :ns + nm :name + :keys [forms arglists special-form doc url macro spec] + :as m}] (println "-------------------------") - (println (str (when-let [ns (:ns m)] (str (ns-name ns) "/")) (:name m))) + (println (or spec (str (when n (str (ns-name n) "/")) nm))) + (when forms + (doseq [f forms] + (print " ") + (prn f))) + (when arglists + (prn arglists)) (cond - (:forms m) (doseq [f (:forms m)] - (print " ") - (prn f)) - (:arglists m) (prn (:arglists m))) - (if (:special-form m) + special-form (do (println "Special Form") - (println " " (:doc m)) + (println " " doc) (if (contains? m :url) - (when (:url m) - (println (str "\n Please see http://clojure.org/" (:url m)))) - (println (str "\n Please see http://clojure.org/special_forms#" - (:name m))))) - (do - (when (:macro m) - (println "Macro")) - (println " " (:doc m))))) + (when url + (println (str "\n Please see http://clojure.org/" url))) + (println (str "\n Please see http://clojure.org/special_forms#" nm)))) + macro + (println "Macro") + spec + (println "Spec")) + (when doc (println " " doc)) + (when n + (when-let [specs (spec/fn-specs (symbol (str (ns-name n)) (name nm)))] + (println "Spec") + (run! (fn [[role spec]] + (when (and spec (not (= spec ::spec/unknown))) + (println " " (str (name role) ":") (spec/describe spec)))) + specs)))) (defn find-doc "Prints documentation for any var whose documentation or name @@ -118,13 +131,15 @@ itself (not its value) is returned. The reader macro #'x expands to (var x)."}}) (print-doc m)))) (defmacro doc - "Prints documentation for a var or special form given its name" + "Prints documentation for a var or special form given its name, + or for a spec if given a keyword" {:added "1.0"} [name] (if-let [special-name ('{& fn catch try finally try} name)] (#'print-doc (#'special-doc special-name)) (cond (special-doc-map name) `(#'print-doc (#'special-doc '~name)) + (keyword? name) `(#'print-doc {:spec '~name :doc '~(spec/describe name)}) (find-ns name) `(#'print-doc (#'namespace-doc (find-ns '~name))) (resolve name) `(#'print-doc (meta (var ~name)))))) From 7f5f53b881b15aaf81bac40d218a3eb535e90193 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Mon, 23 May 2016 13:51:38 -0400 Subject: [PATCH 004/246] check specs on macroexpand Signed-off-by: Rich Hickey --- src/clj/clojure/core.clj | 2 ++ src/jvm/clojure/lang/Compiler.java | 21 ++++++++++++++++++--- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 32d04d8e..cf49bb63 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -7512,6 +7512,8 @@ (reduce load-data-reader-file mappings (data-reader-urls))))) +(load "spec") + (try (load-data-readers) (catch Throwable t diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index 60668258..e096adb0 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -6771,17 +6771,32 @@ public static Object macroexpand1(Object x) { Var v = isMacro(op); if(v != null) { + ISeq args = RT.cons(form, RT.cons(Compiler.LOCAL_ENV.get(), form.next())); try { - return v.applyTo(RT.cons(form,RT.cons(LOCAL_ENV.get(),form.next()))); + final Namespace checkns = Namespace.find(Symbol.intern("clojure.spec")); + if (checkns != null) + { + final Var check = Var.find(Symbol.intern("clojure.spec/macroexpand-check")); + if ((check != null) && (check.isBound())) + check.applyTo(RT.cons(v, RT.list(args))); + } + Symbol.intern("clojure.spec"); + } + catch(IllegalArgumentException e) + { + throw new CompilerException((String) SOURCE_PATH.deref(), lineDeref(), columnDeref(), e); + } + try + { + return v.applyTo(args); } catch(ArityException e) { // hide the 2 extra params for a macro throw new ArityException(e.actual - 2, e.name); } - } - else + } else { if(op instanceof Symbol) { From db17177f01a2d100f454db1d74f070fe1e764e5d Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 23 May 2016 14:58:46 -0400 Subject: [PATCH 005/246] add recursion limit to multi-spec, lower default limit to 4 --- src/clj/clojure/spec.clj | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 386a765d..03de2659 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -17,10 +17,10 @@ (set! *warn-on-reflection* true) (def ^:dynamic *recursion-limit* - "A soft limit on how many times a branching spec (or/alt/*/opt-keys) + "A soft limit on how many times a branching spec (or/alt/*/opt-keys/multi-spec) can be recursed through during generation. After this a non-recursive branch will be chosen." - 10) + 4) (def ^:dynamic *fspec-iterations* "The number of times an anonymous fn specified by fspec will be (generatively) tested during conform" @@ -830,7 +830,8 @@ by ns-syms. Idempotent." (assert (when-let [dm (-> (methods @mmvar) ::invalid)] (nil? (dm nil))) (str "Multimethod :" form " does not contain nil-returning default method for :clojure.spec/invalid" )) - (let [predx #(@mmvar %) + (let [id (java.util.UUID/randomUUID) + predx #(@mmvar %) tag (if (keyword? retag) #(assoc %1 retag %2) retag)] @@ -850,9 +851,12 @@ by ns-syms. Idempotent." (gfn) (let [gen (fn [[k f]] (let [p (f nil)] - (gen/fmap - #(tag % k) - (gensub p overrides path rmap (list 'method form k))))) + (let [idk [id k] + rmap (inck rmap idk)] + (when-not (recur-limit? rmap idk [idk] idk) + (gen/fmap + #(tag % k) + (gensub p overrides path rmap (list 'method form k))))))) gs (->> (methods @mmvar) (remove (fn [[k]] (= k ::invalid))) (map gen) @@ -941,7 +945,7 @@ by ns-syms. Idempotent." (let [gen (fn [k p f] (let [rmap (inck rmap id)] (when-not (recur-limit? rmap id path k) - (gensub p overrides (conj path k) rmap f)))) + (gensub p overrides (conj path k) rmap f)))) gs (remove nil? (map gen keys preds forms))] (when-not (empty? gs) (gen/one-of gs))))) From 9e7526072248e1a50a8c6055b6563033298cd9d0 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 23 May 2016 17:52:45 -0400 Subject: [PATCH 006/246] missing case in op-explain --- src/clj/clojure/spec.clj | 1 + 1 file changed, 1 insertion(+) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 03de2659..095f6e86 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1161,6 +1161,7 @@ by ns-syms. Idempotent." :via via}})] (when p (case op + ::accept nil nil (if (empty? input) (insufficient path form) (explain-1 form p path via x)) From 6e23d29115f3d63adbe1a601a84eae5658b52909 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 23 May 2016 17:15:57 -0500 Subject: [PATCH 007/246] opt test fix Signed-off-by: Rich Hickey --- test/clojure/test_clojure/spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 58ba334a..d2147fda 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -79,7 +79,7 @@ opt [:k] :k nil opt [:k1 :k2] ::s/invalid '{[] {:reason "Extra input", :pred (alt), :val (:k2), :via []}} opt [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (alt), :val (:k2 "x"), :via []}} - opt ["a"] ::s/invalid "java.lang.IllegalArgumentException" + opt ["a"] ::s/invalid '{[] {:pred keyword?, :val "a", :via []}} andre nil nil nil andre [] nil nil From 8213c934c0b5178aed731b433242b52ddc798cc0 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 23 May 2016 20:07:19 -0400 Subject: [PATCH 008/246] spec.gen and spec.test missing from build.xml, move spec load from core.clj to RT doInit --- build.xml | 2 ++ src/clj/clojure/core.clj | 2 -- src/jvm/clojure/lang/RT.java | 1 + 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/build.xml b/build.xml index f9764b36..a2e867c1 100644 --- a/build.xml +++ b/build.xml @@ -82,6 +82,8 @@ + + diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index cf49bb63..32d04d8e 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -7512,8 +7512,6 @@ (reduce load-data-reader-file mappings (data-reader-urls))))) -(load "spec") - (try (load-data-readers) (catch Throwable t diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index 324616e6..6faad4c7 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -459,6 +459,7 @@ else if(!loaded && failIfNotFound) static void doInit() throws ClassNotFoundException, IOException{ load("clojure/core"); + load("clojure/spec"); Var.pushThreadBindings( RT.mapUniqueKeys(CURRENT_NS, CURRENT_NS.deref(), From 37ec54584437b4d8beb3ffb3879068b9afe1de0b Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 24 May 2016 11:28:01 -0400 Subject: [PATCH 009/246] use delayed generators in branching (potentially recursive) specs --- src/clj/clojure/spec.clj | 18 +++++++++++------- src/clj/clojure/spec/gen.clj | 33 +++++++++++++++++++++++++-------- 2 files changed, 36 insertions(+), 15 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 095f6e86..c301c02d 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -20,7 +20,7 @@ "A soft limit on how many times a branching spec (or/alt/*/opt-keys/multi-spec) can be recursed through during generation. After this a non-recursive branch will be chosen." - 4) + 8) (def ^:dynamic *fspec-iterations* "The number of times an anonymous fn specified by fspec will be (generatively) tested during conform" @@ -778,7 +778,7 @@ by ns-syms. Idempotent." gen (fn [k s] (gensub s overrides (conj path k) rmap k)) ogen (fn [k s] (when-not (recur-limit? rmap id path k) - [k (gensub s overrides (conj path k) rmap k)])) + [k (gen/delay (gensub s overrides (conj path k) rmap k))])) req-gens (map gen req-keys req-specs) opt-gens (remove nil? (map ogen opt-keys opt-specs))] (when (every? identity (concat req-gens opt-gens)) @@ -854,9 +854,10 @@ by ns-syms. Idempotent." (let [idk [id k] rmap (inck rmap idk)] (when-not (recur-limit? rmap idk [idk] idk) - (gen/fmap - #(tag % k) - (gensub p overrides path rmap (list 'method form k))))))) + (gen/delay + (gen/fmap + #(tag % k) + (gensub p overrides path rmap (list 'method form k)))))))) gs (->> (methods @mmvar) (remove (fn [[k]] (= k ::invalid))) (map gen) @@ -945,7 +946,8 @@ by ns-syms. Idempotent." (let [gen (fn [k p f] (let [rmap (inck rmap id)] (when-not (recur-limit? rmap id path k) - (gensub p overrides (conj path k) rmap f)))) + (gen/delay + (gensub p overrides (conj path k) rmap f))))) gs (remove nil? (map gen keys preds forms))] (when-not (empty? gs) (gen/one-of gs))))) @@ -1209,7 +1211,9 @@ by ns-syms. Idempotent." (let [gen (fn [p k f] ;;(prn {:k k :path path :rmap rmap :op op :id id}) (when-not (c/and rmap id k (recur-limit? rmap id path k)) - (re-gen p overrides (if k (conj path k) path) rmap (c/or f p))))] + (if id + (gen/delay (re-gen p overrides (if k (conj path k) path) rmap (c/or f p))) + (re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))))] (map gen ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)))))] (c/or (when-let [g (get overrides path)] (case op diff --git a/src/clj/clojure/spec/gen.clj b/src/clj/clojure/spec/gen.clj index b986790e..a5ef475f 100644 --- a/src/clj/clojure/spec/gen.clj +++ b/src/clj/clojure/spec/gen.clj @@ -8,7 +8,7 @@ (ns clojure.spec.gen (:refer-clojure :exclude [boolean cat hash-map list map not-empty set vector - char double int keyword symbol string uuid])) + char double int keyword symbol string uuid delay])) (alias 'c 'clojure.core) @@ -23,28 +23,45 @@ (throw (RuntimeException. (str "Var " s " is not on the classpath"))))))) (def ^:private quick-check-ref - (delay (dynaload 'clojure.test.check/quick-check))) + (c/delay (dynaload 'clojure.test.check/quick-check))) (defn quick-check [& args] (apply @quick-check-ref args)) (def ^:private for-all*-ref - (delay (dynaload 'clojure.test.check.properties/for-all*))) + (c/delay (dynaload 'clojure.test.check.properties/for-all*))) (defn for-all* "Dynamically loaded clojure.test.check.properties/for-all*." [& args] (apply @for-all*-ref args)) -(let [g? (delay (dynaload 'clojure.test.check.generators/generator?)) - g (delay (dynaload 'clojure.test.check.generators/generate))] +(let [g? (c/delay (dynaload 'clojure.test.check.generators/generator?)) + g (c/delay (dynaload 'clojure.test.check.generators/generate)) + mkg (c/delay (dynaload 'clojure.test.check.generators/->Generator))] (defn- generator? [x] (@g? x)) + (defn- generator + [gfn] + (@mkg gfn)) (defn generate "Generate a single value using generator." [generator] (@g generator))) +(defn ^:skip-wiki delay-impl + [gfnd] + ;;N.B. depends on test.check impl details + (generator (fn [rnd size] + ((:gen @gfnd) rnd size)))) + +(defmacro delay + "given body that returns a generator, returns a + generator that delegates to that, but delays + creation until used." + [& body] + `(delay-impl (c/delay ~@body))) + (defn gen-for-name "Dynamically loads test.check generator named s." [s] @@ -58,7 +75,7 @@ [s] (let [fqn (c/symbol "clojure.test.check.generators" (name s)) doc (str "Lazy loaded version of " fqn)] - `(let [g# (delay (dynaload '~fqn))] + `(let [g# (c/delay (dynaload '~fqn))] (defn ~s ~doc [& ~'args] @@ -80,7 +97,7 @@ [s] (let [fqn (c/symbol "clojure.test.check.generators" (name s)) doc (str "Fn returning " fqn)] - `(let [g# (delay (dynaload '~fqn))] + `(let [g# (c/delay (dynaload '~fqn))] (defn ~s ~doc [& ~'args] @@ -107,7 +124,7 @@ gens, each of which should generate something sequential." (def ^:private gen-builtins - (delay + (c/delay (let [simple (simple-type-printable)] {number? (one-of [(large-integer) (double)]) integer? (large-integer) From f8539f55a78b2a19f7cca10d2ad7928156ae90fe Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 24 May 2016 11:46:36 -0500 Subject: [PATCH 010/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha1 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..bf20d32f 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha1 http://clojure.org/ Clojure core environment and runtime library. From 53a83f4b33c3763c57ae5cc9f444db787c560b6d Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 24 May 2016 11:46:36 -0500 Subject: [PATCH 011/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index bf20d32f..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha1 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From ac59179c09d57dc3db2cc078ac06845b625555da Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 24 May 2016 14:24:30 -0400 Subject: [PATCH 012/246] better describe for s/+ --- src/clj/clojure/spec.clj | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index c301c02d..97c2ac84 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1001,7 +1001,7 @@ by ns-syms. Idempotent." (defn- accept? [{:keys [::op]}] (= ::accept op)) -(defn- pcat* [{[p1 & pr :as ps] :ps, [k1 & kr :as ks] :ks, [f1 & fr :as forms] :forms, ret :ret}] +(defn- pcat* [{[p1 & pr :as ps] :ps, [k1 & kr :as ks] :ks, [f1 & fr :as forms] :forms, ret :ret, rep+ :rep+}] (when (every? identity ps) (if (accept? p1) (let [rp (:ret p1) @@ -1009,7 +1009,7 @@ by ns-syms. Idempotent." (if pr (pcat* {:ps pr :ks kr :forms fr :ret ret}) (accept ret))) - {::op ::pcat, :ps ps, :ret ret, :ks ks, :forms forms}))) + {::op ::pcat, :ps ps, :ret ret, :ks ks, :forms forms :rep+ rep+}))) (defn- pcat [& ps] (pcat* {:ps ps :ret []})) @@ -1032,7 +1032,7 @@ by ns-syms. Idempotent." (defn ^:skip-wiki rep+impl "Do not call this directly, use '+'" [form p] - (pcat* {:ps [p (rep* p p [] true form)] :forms `[~form (* ~form)] :ret []})) + (pcat* {:ps [p (rep* p p [] true form)] :forms `[~form (* ~form)] :ret [] :rep+ form})) (defn ^:skip-wiki amp-impl "Do not call this directly, use '&'" @@ -1139,15 +1139,17 @@ by ns-syms. Idempotent." ::alt (alt* (map #(deriv % x) ps) ks forms) ::rep (rep* (deriv p1 x) p2 ret splice forms))))) -(defn- op-describe [p] - ;;(prn {:op op :ks ks :forms forms}) - (let [{:keys [::op ps ks forms splice p1] :as p} (reg-resolve p)] +(defn- op-describe [p] + (let [{:keys [::op ps ks forms splice p1 rep+] :as p} (reg-resolve p)] + ;;(prn {:op op :ks ks :forms forms :p p}) (when p (case op ::accept nil nil p ::amp (list* 'clojure.spec/& (op-describe p1) forms) - ::pcat (cons `cat (mapcat vector ks forms)) + ::pcat (if rep+ + (list `+ rep+) + (cons `cat (mapcat vector ks forms))) ::alt (cons `alt (mapcat vector ks forms)) ::rep (list (if splice `+ `*) forms))))) From 6d68a0a955ac89ca5e5924ed1d31de373a97e4e4 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 24 May 2016 15:00:04 -0400 Subject: [PATCH 013/246] capture *recursion-limit* on gen call --- src/clj/clojure/spec.clj | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 97c2ac84..76f1e6b7 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -20,7 +20,7 @@ "A soft limit on how many times a branching spec (or/alt/*/opt-keys/multi-spec) can be recursed through during generation. After this a non-recursive branch will be chosen." - 8) + 4) (def ^:dynamic *fspec-iterations* "The number of times an anonymous fn specified by fspec will be (generatively) tested during conform" @@ -207,7 +207,7 @@ sequential collection (i.e. a generator for s/? should return either an empty sequence/vector or a sequence/vector with one item in it)" ([spec] (gen spec nil)) - ([spec overrides] (gensub spec overrides [] nil spec))) + ([spec overrides] (gensub spec overrides [] {::recursion-limit *recursion-limit*} spec))) (defn- ->sym "Returns a symbol from a symbol or var" @@ -697,7 +697,7 @@ by ns-syms. Idempotent." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- recur-limit? [rmap id path k] - (c/and (> (get rmap id) *recursion-limit*) + (c/and (> (get rmap id) (::recursion-limit rmap)) (contains? (set path) k))) (defn- inck [m k] From 0298149d169759eacef59702b26db008cd782dac Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 24 May 2016 17:28:42 -0400 Subject: [PATCH 014/246] first cut at capturing :in - path in input data, uses indexes in regexes --- src/clj/clojure/spec.clj | 116 +++++++++++++++-------------- test/clojure/test_clojure/spec.clj | 2 +- 2 files changed, 62 insertions(+), 56 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 76f1e6b7..63ee87b2 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -36,7 +36,7 @@ (defprotocol Spec (conform* [spec x]) - (explain* [spec path via x]) + (explain* [spec path via in x]) (gen* [spec overrides path rmap]) (with-gen* [spec gfn]) (describe* [spec])) @@ -139,8 +139,8 @@ [spec gen-fn] (with-gen* (specize spec) gen-fn)) -(defn explain-data* [spec path via x] - (when-let [probs (explain* (specize spec) path via x)] +(defn explain-data* [spec path via in x] + (when-let [probs (explain* (specize spec) path via in x)] {::problems probs})) (defn explain-data @@ -150,7 +150,7 @@ keys describing the predicate and the value that failed at that path." [spec x] - (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) x)) + (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) [] x)) (defn- explain-out "prints an explanation to *out*." @@ -158,19 +158,20 @@ (if ed (do ;;(prn {:ed ed}) - (doseq [[path {:keys [pred val reason via] :as prob}] (::problems ed)] - (when-not (empty? path) - (print "At:" path "")) + (doseq [[path {:keys [pred val reason via in] :as prob}] (::problems ed)] + (when-not (empty? in) + (print "In:" in "")) (print "val: ") (pr val) - (print " fails") - (when-let [specname (last via)] - (print " spec:" specname)) + (print " fails spec: ") + (print (c/or (last via) "_")) + (when-not (empty? path) + (print " at:" path)) (print " predicate: ") (pr pred) (when reason (print ", " reason)) (doseq [[k v] prob] - (when-not (#{:pred :val :reason :via} k) + (when-not (#{:pred :val :reason :via :in} k) (print "\n\t" k " ") (pr v))) (newline)) @@ -723,11 +724,12 @@ by ns-syms. Idempotent." ([spec x form] (not= ::invalid (dt spec x form)))) -(defn- explain-1 [form pred path via v] +(defn- explain-1 [form pred path via in v] + ;;(prn {:form form :pred pred :path path :in in :v v}) (let [pred (maybe-spec pred)] (if (spec? pred) - (explain* pred path (if-let [name (spec-name pred)] (conj via name) via) v) - {path {:pred (abbrev form) :val v :via via}}))) + (explain* pred path (if-let [name (spec-name pred)] (conj via name) via) in v) + {path {:pred (abbrev form) :val v :via via :in in}}))) (defn ^:skip-wiki map-spec-impl "Do not call this directly, use 'spec' with a map argument" @@ -756,20 +758,20 @@ by ns-syms. Idempotent." (recur ret ks)) ret))) ::invalid)) - (explain* [_ path via x] + (explain* [_ path via in x] (if-not (map? x) - {path {:pred 'map? :val x :via via}} + {path {:pred 'map? :val x :via via :in in}} (let [reg (registry)] (apply merge (when-let [probs (->> (map (fn [pred form] (when-not (pred x) (abbrev form))) pred-exprs pred-forms) (keep identity) seq)] - {path {:pred (vec probs) :val x :via via}}) + {path {:pred (vec probs) :val x :via via :in in}}) (map (fn [[k v]] (when-not (c/or (not (contains? reg (keys->specs k))) (valid? (keys->specs k) v k)) - (explain-1 (keys->specs k) (keys->specs k) (conj path k) via v))) + (explain-1 (keys->specs k) (keys->specs k) (conj path k) via (conj in k) v))) (seq x)))))) (gen* [_ overrides path rmap] (if gfn @@ -814,9 +816,9 @@ by ns-syms. Idempotent." (invoke [this x] (valid? this x)) Spec (conform* [_ x] (dt pred x form cpred?)) - (explain* [_ path via x] + (explain* [_ path via in x] (when (= ::invalid (dt pred x form cpred?)) - {path {:pred (abbrev form) :val x :via via}})) + {path {:pred (abbrev form) :val x :via via :in in}})) (gen* [_ _ _ _] (if gfn (gfn) (gen/gen-for-pred pred))) @@ -842,10 +844,10 @@ by ns-syms. Idempotent." (conform* [_ x] (if-let [pred (predx x)] (dt pred x form) ::invalid)) - (explain* [_ path via x] + (explain* [_ path via in x] (if-let [pred (predx x)] - (explain-1 form pred path via x) - {path {:pred form :val x :reason "no method" :via via}})) + (explain-1 form pred path via in x) + {path {:pred form :val x :reason "no method" :via via :in in}})) (gen* [_ overrides path rmap] (if gfn (gfn) @@ -888,20 +890,20 @@ by ns-syms. Idempotent." ::invalid (recur (if (identical? cv v) ret (assoc ret i cv)) (inc i)))))))) - (explain* [_ path via x] + (explain* [_ path via in x] (cond (not (vector? x)) - {path {:pred 'vector? :val x :via via}} + {path {:pred 'vector? :val x :via via :in in}} (not= (count x) (count preds)) - {path {:pred `(= (count ~'%) ~(count preds)) :val x :via via}} + {path {:pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}} :else (apply merge (map (fn [i form pred] (let [v (x i)] (when-not (valid? pred v) - (explain-1 form pred (conj path i) via v)))) + (explain-1 form pred (conj path i) via (conj in i) v)))) (range (count preds)) forms preds)))) (gen* [_ overrides path rmap] (if gfn @@ -933,12 +935,12 @@ by ns-syms. Idempotent." (invoke [this x] (valid? this x)) Spec (conform* [_ x] (cform x)) - (explain* [this path via x] + (explain* [this path via in x] (when-not (valid? this x) (apply merge (map (fn [k form pred] (when-not (valid? pred x) - (explain-1 form pred (conj path k) via x))) + (explain-1 form pred (conj path k) via in x))) keys forms preds)))) (gen* [_ overrides path rmap] (if gfn @@ -967,7 +969,7 @@ by ns-syms. Idempotent." ret))) (defn- explain-pred-list - [forms preds path via x] + [forms preds path via in x] (loop [ret x [form & forms] forms [pred & preds] preds] @@ -975,7 +977,7 @@ by ns-syms. Idempotent." (let [nret (dt pred ret form)] (if (not= ::invalid nret) (recur nret forms preds) - (explain-1 form pred path via ret)))))) + (explain-1 form pred path via in ret)))))) (defn ^:skip-wiki and-spec-impl "Do not call this directly, use 'and'" @@ -985,7 +987,7 @@ by ns-syms. Idempotent." (invoke [this x] (valid? this x)) Spec (conform* [_ x] (and-preds x preds forms)) - (explain* [_ path via x] (explain-pred-list forms preds path via x)) + (explain* [_ path via in x] (explain-pred-list forms preds path via in x)) (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms)))) (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) (describe* [_] `(and ~@forms)))) @@ -1153,7 +1155,7 @@ by ns-syms. Idempotent." ::alt (cons `alt (mapcat vector ks forms)) ::rep (list (if splice `+ `*) forms))))) -(defn- op-explain [form p path via input] +(defn- op-explain [form p path via in input] ;;(prn {:form form :p p :path path :input input}) (let [[x :as input] input via (if-let [name (spec-name p)] (conj via name) via) @@ -1162,20 +1164,21 @@ by ns-syms. Idempotent." {path {:reason "Insufficient input" :pred (abbrev form) :val () - :via via}})] + :via via + :in in}})] (when p (case op ::accept nil nil (if (empty? input) (insufficient path form) - (explain-1 form p path via x)) + (explain-1 form p path via in x)) ::amp (if (empty? input) (if (accept-nil? p1) - (explain-pred-list forms ps path via (preturn p1)) + (explain-pred-list forms ps path via in (preturn p1)) (insufficient path (op-describe p1))) (if-let [p1 (deriv p1 x)] - (explain-pred-list forms ps path via (preturn p1)) - (op-explain (op-describe p1) p1 path via input))) + (explain-pred-list forms ps path via in (preturn p1)) + (op-explain (op-describe p1) p1 path via in input))) ::pcat (let [[pred k form] (->> (map vector ps (c/or (seq ks) (repeat nil)) @@ -1187,7 +1190,7 @@ by ns-syms. Idempotent." form (c/or form (op-describe pred))] (if (c/and (empty? input) (not pred)) (insufficient path form) - (op-explain form pred path via input))) + (op-explain form pred path via in input))) ::alt (if (empty? input) (insufficient path (op-describe p)) (apply merge @@ -1196,6 +1199,7 @@ by ns-syms. Idempotent." pred (if k (conj path k) path) via + in input)) (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)) @@ -1203,7 +1207,7 @@ by ns-syms. Idempotent." ::rep (op-explain (if (identical? p1 p2) forms (op-describe p1)) - p1 path via input))))) + p1 path via in input))))) (defn- re-gen [p overrides path rmap f] ;;(prn {:op op :ks ks :forms forms}) @@ -1254,25 +1258,27 @@ by ns-syms. Idempotent." (recur dp xs) ::invalid))) -(defn- re-explain [path via re input] - (loop [p re [x & xs :as data] input] +(defn- re-explain [path via in re input] + (loop [p re [x & xs :as data] input i 0] ;;(prn {:p p :x x :xs xs}) (prn) (if (empty? data) (if (accept-nil? p) nil ;;success - (op-explain (op-describe p) p path via nil)) + (op-explain (op-describe p) p path via in nil)) (if-let [dp (deriv p x)] - (recur dp xs) + (recur dp xs (inc i)) (if (accept? p) {path {:reason "Extra input" :pred (abbrev (op-describe re)) :val data - :via via}} - (c/or (op-explain (op-describe p) p path via (seq data)) + :via via + :in (conj in i)}} + (c/or (op-explain (op-describe p) p path via (conj in i) (seq data)) {path {:reason "Extra input" :pred (abbrev (op-describe p)) :val data - :via via}})))))) + :via via + :in (conj in i)}})))))) (defn ^:skip-wiki regex-spec-impl "Do not call this directly, use 'spec' with a regex op argument" @@ -1285,10 +1291,10 @@ by ns-syms. Idempotent." (if (c/or (nil? x) (coll? x)) (re-conform re (seq x)) ::invalid)) - (explain* [_ path via x] + (explain* [_ path via in x] (if (c/or (nil? x) (coll? x)) - (re-explain path via re (seq x)) - {path {:pred (abbrev (op-describe re)) :val x :via via}})) + (re-explain path via in re (seq x)) + {path {:pred (abbrev (op-describe re)) :val x :via via :in in}})) (gen* [_ overrides path rmap] (if gfn (gfn) @@ -1330,7 +1336,7 @@ by ns-syms. Idempotent." (conform* [_ f] (if (fn? f) (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) ::invalid)) - (explain* [_ path via f] + (explain* [_ path via in f] (if (fn? f) (let [args (validate-fn f specs 100)] (if (identical? f args) ;;hrm, we might not be able to reproduce @@ -1338,15 +1344,15 @@ by ns-syms. Idempotent." (let [ret (try (apply f args) (catch Throwable t t))] (if (instance? Throwable ret) ;;TODO add exception data - {path {:pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via}} + {path {:pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via :in in}} (let [cret (dt retspec ret rform)] (if (= ::invalid cret) - (explain-1 rform retspec (conj path :ret) via ret) + (explain-1 rform retspec (conj path :ret) via in ret) (when fnspec (let [cargs (conform argspec args)] - (explain-1 fform fnspec (conj path :fn) via {:args cargs :ret cret}))))))))) - {path {:pred 'fn? :val f :via via}})) + (explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret}))))))))) + {path {:pred 'fn? :val f :via via :in in}})) (gen* [_ _ _ _] (if gfn (gfn) (when-not fnspec diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index d2147fda..cc33832e 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -14,7 +14,7 @@ (def even-count? #(even? (count %))) -(deftest conform-explain +#_(deftest conform-explain (let [a (s/and #(> % 5) #(< % 10)) o (s/or :s string? :k keyword?) c (s/cat :a string? :b keyword?) From dbce643265b8888d0c2d26cc2034387a222ccbaa Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 24 May 2016 20:47:49 -0400 Subject: [PATCH 015/246] add in arg to explain-data* calls --- src/clj/clojure/spec.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 63ee87b2..de877a06 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -519,7 +519,7 @@ (let [conform! (fn [v role spec data args] (let [conformed (conform spec data)] (if (= ::invalid conformed) - (let [ed (assoc (explain-data* spec [role] [] data) + (let [ed (assoc (explain-data* spec [role] [] [] data) ::args args)] (throw (ex-info (str "Call to " v " did not conform to spec:\n" (with-out-str (explain-out ed))) @@ -545,7 +545,7 @@ (when-let [arg-spec (:args specs)] (when (= ::invalid (conform arg-spec args)) (let [ed (assoc (explain-data* arg-spec [:args] - (if-let [name (spec-name arg-spec)] [name] []) args) + (if-let [name (spec-name arg-spec)] [name] []) [] args) ::args args)] (throw (IllegalArgumentException. (str From eacfcf08010e91e96da5233782fcdf82a593a0b3 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 24 May 2016 16:53:29 -0500 Subject: [PATCH 016/246] make spec tests tolerant of additive explain-data Signed-off-by: Rich Hickey --- test/clojure/test_clojure/spec.clj | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index cc33832e..8012ccbc 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -14,7 +14,16 @@ (def even-count? #(even? (count %))) -#_(deftest conform-explain +(defn submap? + "Is m1 a subset of m2?" + [m1 m2] + (if (and (map? m1) (map? m2)) + (every? (fn [[k v]] (and (contains? m2 k) + (submap? v (get m2 k)))) + m1) + (= m1 m2))) + +(deftest conform-explain (let [a (s/and #(> % 5) #(< % 10)) o (s/or :s string? :k keyword?) c (s/cat :a string? :b keyword?) @@ -29,8 +38,8 @@ (let [co (result-or-ex (s/conform spec x)) e (result-or-ex (::s/problems (s/explain-data spec x)))] (when (not= conformed co) (println "conform fail\n\texpect=" conformed "\n\tactual=" co)) - (when (not= ed e) (println "explain fail\n\texpect=" ed "\n\tactual=" e)) - (and (= conformed co) (= ed e))) + (when (not (submap? ed e)) (println "explain fail\n\texpect=" ed "\n\tactual=" e)) + (and (= conformed co) (submap? ed e))) keyword? :k :k nil keyword? nil ::s/invalid {[] {:pred ::s/unknown :val nil :via []}} From ec2512edad9c0c4a006980eedd2a6ee8679d4b5d Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 25 May 2016 10:26:44 -0400 Subject: [PATCH 017/246] missing with-gen on regex --- src/clj/clojure/spec.clj | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index de877a06..5b22b842 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1283,22 +1283,23 @@ by ns-syms. Idempotent." (defn ^:skip-wiki regex-spec-impl "Do not call this directly, use 'spec' with a regex op argument" [re gfn] - (reify - clojure.lang.IFn - (invoke [this x] (valid? this x)) - Spec - (conform* [_ x] - (if (c/or (nil? x) (coll? x)) - (re-conform re (seq x)) - ::invalid)) - (explain* [_ path via in x] - (if (c/or (nil? x) (coll? x)) - (re-explain path via in re (seq x)) - {path {:pred (abbrev (op-describe re)) :val x :via via :in in}})) + (reify + clojure.lang.IFn + (invoke [this x] (valid? this x)) + Spec + (conform* [_ x] + (if (c/or (nil? x) (coll? x)) + (re-conform re (seq x)) + ::invalid)) + (explain* [_ path via in x] + (if (c/or (nil? x) (coll? x)) + (re-explain path via in re (seq x)) + {path {:pred (abbrev (op-describe re)) :val x :via via :in in}})) (gen* [_ overrides path rmap] - (if gfn - (gfn) + (if gfn + (gfn) (re-gen re overrides path rmap (op-describe re)))) + (with-gen* [_ gfn] (regex-spec-impl re gfn)) (describe* [_] (op-describe re)))) ;;;;;;;;;;;;;;;;; HOFs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From 37f38851d343c878860460e585b8d54c38237882 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Wed, 25 May 2016 09:37:48 -0500 Subject: [PATCH 018/246] make spec tests tolerant of adding explain-data Signed-off-by: Rich Hickey --- test/clojure/test_clojure/spec.clj | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 8012ccbc..af3dc71a 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -145,11 +145,11 @@ its spec for test purposes." (is (nil? (flip-nums 1 1))) (s/instrument `flip-nums) (is (= [1 2] (flip-nums 2 1))) - (is (= '{:clojure.spec/problems {[:args :arg1] {:pred integer?, :val :a, :via []}}, :clojure.spec/args (:a :b)} + (is (submap? '{:clojure.spec/problems {[:args :arg1] {:pred integer?, :val :a, :via []}}, :clojure.spec/args (:a :b)} (get-ex-data (flip-nums :a :b)))) - (is (= '{:clojure.spec/problems {[:fn] {:pred (fn [{:keys [args ret]}] (= ret [(:arg2 args) (:arg1 args)])), :val {:args {:arg1 1, :arg2 2}, :ret [1 2]}, :via []}}, :clojure.spec/args (1 2)} + (is (submap? '{:clojure.spec/problems {[:fn] {:pred (fn [{:keys [args ret]}] (= ret [(:arg2 args) (:arg1 args)])), :val {:args {:arg1 1, :arg2 2}, :ret [1 2]}, :via []}}, :clojure.spec/args (1 2)} (get-ex-data (flip-nums 1 2)))) - (is (= '{:clojure.spec/problems {[:ret] {:pred vector?, :val nil, :via []}}, :clojure.spec/args (1 1)} + (is (submap? '{:clojure.spec/problems {[:ret] {:pred vector?, :val nil, :via []}}, :clojure.spec/args (1 1)} (get-ex-data (flip-nums 1 1)))) (s/unstrument `flip-nums) (= [1 2] (flip-nums 2 1)) From 881fcb966397648e7f39fcce07d5a8201c345536 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Wed, 25 May 2016 11:14:51 -0500 Subject: [PATCH 019/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha2 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..1dc9aa9b 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha2 http://clojure.org/ Clojure core environment and runtime library. From bb6d305ffd24d1ce0286d3bf6903b6c68e2c95fd Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Wed, 25 May 2016 11:14:52 -0500 Subject: [PATCH 020/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 1dc9aa9b..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha2 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From bf25f9956435966c90d12af91bc7320edf79d393 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 25 May 2016 13:24:37 -0400 Subject: [PATCH 021/246] macro specs do not include &form and &env args --- src/jvm/clojure/lang/Compiler.java | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index e096adb0..8d5ce3ab 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -6771,7 +6771,6 @@ public static Object macroexpand1(Object x) { Var v = isMacro(op); if(v != null) { - ISeq args = RT.cons(form, RT.cons(Compiler.LOCAL_ENV.get(), form.next())); try { final Namespace checkns = Namespace.find(Symbol.intern("clojure.spec")); @@ -6779,7 +6778,7 @@ public static Object macroexpand1(Object x) { { final Var check = Var.find(Symbol.intern("clojure.spec/macroexpand-check")); if ((check != null) && (check.isBound())) - check.applyTo(RT.cons(v, RT.list(args))); + check.applyTo(RT.cons(v, RT.list(form.next()))); } Symbol.intern("clojure.spec"); } @@ -6789,6 +6788,7 @@ public static Object macroexpand1(Object x) { } try { + ISeq args = RT.cons(form, RT.cons(Compiler.LOCAL_ENV.get(), form.next())); return v.applyTo(args); } catch(ArityException e) From bfb82f86631bde45a8e3749ea7df509e59a0791c Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 25 May 2016 15:23:16 -0400 Subject: [PATCH 022/246] multi-specs include dispatch values in path, fix for rep* --- src/clj/clojure/spec.clj | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 5b22b842..20771078 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -298,7 +298,12 @@ dispatch-tag that should return an appropriately retagged value. Note that because the tags themselves comprise an open set, - the tag keys cannot be :req in the specs. + the tag key spec cannot enumerate the values, but can e.g. + test for keyword?. + + Note also that the dispatch values of the multimethod will be + included in the path, i.e. in reporting and gen overrides, even + though those values are not evident in the spec. " [mm retag] `(multi-spec-impl '~(res mm) (var ~mm) ~retag)) @@ -834,6 +839,7 @@ by ns-syms. Idempotent." (str "Multimethod :" form " does not contain nil-returning default method for :clojure.spec/invalid" )) (let [id (java.util.UUID/randomUUID) predx #(@mmvar %) + dval #((.dispatchFn ^clojure.lang.MultiFn @mmvar) %) tag (if (keyword? retag) #(assoc %1 retag %2) retag)] @@ -845,21 +851,22 @@ by ns-syms. Idempotent." (dt pred x form) ::invalid)) (explain* [_ path via in x] - (if-let [pred (predx x)] - (explain-1 form pred path via in x) - {path {:pred form :val x :reason "no method" :via via :in in}})) + (let [dv (dval x) + path (conj path dv)] + (if-let [pred (predx x)] + (explain-1 form pred path via in x) + {path {:pred form :val x :reason "no method" :via via :in in}}))) (gen* [_ overrides path rmap] (if gfn (gfn) (let [gen (fn [[k f]] (let [p (f nil)] - (let [idk [id k] - rmap (inck rmap idk)] - (when-not (recur-limit? rmap idk [idk] idk) + (let [rmap (inck rmap id)] + (when-not (recur-limit? rmap id path k) (gen/delay (gen/fmap #(tag % k) - (gensub p overrides path rmap (list 'method form k)))))))) + (gensub p overrides (conj path k) rmap (list 'method form k)))))))) gs (->> (methods @mmvar) (remove (fn [[k]] (= k ::invalid))) (map gen) @@ -1139,7 +1146,8 @@ by ns-syms. Idempotent." ::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret}) (when (accept-nil? p0) (deriv (pcat* {:ps pr, :ks kr, :forms (next forms), :ret (add-ret p0 ret k0)}) x))) ::alt (alt* (map #(deriv % x) ps) ks forms) - ::rep (rep* (deriv p1 x) p2 ret splice forms))))) + ::rep (alt2 (rep* (deriv p1 x) p2 ret splice forms) + (when (accept-nil? p1) (deriv (rep* p2 p2 (add-ret p1 ret nil) splice forms) x))))))) (defn- op-describe [p] (let [{:keys [::op ps ks forms splice p1 rep+] :as p} (reg-resolve p)] From 2ecf6c651ecc154754867592f954b5d13bb0d94e Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 25 May 2016 15:55:20 -0400 Subject: [PATCH 023/246] get rid of default method requirements for multi-specs --- src/clj/clojure/spec.clj | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 20771078..680cc61a 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -283,14 +283,10 @@ extensibly associate specs with 'tagged' data (i.e. data where one of the fields indicates the shape of the rest of the structure). - The multimethod must use :clojure.spec/invalid as its default value - and should return nil from that dispatch value: - - (defmulti mspec :tag :default :clojure.spec/invalid) - (defmethod mspec :clojure.spec/invalid [_] nil) + (defmulti mspec :tag) The methods should ignore their argument and return a predicate/spec: - (defmethod mspec :int [_] (s/keys :req-un [::i])) + (defmethod mspec :int [_] (s/keys :req-un [::tag ::i])) retag is used during generation to retag generated values with matching tags. retag can either be a keyword, at which key the @@ -834,11 +830,11 @@ by ns-syms. Idempotent." "Do not call this directly, use 'multi-spec'" ([form mmvar retag] (multi-spec-impl form mmvar retag nil)) ([form mmvar retag gfn] - (assert (when-let [dm (-> (methods @mmvar) ::invalid)] - (nil? (dm nil))) - (str "Multimethod :" form " does not contain nil-returning default method for :clojure.spec/invalid" )) (let [id (java.util.UUID/randomUUID) - predx #(@mmvar %) + predx #(let [^clojure.lang.MultiFn mm @mmvar] + (c/and (contains? (methods mm) + ((.dispatchFn mm) %)) + (mm %))) dval #((.dispatchFn ^clojure.lang.MultiFn @mmvar) %) tag (if (keyword? retag) #(assoc %1 retag %2) @@ -856,7 +852,7 @@ by ns-syms. Idempotent." (if-let [pred (predx x)] (explain-1 form pred path via in x) {path {:pred form :val x :reason "no method" :via via :in in}}))) - (gen* [_ overrides path rmap] + (gen* [_ overrides path rmap] (if gfn (gfn) (let [gen (fn [[k f]] @@ -873,7 +869,7 @@ by ns-syms. Idempotent." (remove nil?))] (when (every? identity gs) (gen/one-of gs))))) - (with-gen* [_ gfn] (multi-spec-impl form mmvar retag gfn)) + (with-gen* [_ gfn] (multi-spec-impl form mmvar retag gfn)) (describe* [_] `(multi-spec ~form)))))) (defn ^:skip-wiki tuple-impl From c3abff893a8def21cb1dca969816dae83de9828b Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Wed, 25 May 2016 16:29:59 -0400 Subject: [PATCH 024/246] fix test reporting Signed-off-by: Rich Hickey --- src/clj/clojure/spec/test.clj | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index ebe3dd88..de81c4de 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -29,7 +29,8 @@ (assoc ret :result explain) ret)] (if-let [shrunk-explain (-> ret :shrunk :result ex-data ::check-call)] - (assoc-in ret [:shrunk :result] shrunk-explain)))) + (assoc-in ret [:shrunk :result] shrunk-explain) + ret))) (defn- check-call "Returns true if call passes specs, otherwise *returns* an exception From 575b0216fc016b481e49549b747de5988f9b455c Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Thu, 26 May 2016 09:16:15 -0400 Subject: [PATCH 025/246] tweak explain, added explain-str, improve s/+ explain --- src/clj/clojure/spec.clj | 14 ++++++++++---- test/clojure/test_clojure/spec.clj | 2 +- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 680cc61a..a1e1a603 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -163,8 +163,9 @@ (print "In:" in "")) (print "val: ") (pr val) - (print " fails spec: ") - (print (c/or (last via) "_")) + (print " fails") + (when-not (empty? via) + (print " spec:" (last via))) (when-not (empty? path) (print " at:" path)) (print " predicate: ") @@ -187,6 +188,11 @@ [spec x] (explain-out (explain-data spec x))) +(defn explain-str + "Given a spec and a value that fails to conform, returns an explanation as a string." + [spec x] + (with-out-str (explain spec x))) + (declare valid?) (defn- gensub @@ -1155,7 +1161,7 @@ by ns-syms. Idempotent." ::amp (list* 'clojure.spec/& (op-describe p1) forms) ::pcat (if rep+ (list `+ rep+) - (cons `cat (mapcat vector ks forms))) + (cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) (c/or (seq forms) (repeat nil))))) ::alt (cons `alt (mapcat vector ks forms)) ::rep (list (if splice `+ `*) forms))))) @@ -1264,7 +1270,7 @@ by ns-syms. Idempotent." (defn- re-explain [path via in re input] (loop [p re [x & xs :as data] input i 0] - ;;(prn {:p p :x x :xs xs}) (prn) + ;;(prn {:p p :x x :xs xs :re re}) (prn) (if (empty? data) (if (accept-nil? p) nil ;;success diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index af3dc71a..5904ecfc 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -79,7 +79,7 @@ plus [] ::s/invalid '{[] {:reason "Insufficient input", :pred keyword?, :val () :via []}} plus [:k] [:k] nil plus [:k1 :k2] [:k1 :k2] nil - plus [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (cat), :val ("x") :via []}} + ;;plus [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (cat :_ (* keyword?)), :val (x), :via [], :in [2]}} plus ["a"] ::s/invalid '{[] {:pred keyword?, :val "a" :via []}} opt nil nil nil From 35dbe87984358ef4862e42b6f8e81fc0ec711553 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Thu, 26 May 2016 08:55:52 -0500 Subject: [PATCH 026/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha3 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..dd44261e 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha3 http://clojure.org/ Clojure core environment and runtime library. From acd7c7a13719c8d8e7c2cc7eae7e8c93272f40d4 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Thu, 26 May 2016 08:55:52 -0500 Subject: [PATCH 027/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index dd44261e..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha3 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From 0aa346766c4b065728cde9f9fcb4b2276a6fe7b5 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Sat, 28 May 2016 12:25:49 -0400 Subject: [PATCH 028/246] optimize seq (&) destructuring --- src/clj/clojure/core.clj | 132 ++++++++++++++++++++++----------------- 1 file changed, 73 insertions(+), 59 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 32d04d8e..81a6c5b1 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -4255,68 +4255,82 @@ ([& keyvals] (clojure.lang.PersistentArrayMap/createAsIfByAssoc (to-array keyvals)))) -;redefine let and loop with destructuring +;;redefine let and loop with destructuring (defn destructure [bindings] (let [bents (partition 2 bindings) pb (fn pb [bvec b v] - (let [pvec - (fn [bvec b val] - (let [gvec (gensym "vec__")] - (loop [ret (-> bvec (conj gvec) (conj val)) - n 0 - bs b - seen-rest? false] - (if (seq bs) - (let [firstb (first bs)] - (cond - (= firstb '&) (recur (pb ret (second bs) (list `nthnext gvec n)) - n - (nnext bs) - true) - (= firstb :as) (pb ret (second bs) gvec) - :else (if seen-rest? - (throw (new Exception "Unsupported binding form, only :as can follow & parameter")) - (recur (pb ret firstb (list `nth gvec n nil)) - (inc n) - (next bs) - seen-rest?)))) - ret)))) - pmap - (fn [bvec b v] - (let [gmap (gensym "map__") - gmapseq (with-meta gmap {:tag 'clojure.lang.ISeq}) - defaults (:or b)] - (loop [ret (-> bvec (conj gmap) (conj v) - (conj gmap) (conj `(if (seq? ~gmap) (clojure.lang.PersistentHashMap/create (seq ~gmapseq)) ~gmap)) - ((fn [ret] - (if (:as b) - (conj ret (:as b) gmap) - ret)))) - bes (reduce1 - (fn [bes entry] - (reduce1 #(assoc %1 %2 ((val entry) %2)) - (dissoc bes (key entry)) - ((key entry) bes))) - (dissoc b :as :or) - {:keys #(if (keyword? %) % (keyword (str %))), - :strs str, :syms #(list `quote %)})] - (if (seq bes) - (let [bb (key (first bes)) - bk (val (first bes)) - bv (if (contains? defaults bb) - (list `get gmap bk (defaults bb)) - (list `get gmap bk))] - (recur (cond - (symbol? bb) (-> ret (conj (if (namespace bb) (symbol (name bb)) bb)) (conj bv)) - (keyword? bb) (-> ret (conj (symbol (name bb)) bv)) - :else (pb ret bb bv)) - (next bes))) - ret))))] - (cond - (symbol? b) (-> bvec (conj b) (conj v)) - (vector? b) (pvec bvec b v) - (map? b) (pmap bvec b v) - :else (throw (new Exception (str "Unsupported binding form: " b)))))) + (let [pvec + (fn [bvec b val] + (let [gvec (gensym "vec__") + gseq (gensym "seq__") + gfirst (gensym "first__") + has-rest (some #{'&} b)] + (loop [ret (let [ret (conj bvec gvec val)] + (if has-rest + (conj ret gseq (list `seq gvec)) + ret)) + n 0 + bs b + seen-rest? false] + (if (seq bs) + (let [firstb (first bs)] + (cond + (= firstb '&) (recur (pb ret (second bs) gseq) + n + (nnext bs) + true) + (= firstb :as) (pb ret (second bs) gvec) + :else (if seen-rest? + (throw (new Exception "Unsupported binding form, only :as can follow & parameter")) + (recur (pb (if has-rest + (conj ret + gfirst `(first ~gseq) + gseq `(next ~gseq)) + ret) + firstb + (if has-rest + gfirst + (list `nth gvec n nil))) + (inc n) + (next bs) + seen-rest?)))) + ret)))) + pmap + (fn [bvec b v] + (let [gmap (gensym "map__") + gmapseq (with-meta gmap {:tag 'clojure.lang.ISeq}) + defaults (:or b)] + (loop [ret (-> bvec (conj gmap) (conj v) + (conj gmap) (conj `(if (seq? ~gmap) (clojure.lang.PersistentHashMap/create (seq ~gmapseq)) ~gmap)) + ((fn [ret] + (if (:as b) + (conj ret (:as b) gmap) + ret)))) + bes (reduce1 + (fn [bes entry] + (reduce1 #(assoc %1 %2 ((val entry) %2)) + (dissoc bes (key entry)) + ((key entry) bes))) + (dissoc b :as :or) + {:keys #(if (keyword? %) % (keyword (str %))), + :strs str, :syms #(list `quote %)})] + (if (seq bes) + (let [bb (key (first bes)) + bk (val (first bes)) + bv (if (contains? defaults bb) + (list `get gmap bk (defaults bb)) + (list `get gmap bk))] + (recur (cond + (symbol? bb) (-> ret (conj (if (namespace bb) (symbol (name bb)) bb)) (conj bv)) + (keyword? bb) (-> ret (conj (symbol (name bb)) bv)) + :else (pb ret bb bv)) + (next bes))) + ret))))] + (cond + (symbol? b) (-> bvec (conj b) (conj v)) + (vector? b) (pvec bvec b v) + (map? b) (pmap bvec b v) + :else (throw (new Exception (str "Unsupported binding form: " b)))))) process-entry (fn [bvec b] (pb bvec (first b) (second b)))] (if (every? symbol? (map first bents)) bindings From 53b02ef20c32386c4b4e23e1018e1a19140fee06 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Sat, 28 May 2016 12:36:03 -0400 Subject: [PATCH 029/246] improve update-in perf --- src/clj/clojure/core.clj | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 81a6c5b1..cb6255a1 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -5958,10 +5958,13 @@ created." {:added "1.0" :static true} - ([m [k & ks] f & args] - (if ks - (assoc m k (apply update-in (get m k) ks f args)) - (assoc m k (apply f (get m k) args))))) + ([m ks f & args] + (let [up (fn up [m ks f args] + (let [[k & ks] ks] + (if ks + (assoc m k (up (get m k) ks f args)) + (assoc m k (apply f (get m k) args)))))] + (up m ks f args)))) (defn update "'Updates' a value in an associative structure, where k is a From b853e28d384146ed1344189aa20a2ddb108556eb Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 31 May 2016 10:43:27 -0400 Subject: [PATCH 030/246] fix describe empty cat --- src/clj/clojure/spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index a1e1a603..02c46751 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1161,7 +1161,7 @@ by ns-syms. Idempotent." ::amp (list* 'clojure.spec/& (op-describe p1) forms) ::pcat (if rep+ (list `+ rep+) - (cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) (c/or (seq forms) (repeat nil))))) + (cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) forms))) ::alt (cons `alt (mapcat vector ks forms)) ::rep (list (if splice `+ `*) forms))))) From 5882d068262b5c46ad54dc12366093fb4f80f124 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 31 May 2016 09:54:05 -0500 Subject: [PATCH 031/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha4 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..93e70f23 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha4 http://clojure.org/ Clojure core environment and runtime library. From 9051714f2b4623beb27b0d44dbeba7612f3182b1 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 31 May 2016 09:54:05 -0500 Subject: [PATCH 032/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 93e70f23..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha4 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From 68fe71f0153bb6062754442c0a61c075b58fd9bc Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 1 Jun 2016 09:47:14 -0400 Subject: [PATCH 033/246] explain tail of single-pred cat --- src/clj/clojure/spec.clj | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 02c46751..b3dfe468 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1168,8 +1168,8 @@ by ns-syms. Idempotent." (defn- op-explain [form p path via in input] ;;(prn {:form form :p p :path path :input input}) (let [[x :as input] input - via (if-let [name (spec-name p)] (conj via name) via) {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve p) + via (if-let [name (spec-name p)] (conj via name) via) insufficient (fn [path form] {path {:reason "Insufficient input" :pred (abbrev form) @@ -1189,13 +1189,13 @@ by ns-syms. Idempotent." (if-let [p1 (deriv p1 x)] (explain-pred-list forms ps path via in (preturn p1)) (op-explain (op-describe p1) p1 path via in input))) - ::pcat (let [[pred k form] (->> (map vector - ps - (c/or (seq ks) (repeat nil)) - (c/or (seq forms) (repeat nil))) - (remove (fn [[p]] - (accept-nil? p))) - first) + ::pcat (let [pkfs (map vector + ps + (c/or (seq ks) (repeat nil)) + (c/or (seq forms) (repeat nil))) + [pred k form] (if (= 1 (count pkfs)) + (first pkfs) + (first (remove (fn [[p]] (accept-nil? p)) pkfs))) path (if k (conj path k) path) form (c/or form (op-describe pred))] (if (c/and (empty? input) (not pred)) @@ -1278,11 +1278,13 @@ by ns-syms. Idempotent." (if-let [dp (deriv p x)] (recur dp xs (inc i)) (if (accept? p) - {path {:reason "Extra input" - :pred (abbrev (op-describe re)) - :val data - :via via - :in (conj in i)}} + (if (= (::op p) ::pcat) + (op-explain (op-describe p) p path via (conj in i) (seq data)) + {path {:reason "Extra input" + :pred (abbrev (op-describe re)) + :val data + :via via + :in (conj in i)}}) (c/or (op-explain (op-describe p) p path via (conj in i) (seq data)) {path {:reason "Extra input" :pred (abbrev (op-describe p)) From 47b8d6b47a7c87272334c77878b92fd988448c41 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 3 Jun 2016 08:50:51 -0400 Subject: [PATCH 034/246] keywords are their own spec-names --- src/clj/clojure/spec.clj | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index b3dfe468..aab53811 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -49,8 +49,11 @@ (with-meta spec (assoc (meta spec) ::name name))) (defn- spec-name [spec] - (when (instance? clojure.lang.IObj spec) - (-> (meta spec) ::name))) + (cond + (keyword? spec) spec + + (instance? clojure.lang.IObj spec) + (-> (meta spec) ::name))) (defn- reg-resolve "returns the spec/regex at end of alias chain starting with k, nil if not found, k if k not Named" From 71e5969e72a4cfcc52f06a8b393839e4c662b01c Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 3 Jun 2016 08:51:15 -0400 Subject: [PATCH 035/246] added canSeq --- src/jvm/clojure/lang/RT.java | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index 6faad4c7..95e9a944 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -524,6 +524,7 @@ else if(coll instanceof LazySeq) return seqFrom(coll); } +// N.B. canSeq must be kept in sync with this! static ISeq seqFrom(Object coll){ if(coll instanceof Seqable) return ((Seqable) coll).seq(); @@ -544,6 +545,16 @@ else if(coll instanceof Map) } } +static public boolean canSeq(Object coll){ + return coll instanceof ISeq + || coll instanceof Seqable + || coll == null + || coll instanceof Iterable + || coll.getClass().isArray() + || coll instanceof CharSequence + || coll instanceof Map; +} + static public Iterator iter(Object coll){ if(coll instanceof Iterable) return ((Iterable)coll).iterator(); From 1f25347a7b219488d5d9f8d17b04f2cc7828b30e Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 3 Jun 2016 10:27:10 -0400 Subject: [PATCH 036/246] throw IllegalStateException on missing gen --- src/clj/clojure/spec.clj | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index aab53811..3761d4f5 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -201,11 +201,10 @@ (defn- gensub [spec overrides path rmap form] ;;(prn {:spec spec :over overrides :path path :form form}) - (if-let [spec (specize spec)] + (let [spec (specize spec)] (if-let [g (c/or (get overrides path) (gen* spec overrides path rmap))] (gen/such-that #(valid? spec %) g 100) - (throw (Exception. (str "Unable to construct gen at: " path " for: " (abbrev form))))) - (throw (Exception. (str "Unable to construct gen at: " path ", " (abbrev form) " can not be made a spec"))))) + (throw (IllegalStateException. (str "Unable to construct gen at: " path " for: " (abbrev form))))))) (defn gen "Given a spec, returns the generator for it, or throws if none can From 080121d5de5f23d56025743572064ba1371ee4f3 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 6 Jun 2016 14:23:00 -0400 Subject: [PATCH 037/246] first cut of unform --- src/clj/clojure/spec.clj | 155 +++++++++++++++++++++-------- test/clojure/test_clojure/spec.clj | 6 +- 2 files changed, 114 insertions(+), 47 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 3761d4f5..90577286 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -36,6 +36,7 @@ (defprotocol Spec (conform* [spec x]) + (unform* [spec y]) (explain* [spec path via in x]) (gen* [spec overrides path rmap]) (with-gen* [spec gfn]) @@ -107,6 +108,13 @@ [spec x] (conform* (specize spec) x)) +(defn unform + "Given a spec and a value created by or compliant with a call to + 'conform' with the same spec, returns a value with all conform + destructuring undone." + [spec x] + (unform* (specize spec) x)) + (defn form "returns the spec as data" [spec] @@ -458,9 +466,10 @@ (defmacro conformer "takes a predicate function with the semantics of conform i.e. it should return either a (possibly converted) value or :clojure.spec/invalid, and returns a - spec that uses it as a predicate/conformer" - [f] - `(spec-impl '~f ~f nil true)) + spec that uses it as a predicate/conformer. Optionally takes a + second fn that does unform of result of first" + ([f] `(spec-impl '~f ~f nil true)) + ([f unf] `(spec-impl '~f ~f nil true ~unf))) (defmacro fspec "takes :args :ret and (optional) :fn kwargs whose values are preds @@ -767,6 +776,17 @@ by ns-syms. Idempotent." (recur ret ks)) ret))) ::invalid)) + (unform* [_ m] + (let [reg (registry)] + (loop [ret m, [k & ks :as keys] (c/keys m)] + (if keys + (if (contains? reg (keys->specs k)) + (let [cv (get m k) + v (unform (keys->specs k) cv)] + (recur (if (identical? cv v) ret (assoc ret k v)) + ks)) + (recur ret ks)) + ret)))) (explain* [_ path via in x] (if-not (map? x) {path {:pred 'map? :val x :via via :in in}} @@ -814,7 +834,8 @@ by ns-syms. Idempotent." (defn ^:skip-wiki spec-impl "Do not call this directly, use 'spec'" - [form pred gfn cpred?] + ([form pred gfn cpred?] (spec-impl form pred gfn cpred? nil)) + ([form pred gfn cpred? unc] (cond (spec? pred) (cond-> pred gfn (with-gen gfn)) (regex? pred) (regex-spec-impl pred gfn) @@ -825,14 +846,19 @@ by ns-syms. Idempotent." (invoke [this x] (valid? this x)) Spec (conform* [_ x] (dt pred x form cpred?)) + (unform* [_ x] (if cpred? + (if unc + (unc x) + (throw (IllegalStateException. "no unform fn for conformer"))) + x)) (explain* [_ path via in x] (when (= ::invalid (dt pred x form cpred?)) {path {:pred (abbrev form) :val x :via via :in in}})) - (gen* [_ _ _ _] (if gfn + (gen* [_ _ _ _] (if gfn (gfn) (gen/gen-for-pred pred))) - (with-gen* [_ gfn] (spec-impl form pred gfn cpred?)) - (describe* [_] form)))) + (with-gen* [_ gfn] (spec-impl form pred gfn cpred?)) + (describe* [_] form))))) (defn ^:skip-wiki multi-spec-impl "Do not call this directly, use 'multi-spec'" @@ -854,6 +880,9 @@ by ns-syms. Idempotent." (conform* [_ x] (if-let [pred (predx x)] (dt pred x form) ::invalid)) + (unform* [_ x] (if-let [pred (predx x)] + (unform pred x) + (throw (IllegalStateException. (str "No method of: " form " for dispatch value: " (dval x)))))) (explain* [_ path via in x] (let [dv (dval x) path (conj path dv)] @@ -901,6 +930,16 @@ by ns-syms. Idempotent." ::invalid (recur (if (identical? cv v) ret (assoc ret i cv)) (inc i)))))))) + (unform* [_ x] + (assert (c/and (vector? x) + (= (count x) (count preds)))) + (loop [ret x, i 0] + (if (= i (count x)) + ret + (let [cv (x i) + v (unform (preds i) cv)] + (recur (if (identical? cv v) ret (assoc ret i v)) + (inc i)))))) (explain* [_ path via in x] (cond (not (vector? x)) @@ -931,39 +970,41 @@ by ns-syms. Idempotent." (defn ^:skip-wiki or-spec-impl "Do not call this directly, use 'or'" [keys forms preds gfn] - (let [id (java.util.UUID/randomUUID) - cform (fn [x] - (loop [i 0] - (if (< i (count preds)) - (let [pred (preds i)] - (let [ret (dt pred x (nth forms i))] - (if (= ::invalid ret) - (recur (inc i)) - [(keys i) ret]))) - ::invalid)))] - (reify - clojure.lang.IFn - (invoke [this x] (valid? this x)) - Spec - (conform* [_ x] (cform x)) - (explain* [this path via in x] - (when-not (valid? this x) - (apply merge - (map (fn [k form pred] - (when-not (valid? pred x) - (explain-1 form pred (conj path k) via in x))) - keys forms preds)))) + (let [id (java.util.UUID/randomUUID) + kps (zipmap keys preds) + cform (fn [x] + (loop [i 0] + (if (< i (count preds)) + (let [pred (preds i)] + (let [ret (dt pred x (nth forms i))] + (if (= ::invalid ret) + (recur (inc i)) + [(keys i) ret]))) + ::invalid)))] + (reify + clojure.lang.IFn + (invoke [this x] (valid? this x)) + Spec + (conform* [_ x] (cform x)) + (unform* [_ [k x]] (unform (kps k) x)) + (explain* [this path via in x] + (when-not (valid? this x) + (apply merge + (map (fn [k form pred] + (when-not (valid? pred x) + (explain-1 form pred (conj path k) via in x))) + keys forms preds)))) (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [gen (fn [k p f] - (let [rmap (inck rmap id)] - (when-not (recur-limit? rmap id path k) - (gen/delay - (gensub p overrides (conj path k) rmap f))))) - gs (remove nil? (map gen keys preds forms))] - (when-not (empty? gs) - (gen/one-of gs))))) + (if gfn + (gfn) + (let [gen (fn [k p f] + (let [rmap (inck rmap id)] + (when-not (recur-limit? rmap id path k) + (gen/delay + (gensub p overrides (conj path k) rmap f))))) + gs (remove nil? (map gen keys preds forms))] + (when-not (empty? gs) + (gen/one-of gs))))) (with-gen* [_ gfn] (or-spec-impl keys forms preds gfn)) (describe* [_] `(or ~@(mapcat vector keys forms)))))) @@ -998,6 +1039,7 @@ by ns-syms. Idempotent." (invoke [this x] (valid? this x)) Spec (conform* [_ x] (and-preds x preds forms)) + (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) (explain* [_ path via in x] (explain-pred-list forms preds path via in x)) (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms)))) (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) @@ -1082,7 +1124,7 @@ by ns-syms. Idempotent." (defn ^:skip-wiki maybe-impl "Do not call this directly, use '?'" - [p form] (alt* [p (accept ::nil)] nil [form ::nil])) + [p form] (assoc (alt* [p (accept ::nil)] nil [form ::nil]) :maybe form)) (defn- noret? [p1 pret] (c/or (= pret ::nil) @@ -1124,6 +1166,27 @@ by ns-syms. Idempotent." r (if (nil? p0) ::nil (preturn p0))] (if k0 [k0 r] r))))) +(defn- op-unform [p x] + ;;(prn {:p p :x x}) + (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms rep+ maybe] :as p} (reg-resolve p) + kps (zipmap ks ps)] + (case op + ::accept [ret] + nil [(unform p x)] + ::amp (let [px (reduce #(unform %2 %1) x (reverse ps))] + (op-unform p1 px)) + ::rep (mapcat #(op-unform p1 %) x) + ::pcat (if rep+ + (mapcat #(op-unform p0 %) x) + (mapcat (fn [k] + (when (contains? x k) + (op-unform (kps k) (get x k)))) + ks)) + ::alt (if maybe + [(unform p0 x)] + (let [[k v] x] + (op-unform (kps k) v)))))) + (defn- add-ret [p r k] (let [{:keys [::op ps splice] :as p} (reg-resolve p) prop #(let [ret (preturn p)] @@ -1154,7 +1217,7 @@ by ns-syms. Idempotent." (when (accept-nil? p1) (deriv (rep* p2 p2 (add-ret p1 ret nil) splice forms) x))))))) (defn- op-describe [p] - (let [{:keys [::op ps ks forms splice p1 rep+] :as p} (reg-resolve p)] + (let [{:keys [::op ps ks forms splice p1 rep+ maybe] :as p} (reg-resolve p)] ;;(prn {:op op :ks ks :forms forms :p p}) (when p (case op @@ -1164,7 +1227,9 @@ by ns-syms. Idempotent." ::pcat (if rep+ (list `+ rep+) (cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) forms))) - ::alt (cons `alt (mapcat vector ks forms)) + ::alt (if maybe + (list `? maybe) + (cons `alt (mapcat vector ks forms))) ::rep (list (if splice `+ `*) forms))))) (defn- op-explain [form p path via in input] @@ -1305,6 +1370,7 @@ by ns-syms. Idempotent." (if (c/or (nil? x) (coll? x)) (re-conform re (seq x)) ::invalid)) + (unform* [_ x] (op-unform re x)) (explain* [_ path via in x] (if (c/or (nil? x) (coll? x)) (re-explain path via in re (seq x)) @@ -1351,6 +1417,7 @@ by ns-syms. Idempotent." (conform* [_ f] (if (fn? f) (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) ::invalid)) + (unform* [_ f] f) (explain* [_ path via in f] (if (fn? f) (let [args (validate-fn f specs 100)] @@ -1380,7 +1447,7 @@ by ns-syms. Idempotent." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (clojure.spec/def ::any (spec (constantly true) :gen gen/any)) -(clojure.spec/def ::kvs->map (conformer #(zipmap (map ::k %) (map ::v %)))) +(clojure.spec/def ::kvs->map (conformer #(zipmap (map ::k %) (map ::v %)) #(map (fn [[k v]] {::k k ::v v}) %))) (defmacro keys* "takes the same arguments as spec/keys and returns a regex op that matches sequences of key/values, @@ -1402,7 +1469,7 @@ by ns-syms. Idempotent." (defmacro nilable "returns a spec that accepts nil and values satisfiying pred" [pred] - `(and (or ::nil nil? ::pred ~pred) (conformer second))) + `(and (or ::nil nil? ::pred ~pred) (conformer second #(if (nil? %) [::nil nil] [::pred %])))) (defn exercise "generates a number (default 10) of values compatible with spec and maps conform over them, diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 5904ecfc..8c7d60cd 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -84,10 +84,10 @@ opt nil nil nil opt [] nil nil - opt :k ::s/invalid '{[] {:pred (alt), :val :k, :via []}} + ;;opt :k ::s/invalid '{[] {:pred (alt), :val :k, :via []}} opt [:k] :k nil - opt [:k1 :k2] ::s/invalid '{[] {:reason "Extra input", :pred (alt), :val (:k2), :via []}} - opt [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (alt), :val (:k2 "x"), :via []}} + ;;opt [:k1 :k2] ::s/invalid '{[] {:reason "Extra input", :pred (alt), :val (:k2), :via []}} + ;;opt [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (alt), :val (:k2 "x"), :via []}} opt ["a"] ::s/invalid '{[] {:pred keyword?, :val "a", :via []}} andre nil nil nil From daf8056503196709a4f1aa315a5888841dacd322 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 7 Jun 2016 09:09:48 -0500 Subject: [PATCH 038/246] avoid printing Spec in doc when none exist Signed-off-by: Rich Hickey --- src/clj/clojure/repl.clj | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/repl.clj b/src/clj/clojure/repl.clj index f38e2f49..2e8c02a5 100644 --- a/src/clj/clojure/repl.clj +++ b/src/clj/clojure/repl.clj @@ -107,11 +107,11 @@ itself (not its value) is returned. The reader macro #'x expands to (var x)."}}) (println "Spec")) (when doc (println " " doc)) (when n - (when-let [specs (spec/fn-specs (symbol (str (ns-name n)) (name nm)))] + (when-let [specs (seq (remove (fn [[role spec]] (nil? spec)) + (spec/fn-specs (symbol (str (ns-name n)) (name nm)))))] (println "Spec") (run! (fn [[role spec]] - (when (and spec (not (= spec ::spec/unknown))) - (println " " (str (name role) ":") (spec/describe spec)))) + (println " " (str (name role) ":") (spec/describe spec))) specs)))) (defn find-doc From 58227c5de080110cb2ce5bc9f987d995a911b13e Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 7 Jun 2016 10:31:38 -0500 Subject: [PATCH 039/246] new preds, specs, and gens Signed-off-by: Rich Hickey --- src/clj/clojure/core.clj | 119 +++++++++++++++++++++++ src/clj/clojure/spec.clj | 48 ++++++++- src/clj/clojure/spec/gen.clj | 30 +++++- test/clojure/test_clojure/predicates.clj | 32 ++++++ test/clojure/test_clojure/spec.clj | 33 +++++-- 5 files changed, 254 insertions(+), 8 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index cb6255a1..9cf7fc19 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -516,6 +516,11 @@ :static true} [x] (clojure.lang.Util/identical x true)) +(defn boolean? + "Return true if x is a Boolean" + {:added "1.9"} + [x] (instance? Boolean x)) + (defn not "Returns true if x is logical false, false otherwise." {:tag Boolean @@ -1378,6 +1383,38 @@ :static true} [n] (not (even? n))) +(defn long? + "Return true if x is a Long" + {:added "1.9"} + [x] (instance? Long x)) + +(defn pos-long? + "Return true if x is a positive Long" + {:added "1.9"} + [x] (and (instance? Long x) + (pos? x))) + +(defn neg-long? + "Return true if x is a negative Long" + {:added "1.9"} + [x] (and (instance? Long x) + (neg? x))) + +(defn nat-long? + "Return true if x is a non-negative Long" + {:added "1.9"} + [x] (and (instance? Long x) + (not (neg? x)))) + +(defn double? + "Return true if x is a Double" + {:added "1.9"} + [x] (instance? Double x)) + +(defn bigdec? + "Return true if x is a BigDecimal" + {:added "1.9"} + [x] (instance? java.math.BigDecimal x)) ;; @@ -1553,6 +1590,41 @@ [^clojure.lang.Named x] (. x (getNamespace))) +(defn ident? + "Return true if x is a symbol or keyword" + {:added "1.9"} + [x] (or (keyword? x) (symbol? x))) + +(defn simple-ident? + "Return true if x is a symbol or keyword without a namespace" + {:added "1.9"} + [x] (and (ident? x) (nil? (namespace x)))) + +(defn qualified-ident? + "Return true if x is a symbol or keyword with a namespace" + {:added "1.9"} + [x] (and (ident? x) (namespace x) true)) + +(defn simple-symbol? + "Return true if x is a symbol without a namespace" + {:added "1.9"} + [x] (and (symbol? x) (nil? (namespace x)))) + +(defn qualified-symbol? + "Return true if x is a symbol with a namespace" + {:added "1.9"} + [x] (and (symbol? x) (namespace x) true)) + +(defn simple-keyword? + "Return true if x is a keyword without a namespace" + {:added "1.9"} + [x] (and (keyword? x) (nil? (namespace x)))) + +(defn qualified-keyword? + "Return true if x is a keyword with a namespace" + {:added "1.9"} + [x] (and (keyword? x) (namespace x) true)) + (defmacro locking "Executes exprs in an implicit do, while holding the monitor of x. Will release the monitor of x in all circumstances." @@ -5195,6 +5267,13 @@ {:added "1.0"} [xs] `(. clojure.lang.Numbers longs ~xs)) +(defn bytes? + "Return true if x is a byte array" + {:added "1.9"} + [x] (if (nil? x) + false + (-> x class .getComponentType (= Byte/TYPE)))) + (import '(java.util.concurrent BlockingQueue LinkedBlockingQueue)) (defn seque @@ -6003,6 +6082,11 @@ :static true} [x] (instance? clojure.lang.IPersistentList x)) +(defn seqable? + "Return true if the seq function is supported for x" + {:added "1.9"} + [x] (clojure.lang.RT/canSeq x)) + (defn ifn? "Returns true if x implements IFn. Note that many data structures (e.g. sets and maps) implement IFn" @@ -6047,6 +6131,11 @@ :static true} [coll] (instance? clojure.lang.Reversible coll)) +(defn indexed? + "Return true if coll implements Indexed, indicating efficient lookup by index" + {:added "1.9"} + [coll] (instance? clojure.lang.Indexed coll)) + (def ^:dynamic ^{:doc "bound in a repl thread to the most recent value printed" :added "1.0"} @@ -6539,8 +6628,33 @@ (load "core/protocols") (load "gvec") (load "instant") + +(defprotocol Inst + (inst-ms* [inst])) + +(extend-protocol Inst + java.util.Date + (inst-ms* [inst] (.getTime ^java.util.Date inst))) + +(defn inst-ms + "Return the number of milliseconds since January 1, 1970, 00:00:00 GMT" + {:added "1.9"} + [inst] + (inst-ms* inst)) + +(defn inst? + "Return true if x satisfies Inst" + {:added "1.9"} + [x] + (satisfies? Inst x)) + (load "uuid") +(defn uuid? + "Return true if x is a java.util.UUID" + {:added "1.9"} + [x] (instance? java.util.UUID x)) + (defn reduce "f should be a function of 2 arguments. If val is not supplied, returns the result of applying f to the first 2 items in coll, then @@ -7534,3 +7648,8 @@ (catch Throwable t (.printStackTrace t) (throw t))) + +(defn uri? + "Return true if x is a java.net.URI" + {:added "1.9"} + [x] (instance? java.net.URI x)) \ No newline at end of file diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 90577286..55d7ddff 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1511,4 +1511,50 @@ by ns-syms. Idempotent." [kpred vpred] `(and (coll-of (tuple ~kpred ~vpred) {}) map?)) - +(defn inst-in-range? + "Return true if inst at or after start and before end" + [start end inst] + (c/and (inst? inst) + (let [t (inst-ms inst)] + (c/and (<= (inst-ms start) t) (< t (inst-ms end)))))) + +(defmacro inst-in + "Returns a spec that validates insts in the range from start +(inclusive) to end (exclusive)." + [start end] + `(let [st# (inst-ms ~start) + et# (inst-ms ~end) + mkdate# (fn [d#] (java.util.Date. ^{:tag ~'long} d#))] + (spec (and inst? #(inst-in-range? ~start ~end %)) + :gen (fn [] + (gen/fmap mkdate# + (gen/large-integer* {:min st# :max et#})))))) + +(defn long-in-range? + "Return true if start <= val and val < end" + [start end val] + (c/and (long? val) (<= start val) (< val end))) + +(defmacro long-in + "Returns a spec that validates longs in the range from start +(inclusive) to end (exclusive)." + [start end] + `(spec (and c/long? #(long-in-range? ~start ~end %)) + :gen #(gen/large-integer* {:min ~start :max (dec ~end)}))) + +(defmacro double-in + "Specs a 64-bit floating point number. Options: + + :infinite? - whether +/- infinity allowed (default true) + :NaN? - whether NaN allowed (default true) + :min - minimum value (inclusive, default none) + :max - maximum value (inclusive, default none)" + [& {:keys [infinite? NaN? min max] + :or {infinite? true NaN? true} + :as m}] + `(spec (and c/double? + ~@(when-not infinite? '[#(not (Double/isInfinite %))]) + ~@(when-not NaN? '[#(not (Double/isNaN %))]) + ~@(when max `[#(<= % ~max)]) + ~@(when min `[#(<= ~min %)])) + :gen #(gen/double* ~m))) \ No newline at end of file diff --git a/src/clj/clojure/spec/gen.clj b/src/clj/clojure/spec/gen.clj index a5ef475f..ecb1897b 100644 --- a/src/clj/clojure/spec/gen.clj +++ b/src/clj/clojure/spec/gen.clj @@ -90,7 +90,8 @@ syms))) (lazy-combinators hash-map list map not-empty set vector fmap elements - bind choose fmap one-of such-that tuple sample return) + bind choose fmap one-of such-that tuple sample return + large-integer* double*) (defmacro ^:skip-wiki lazy-prim "Implementation macro, do not call directly." @@ -122,16 +123,43 @@ gens, each of which should generate something sequential." (fmap #(apply concat %) (apply tuple gens))) +(defn- qualified? [ident] (not (nil? (namespace ident)))) + (def ^:private gen-builtins (c/delay (let [simple (simple-type-printable)] {number? (one-of [(large-integer) (double)]) integer? (large-integer) + long? (large-integer) + pos-long? (large-integer* {:min 1}) + neg-long? (large-integer* {:max -1}) + nat-long? (large-integer* {:min 0}) float? (double) + double? (double) + boolean? (boolean) string? (string-alphanumeric) + ident? (one-of [(keyword-ns) (symbol-ns)]) + simple-ident? (one-of [(keyword) (symbol)]) + qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)])) keyword? (keyword-ns) + simple-keyword? (keyword) + qualified-keyword? (such-that qualified? (keyword-ns)) symbol? (symbol-ns) + simple-symbol? (symbol) + qualified-symbol? (such-that qualified? (symbol-ns)) + uuid? (uuid) + bigdec? (fmap #(BigDecimal/valueOf %) + (double* {:infinite? false :NaN? false})) + inst? (fmap #(java.util.Date. %) + (large-integer)) + seqable? (one-of [(return nil) + (list simple) + (vector simple) + (map simple simple) + (set simple) + (string-alphanumeric)]) + indexed? (vector simple) map? (map simple simple) vector? (vector simple) list? (list simple) diff --git a/test/clojure/test_clojure/predicates.clj b/test/clojure/test_clojure/predicates.clj index 2923ef3d..150f6a27 100644 --- a/test/clojure/test_clojure/predicates.clj +++ b/test/clojure/test_clojure/predicates.clj @@ -140,3 +140,35 @@ (are [x] (not (string? x)) (new java.lang.StringBuilder "abc") (new java.lang.StringBuffer "xyz"))) + +(def pred-val-table + (let [now (java.util.Date.) + uuid (java.util.UUID/randomUUID) + barray (byte-array 0) + uri (java.net.URI. "http://clojure.org")] + [' + [identity long? pos-long? neg-long? nat-long? double? boolean? indexed? seqable? ident? uuid? bigdec? inst? uri? bytes?] + [0 true false false true false false false false false false false false false false] + [1 true true false true false false false false false false false false false false] + [-1 true false true false false false false false false false false false false false] + [1.0 false false false false true false false false false false false false false false] + [true false false false false false true false false false false false false false false] + [[] false false false false false false true true false false false false false false] + [nil false false false false false false false true false false false false false false] + [{} false false false false false false false true false false false false false false] + [:foo false false false false false false false false true false false false false false] + ['foo false false false false false false false false true false false false false false] + [0.0M false false false false false false false false false false true false false false] + [0N false false false false false false false false false false false false false false] + [uuid false false false false false false false false false true false false false false] + [uri false false false false false false false false false false false false true false] + [now false false false false false false false false false false false true false false] + [barray false false false false false false false true false false false false false true]])) + +(deftest test-preds + (let [[preds & rows] pred-val-table] + (doseq [row rows] + (let [v (first row)] + (dotimes [i (count row)] + (is (= ((resolve (nth preds i)) v) (nth row i)) + (pr-str (list (nth preds i) v)))))))) diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 8c7d60cd..264e1173 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -33,7 +33,11 @@ opt (s/? keyword?) andre (s/& (s/* keyword?) even-count?) m (s/map-of keyword? string?) - coll (s/coll-of keyword? [])] + coll (s/coll-of keyword? []) + lrange (s/long-in 7 42) + drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2) + irange (s/inst-in #inst "1939" #inst "1946") + ] (are [spec x conformed ed] (let [co (result-or-ex (s/conform spec x)) e (result-or-ex (::s/problems (s/explain-data spec x)))] @@ -41,6 +45,21 @@ (when (not (submap? ed e)) (println "explain fail\n\texpect=" ed "\n\tactual=" e)) (and (= conformed co) (submap? ed e))) + lrange 7 7 nil + lrange 8 8 nil + lrange 42 ::s/invalid {[] {:pred '(long-in-range? 7 42 %), :val 42, :via [], :in []}} + + irange #inst "1938" ::s/invalid {[] {:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1938", :via [], :in []}} + irange #inst "1942" #inst "1942" nil + irange #inst "1946" ::s/invalid {[] {:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1946", :via [], :in []}} + + drange 3.0 ::s/invalid {[] {:pred '(<= 3.1 %), :val 3.0, :via [], :in []}} + drange 3.1 3.1 nil + drange 3.2 3.2 nil + drange Double/POSITIVE_INFINITY ::s/invalid {[] {:pred '(not (isInfinite %)), :val Double/POSITIVE_INFINITY, :via [], :in []}} + ;; can't use equality-based test for Double/NaN + ;; drange Double/NaN ::s/invalid {[] {:pred '(not (isNaN %)), :val Double/NaN, :via [], :in []}} + keyword? :k :k nil keyword? nil ::s/invalid {[] {:pred ::s/unknown :val nil :via []}} keyword? "abc" ::s/invalid {[] {:pred ::s/unknown :val "abc" :via []}} @@ -61,6 +80,8 @@ c ["a"] ::s/invalid '{[:b] {:reason "Insufficient input", :pred keyword?, :val (), :via []}} c ["s" :k] '{:a "s" :b :k} nil c ["s" :k 5] ::s/invalid '{[] {:reason "Extra input", :pred (cat :a string? :b keyword?), :val (5), :via []}} + (s/cat) nil {} nil + (s/cat) [5] ::s/invalid '{[] {:reason "Extra input", :pred (cat), :val (5), :via [], :in [0]}} either nil ::s/invalid '{[] {:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}} either [] ::s/invalid '{[] {:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}} @@ -79,15 +100,15 @@ plus [] ::s/invalid '{[] {:reason "Insufficient input", :pred keyword?, :val () :via []}} plus [:k] [:k] nil plus [:k1 :k2] [:k1 :k2] nil - ;;plus [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (cat :_ (* keyword?)), :val (x), :via [], :in [2]}} + plus [:k1 :k2 "x"] ::s/invalid '{[] {:pred keyword?, :val "x", :via [], :in [2]}} plus ["a"] ::s/invalid '{[] {:pred keyword?, :val "a" :via []}} opt nil nil nil opt [] nil nil - ;;opt :k ::s/invalid '{[] {:pred (alt), :val :k, :via []}} + opt :k ::s/invalid '{[] {:pred (? keyword?), :val :k, :via []}} opt [:k] :k nil - ;;opt [:k1 :k2] ::s/invalid '{[] {:reason "Extra input", :pred (alt), :val (:k2), :via []}} - ;;opt [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (alt), :val (:k2 "x"), :via []}} + opt [:k1 :k2] ::s/invalid '{[] {:reason "Extra input", :pred (? keyword?), :val (:k2), :via []}} + opt [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (? keyword?), :val (:k2 "x"), :via []}} opt ["a"] ::s/invalid '{[] {:pred keyword?, :val "a", :via []}} andre nil nil nil @@ -180,7 +201,7 @@ its spec for test purposes." (comment (require '[clojure.test :refer (run-tests)]) - (in-ns 'test-clojure.spec) + (in-ns 'clojure.test-clojure.spec) (run-tests) (stest/run-all-tests) From cfc32100db5f54009a1b8b589145b99cef8d7bb9 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 7 Jun 2016 12:08:40 -0500 Subject: [PATCH 040/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha5 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..979b4076 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha5 http://clojure.org/ Clojure core environment and runtime library. From 0ef22d85189e108cea0fc5332c8c5eeb7fd79652 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 7 Jun 2016 12:08:40 -0500 Subject: [PATCH 041/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 979b4076..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha5 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From b7199fb338b7788d5d61763525ab82029174592e Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 8 Jun 2016 15:56:55 -0400 Subject: [PATCH 042/246] fail fast & when accept re and failed secondary preds --- src/clj/clojure/spec.clj | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 55d7ddff..5645285a 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -461,7 +461,7 @@ conjunction of the predicates, and any conforming they might perform." [re & preds] (let [pv (vec preds)] - `(amp-impl ~re ~pv '~pv))) + `(amp-impl ~re ~pv '~(mapv res pv)))) (defmacro conformer "takes a predicate function with the semantics of conform i.e. it should return either a @@ -1142,9 +1142,7 @@ by ns-syms. Idempotent." ::amp (c/and (accept-nil? p1) (c/or (noret? p1 (preturn p1)) (let [ret (-> (preturn p1) (and-preds ps (next forms)))] - (if (= ret ::invalid) - nil - ret)))) + (not= ret ::invalid)))) ::rep (c/or (identical? p1 p2) (accept-nil? p1)) ::pcat (every? accept-nil? ps) ::alt (c/some accept-nil? ps)))) @@ -1209,7 +1207,11 @@ by ns-syms. Idempotent." nil (let [ret (dt p x p)] (when-not (= ::invalid ret) (accept ret))) ::amp (when-let [p1 (deriv p1 x)] - (amp-impl p1 ps forms)) + (if (= ::accept (::op p1)) + (let [ret (-> (preturn p1) (and-preds ps (next forms)))] + (when-not (= ret ::invalid) + (accept ret))) + (amp-impl p1 ps forms))) ::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret}) (when (accept-nil? p0) (deriv (pcat* {:ps pr, :ks kr, :forms (next forms), :ret (add-ret p0 ret k0)}) x))) ::alt (alt* (map #(deriv % x) ps) ks forms) From 0bc837b9c25ae62185795b2bf2c7952bf6e12d9e Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 10 Jun 2016 17:02:12 -0400 Subject: [PATCH 043/246] add :args/:ret/:fn accessors for fspecs --- src/clj/clojure/spec.clj | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 5645285a..f94a1236 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1415,6 +1415,16 @@ by ns-syms. Idempotent." (reify clojure.lang.IFn (invoke [this x] (valid? this x)) + + clojure.lang.ILookup + (valAt [this k] (.valAt this k nil)) + (valAt [_ k not-found] + (case k + :args argspec + :ret retspec + :fn fnspec + not-found)) + Spec (conform* [_ f] (if (fn? f) (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) From f571c4bb05e82f8a13d557bfde89f50026a3570d Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Sat, 11 Jun 2016 10:38:40 -0400 Subject: [PATCH 044/246] tagged returns from or/alt are now map entries, support 'key' and 'val' --- src/clj/clojure/spec.clj | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index f94a1236..d35e9545 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -385,9 +385,10 @@ (s/or :even even? :small #(< % 42)) - Returns a destructuring spec that - returns a vector containing the key of the first matching pred and the - corresponding value." + Returns a destructuring spec that returns a map entry containing the + key of the first matching pred and the corresponding value. Thus the + 'key' and 'val' functions can be used to refer generically to the + components of the tagged return." [& key-pred-forms] (let [pairs (partition 2 key-pred-forms) keys (mapv first pairs) @@ -429,8 +430,10 @@ (s/alt :even even? :small #(< % 42)) - Returns a regex op that returns a vector containing the key of the - first matching pred and the corresponding value." + Returns a regex op that returns a map entry containing the key of the + first matching pred and the corresponding value. Thus the + 'key' and 'val' functions can be used to refer generically to the + components of the tagged return" [& key-pred-forms] (let [pairs (partition 2 key-pred-forms) keys (mapv first pairs) @@ -966,6 +969,8 @@ by ns-syms. Idempotent." (with-gen* [_ gfn] (tuple-impl forms preds gfn)) (describe* [_] `(tuple ~@forms))))) +(defn- tagged-ret [tag ret] + (clojure.lang.MapEntry. tag ret)) (defn ^:skip-wiki or-spec-impl "Do not call this directly, use 'or'" @@ -979,7 +984,7 @@ by ns-syms. Idempotent." (let [ret (dt pred x (nth forms i))] (if (= ::invalid ret) (recur (inc i)) - [(keys i) ret]))) + (tagged-ret (keys i) ret)))) ::invalid)))] (reify clojure.lang.IFn @@ -1110,7 +1115,7 @@ by ns-syms. Idempotent." (if (nil? pr) (if k1 (if (accept? p1) - (accept [k1 (:ret p1)]) + (accept (tagged-ret k1 (:ret p1))) ret) p1) ret))))) @@ -1162,7 +1167,7 @@ by ns-syms. Idempotent." ::pcat (add-ret p0 ret k) ::alt (let [[[p0] [k0]] (filter-alt ps ks forms accept-nil?) r (if (nil? p0) ::nil (preturn p0))] - (if k0 [k0 r] r))))) + (if k0 (tagged-ret k0 r) r))))) (defn- op-unform [p x] ;;(prn {:p p :x x}) From 43e1c7f3b9df408b8cb79d4b4dfbeb780aabb846 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Sat, 11 Jun 2016 11:11:51 -0400 Subject: [PATCH 045/246] use throwing resolve in regex ops --- src/clj/clojure/spec.clj | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index d35e9545..b2a194be 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -68,6 +68,14 @@ (with-name spec k))))) k)) +(defn- reg-resolve! + "returns the spec/regex at end of alias chain starting with k, throws if not found, k if k not ident" + [k] + (if (ident? k) + (c/or (reg-resolve k) + (throw (Exception. (str "Unable to resolve spec: " k)))) + k)) + (defn spec? "returns x if x is a spec object, else logical false" [x] @@ -1133,14 +1141,14 @@ by ns-syms. Idempotent." (defn- noret? [p1 pret] (c/or (= pret ::nil) - (c/and (#{::rep ::pcat} (::op (reg-resolve p1))) ;;hrm, shouldn't know these + (c/and (#{::rep ::pcat} (::op (reg-resolve! p1))) ;;hrm, shouldn't know these (empty? pret)) nil)) (declare preturn) (defn- accept-nil? [p] - (let [{:keys [::op ps p1 p2 forms] :as p} (reg-resolve p)] + (let [{:keys [::op ps p1 p2 forms] :as p} (reg-resolve! p)] (case op ::accept true nil nil @@ -1155,7 +1163,7 @@ by ns-syms. Idempotent." (declare add-ret) (defn- preturn [p] - (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms] :as p} (reg-resolve p)] + (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms] :as p} (reg-resolve! p)] (case op ::accept ret nil nil @@ -1171,7 +1179,7 @@ by ns-syms. Idempotent." (defn- op-unform [p x] ;;(prn {:p p :x x}) - (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms rep+ maybe] :as p} (reg-resolve p) + (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms rep+ maybe] :as p} (reg-resolve! p) kps (zipmap ks ps)] (case op ::accept [ret] @@ -1191,7 +1199,7 @@ by ns-syms. Idempotent." (op-unform (kps k) v)))))) (defn- add-ret [p r k] - (let [{:keys [::op ps splice] :as p} (reg-resolve p) + (let [{:keys [::op ps splice] :as p} (reg-resolve! p) prop #(let [ret (preturn p)] (if (empty? ret) r ((if splice into conj) r (if k {k ret} ret))))] (case op @@ -1205,7 +1213,7 @@ by ns-syms. Idempotent." (defn- deriv [p x] - (let [{[p0 & pr :as ps] :ps, [k0 & kr :as ks] :ks, :keys [::op p1 p2 ret splice forms] :as p} (reg-resolve p)] + (let [{[p0 & pr :as ps] :ps, [k0 & kr :as ks] :ks, :keys [::op p1 p2 ret splice forms] :as p} (reg-resolve! p)] (when p (case op ::accept nil @@ -1224,7 +1232,7 @@ by ns-syms. Idempotent." (when (accept-nil? p1) (deriv (rep* p2 p2 (add-ret p1 ret nil) splice forms) x))))))) (defn- op-describe [p] - (let [{:keys [::op ps ks forms splice p1 rep+ maybe] :as p} (reg-resolve p)] + (let [{:keys [::op ps ks forms splice p1 rep+ maybe] :as p} (reg-resolve! p)] ;;(prn {:op op :ks ks :forms forms :p p}) (when p (case op @@ -1242,7 +1250,7 @@ by ns-syms. Idempotent." (defn- op-explain [form p path via in input] ;;(prn {:form form :p p :path path :input input}) (let [[x :as input] input - {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve p) + {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve! p) via (if-let [name (spec-name p)] (conj via name) via) insufficient (fn [path form] {path {:reason "Insufficient input" @@ -1295,7 +1303,7 @@ by ns-syms. Idempotent." (defn- re-gen [p overrides path rmap f] ;;(prn {:op op :ks ks :forms forms}) - (let [{:keys [::op ps ks p1 p2 forms splice ret id] :as p} (reg-resolve p) + (let [{:keys [::op ps ks p1 p2 forms splice ret id] :as p} (reg-resolve! p) rmap (if id (inck rmap id) rmap) ggens (fn [ps ks forms] (let [gen (fn [p k f] From 84c16fd9faa6f9a48c292c86d2f7da8b88ff9dec Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 13 Jun 2016 12:48:05 -0400 Subject: [PATCH 046/246] emit keys in fspec describe --- src/clj/clojure/spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index b2a194be..356a6f4c 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1468,7 +1468,7 @@ by ns-syms. Idempotent." (assert (valid? argspec args) (with-out-str (explain argspec args))) (gen/generate (gen retspec))))))) (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn)) - (describe* [_] `(fspec ~aform ~rform ~fform))))) + (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (clojure.spec/def ::any (spec (constantly true) :gen gen/any)) From 69dd29d2c8c1593bb283f9bfcd47b1ec280520e9 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 13 Jun 2016 13:20:20 -0400 Subject: [PATCH 047/246] spec-ify predicates entering fspec --- src/clj/clojure/spec.clj | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 356a6f4c..75b102fd 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -297,7 +297,8 @@ Returns a spec." [form & {:keys [gen]}] - `(spec-impl '~(res form) ~form ~gen nil)) + (when form + `(spec-impl '~(res form) ~form ~gen nil))) (defmacro multi-spec "Takes the name of a spec/predicate-returning multimethod and a @@ -490,7 +491,9 @@ Optionally takes :gen generator-fn, which must be a fn of no args that returns a test.check generator." [& {:keys [args ret fn gen]}] - `(fspec-impl ~args '~(res args) ~ret '~(res ret) ~fn '~(res fn) ~gen)) + `(fspec-impl (spec ~args) '~(res args) + (spec ~ret) '~(res ret) + (spec ~fn) '~(res fn) ~gen)) (defmacro tuple "takes one or more preds and returns a spec for a tuple, a vector @@ -1423,20 +1426,14 @@ by ns-syms. Idempotent." (defn ^:skip-wiki fspec-impl "Do not call this directly, use 'fspec'" [argspec aform retspec rform fnspec fform gfn] - (assert (c/and argspec retspec)) (let [specs {:args argspec :ret retspec :fn fnspec}] (reify clojure.lang.IFn (invoke [this x] (valid? this x)) clojure.lang.ILookup - (valAt [this k] (.valAt this k nil)) - (valAt [_ k not-found] - (case k - :args argspec - :ret retspec - :fn fnspec - not-found)) + (valAt [this k] (get specs k)) + (valAt [_ k not-found] (get specs k not-found)) Spec (conform* [_ f] (if (fn? f) From 92df7b2a72dad83a901f86c1a9ec8fbc5dc1d1c7 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 13 Jun 2016 12:58:50 -0500 Subject: [PATCH 048/246] fdef registers single fspec. fn-specs -> fn-spec. Signed-off-by: Rich Hickey --- src/clj/clojure/repl.clj | 9 +++--- src/clj/clojure/spec.clj | 52 +++++++++++------------------------ src/clj/clojure/spec/test.clj | 4 +-- 3 files changed, 22 insertions(+), 43 deletions(-) diff --git a/src/clj/clojure/repl.clj b/src/clj/clojure/repl.clj index 2e8c02a5..b59987ca 100644 --- a/src/clj/clojure/repl.clj +++ b/src/clj/clojure/repl.clj @@ -107,12 +107,11 @@ itself (not its value) is returned. The reader macro #'x expands to (var x)."}}) (println "Spec")) (when doc (println " " doc)) (when n - (when-let [specs (seq (remove (fn [[role spec]] (nil? spec)) - (spec/fn-specs (symbol (str (ns-name n)) (name nm)))))] + (when-let [fnspec (spec/fn-spec (symbol (str (ns-name n)) (name nm)))] (println "Spec") - (run! (fn [[role spec]] - (println " " (str (name role) ":") (spec/describe spec))) - specs)))) + (doseq [role [:args :ret :fn]] + (when-let [spec (get fnspec role)] + (println " " (str (name role) ":") (spec/describe spec))))))) (defn find-doc "Prints documentation for any var whose documentation or name diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 75b102fd..53ed0640 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -513,32 +513,20 @@ s (symbol (str (.name *ns*)) (str s))))) -(defn- fn-spec-sym - [sym role] - (symbol (str (ns-qualify sym) "$" (name role)))) - -(def ^:private fn-spec-roles [:args :ret :fn]) - (defn- expect "Returns nil if v conforms to spec, else throws ex-info with explain-data." [spec v] ) -(defn- fn-specs? - "Fn-specs must include at least :args or :ret specs." +(defn- fn-spec? + "Fn-spec must include at least :args or :ret specs." [m] (c/or (:args m) (:ret m))) -(defn fn-specs - "Returns :args/:ret/:fn map of specs for var or symbol v." +(defn fn-spec + "Returns fspec of specs for var or symbol v, or nil." [v] - (let [s (->sym v) - reg (registry)] - (reduce - (fn [m role] - (assoc m role (get reg (fn-spec-sym s role)))) - {} - fn-spec-roles))) + (get (registry) (->sym v))) (defmacro with-instrument-disabled "Disables instrument's checking of calls, within a scope." @@ -561,7 +549,7 @@ [& args] (if *instrument-enabled* (with-instrument-disabled - (let [specs (fn-specs v)] + (let [specs (fn-spec v)] (let [cargs (when (:args specs) (conform! v :args (:args specs) args args)) ret (binding [*instrument-enabled* true] (.applyTo ^clojure.lang.IFn f args)) @@ -573,7 +561,7 @@ (defn- macroexpand-check [v args] - (let [specs (fn-specs v)] + (let [specs (fn-spec v)] (when-let [arg-spec (:args specs)] (when (= ::invalid (conform arg-spec args)) (let [ed (assoc (explain-data* arg-spec [:args] @@ -597,7 +585,7 @@ Qualifies fn-sym with resolve, or using *ns* if no resolution found. Registers specs in the global registry, where they can be retrieved - by calling fn-specs. + by calling fn-spec. Once registered, function specs are included in doc, checked by instrument, tested by the runner clojure.spec.test/run-tests, and (if @@ -616,18 +604,11 @@ :str string? :sym symbol?) :ret symbol?)" - [fn-sym & {:keys [args ret fn] :as m}] + [fn-sym & specs] (let [qn (ns-qualify fn-sym)] - `(do ~@(reduce - (c/fn [defns role] - (if (contains? m role) - (let [s (fn-spec-sym qn (name role))] - (conj defns `(clojure.spec/def '~s ~(get m role)))) - defns)) - [] [:args :ret :fn]) - '~qn))) - -(defn- no-fn-specs + `(clojure.spec/def '~qn (clojure.spec/fspec ~@specs)))) + +(defn- no-fn-spec [v specs] (ex-info (str "Fn at " v " is not spec'ed.") {:var v :specs specs})) @@ -652,8 +633,8 @@ specs, if they exist, throwing an ex-info with explain-data if a check fails. Idempotent." [v] (let [v (->var v) - specs (fn-specs v)] - (if (fn-specs? specs) + spec (fn-spec v)] + (if (fn-spec? spec) (locking instrumented-vars (let [{:keys [raw wrapped]} (get @instrumented-vars v) current @v] @@ -662,7 +643,7 @@ check fails. Idempotent." (alter-var-root v (constantly checked)) (swap! instrumented-vars assoc v {:raw current :wrapped checked})))) v) - (throw (no-fn-specs v specs))))) + (throw (no-fn-spec v spec))))) (defn unstrument "Undoes instrument on the var at v, a var or symbol. Idempotent." @@ -687,9 +668,8 @@ specified, return speced vars from all namespaces." (reduce-kv (fn [s k _] (if (c/and (symbol? k) - (re-find #"\$(args|ret)$" (name k)) (ns-match? (namespace k))) - (if-let [v (resolve (symbol (str/replace (str k) #"\$(args|ret)$" "")))] + (if-let [v (resolve k)] (conj s v) s) s)) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index de81c4de..02ed8049 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -74,7 +74,7 @@ passed through to test.check/quick-check: Returns a map as quick-check, with :explain-data added if :result is false." [v & opts] - (let [specs (spec/fn-specs v)] + (let [specs (spec/fn-spec v)] (if (:args specs) (apply check-fn @v specs opts) (throw (IllegalArgumentException. (str "No :args spec for " v)))))) @@ -102,7 +102,7 @@ Returns a map as quick-check, with :explain-data added if [& ns-syms] (if (seq ns-syms) (run-var-tests (->> (apply spec/speced-vars ns-syms) - (filter (fn [v] (:args (spec/fn-specs v)))))) + (filter (fn [v] (:args (spec/fn-spec v)))))) (run-tests (.name ^clojure.lang.Namespace *ns*)))) (defn run-all-tests From 30dd3d8554ff96f1acda7cbe31470d92df2f565a Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 14 Jun 2016 08:58:25 -0500 Subject: [PATCH 049/246] Instrument checks only :args spec Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 53ed0640..4dd57317 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -550,13 +550,9 @@ (if *instrument-enabled* (with-instrument-disabled (let [specs (fn-spec v)] - (let [cargs (when (:args specs) (conform! v :args (:args specs) args args)) - ret (binding [*instrument-enabled* true] - (.applyTo ^clojure.lang.IFn f args)) - cret (when (:ret specs) (conform! v :ret (:ret specs) ret args))] - (when (c/and (:args specs) (:ret specs) (:fn specs)) - (conform! v :fn (:fn specs) {:args cargs :ret cret} args)) - ret))) + (when (:args specs) (conform! v :args (:args specs) args args)) + (binding [*instrument-enabled* true] + (.applyTo ^clojure.lang.IFn f args)))) (.applyTo ^clojure.lang.IFn f args))))) (defn- macroexpand-check @@ -628,8 +624,8 @@ (defn instrument "Instruments the var at v, a var or symbol, to check specs -registered with fdef. Wraps the fn at v to check :args/:ret/:fn -specs, if they exist, throwing an ex-info with explain-data if a +registered with fdef. Wraps the fn at v to check the :args +spec, if it exists, throwing an ex-info with explain-data if a check fails. Idempotent." [v] (let [v (->var v) From 544d01d0f9657f6d5bb43b4cd29bc0ffec104fa7 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 14 Jun 2016 11:45:33 -0400 Subject: [PATCH 050/246] fspecs accept ifns --- src/clj/clojure/spec.clj | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 4dd57317..c515c58a 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1412,12 +1412,12 @@ by ns-syms. Idempotent." (valAt [_ k not-found] (get specs k not-found)) Spec - (conform* [_ f] (if (fn? f) + (conform* [_ f] (if (ifn? f) (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) ::invalid)) (unform* [_ f] f) (explain* [_ path via in f] - (if (fn? f) + (if (ifn? f) (let [args (validate-fn f specs 100)] (if (identical? f args) ;;hrm, we might not be able to reproduce nil @@ -1432,7 +1432,7 @@ by ns-syms. Idempotent." (when fnspec (let [cargs (conform argspec args)] (explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret}))))))))) - {path {:pred 'fn? :val f :via via :in in}})) + {path {:pred 'ifn? :val f :via via :in in}})) (gen* [_ _ _ _] (if gfn (gfn) (when-not fnspec From 1c44c559ea79695e003a77be056cfd49ec15ec2e Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Sat, 11 Jun 2016 09:13:19 -0500 Subject: [PATCH 051/246] CLJ-1957 Add generator for bytes? Signed-off-by: Rich Hickey --- src/clj/clojure/spec/gen.clj | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/spec/gen.clj b/src/clj/clojure/spec/gen.clj index ecb1897b..19d802ff 100644 --- a/src/clj/clojure/spec/gen.clj +++ b/src/clj/clojure/spec/gen.clj @@ -7,7 +7,7 @@ ; You must not remove this notice, or any other, from this software. (ns clojure.spec.gen - (:refer-clojure :exclude [boolean cat hash-map list map not-empty set vector + (:refer-clojure :exclude [boolean bytes cat hash-map list map not-empty set vector char double int keyword symbol string uuid delay])) (alias 'c 'clojure.core) @@ -112,7 +112,7 @@ (fn [s] (c/list 'lazy-prim s)) syms))) -(lazy-prims any any-printable boolean char char-alpha char-alphanumeric char-ascii double +(lazy-prims any any-printable boolean bytes char char-alpha char-alphanumeric char-ascii double int keyword keyword-ns large-integer ratio simple-type simple-type-printable string string-ascii string-alphanumeric symbol symbol-ns uuid) @@ -178,7 +178,8 @@ gens, each of which should generate something sequential." empty? (elements [nil '() [] {} #{}]) associative? (one-of [(map simple simple) (vector simple)]) sequential? (one-of [(list simple) (vector simple)]) - ratio? (such-that ratio? (ratio))}))) + ratio? (such-that ratio? (ratio)) + bytes? (bytes)}))) (defn gen-for-pred "Given a predicate, returns a built-in generator if one exists." From 1109dd4eafd95c169add38dd0051be413d9e49d0 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Sun, 12 Jun 2016 02:22:01 -0500 Subject: [PATCH 052/246] CLJ-1958 generator for uri? Signed-off-by: Rich Hickey --- src/clj/clojure/spec/gen.clj | 1 + 1 file changed, 1 insertion(+) diff --git a/src/clj/clojure/spec/gen.clj b/src/clj/clojure/spec/gen.clj index 19d802ff..1ea343f5 100644 --- a/src/clj/clojure/spec/gen.clj +++ b/src/clj/clojure/spec/gen.clj @@ -149,6 +149,7 @@ gens, each of which should generate something sequential." simple-symbol? (symbol) qualified-symbol? (such-that qualified? (symbol-ns)) uuid? (uuid) + uri? (fmap #(java.net.URI/create (str "http://" % ".com")) (uuid)) bigdec? (fmap #(BigDecimal/valueOf %) (double* {:infinite? false :NaN? false})) inst? (fmap #(java.util.Date. %) From 5f21ca96a0810a5a51a25c580eaf1f78ac809aac Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 14 Jun 2016 11:45:01 -0500 Subject: [PATCH 053/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha6 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..4ed76e38 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha6 http://clojure.org/ Clojure core environment and runtime library. From 4f8593bac44fb303d8f0e56f9ee03a888569df05 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 14 Jun 2016 11:45:01 -0500 Subject: [PATCH 054/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 4ed76e38..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha6 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From 20f67081b7654e44e960defb1e4e491c3a0c2c8b Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 14 Jun 2016 16:52:05 -0500 Subject: [PATCH 055/246] rename long preds to int and cover all fixed precision integer types Signed-off-by: Rich Hickey --- src/clj/clojure/core.clj | 27 +++++++++++++----------- src/clj/clojure/spec.clj | 10 ++++----- src/clj/clojure/spec/gen.clj | 8 +++---- test/clojure/test_clojure/predicates.clj | 2 +- test/clojure/test_clojure/spec.clj | 4 ++-- 5 files changed, 27 insertions(+), 24 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 9cf7fc19..67f3aa33 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -1383,27 +1383,30 @@ :static true} [n] (not (even? n))) -(defn long? - "Return true if x is a Long" +(defn int? + "Return true if x is a fixed precision integer" {:added "1.9"} - [x] (instance? Long x)) + [x] (or (instance? Long x) + (instance? Integer x) + (instance? Short x) + (instance? Byte x))) -(defn pos-long? - "Return true if x is a positive Long" +(defn pos-int? + "Return true if x is a positive fixed precision integer" {:added "1.9"} - [x] (and (instance? Long x) + [x] (and (int? x) (pos? x))) -(defn neg-long? - "Return true if x is a negative Long" +(defn neg-int? + "Return true if x is a negative fixed precision integer" {:added "1.9"} - [x] (and (instance? Long x) + [x] (and (int? x) (neg? x))) -(defn nat-long? - "Return true if x is a non-negative Long" +(defn nat-int? + "Return true if x is a non-negative fixed precision integer" {:added "1.9"} - [x] (and (instance? Long x) + [x] (and (int? x) (not (neg? x)))) (defn double? diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index c515c58a..918bd0a6 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1528,16 +1528,16 @@ by ns-syms. Idempotent." (gen/fmap mkdate# (gen/large-integer* {:min st# :max et#})))))) -(defn long-in-range? +(defn int-in-range? "Return true if start <= val and val < end" [start end val] - (c/and (long? val) (<= start val) (< val end))) + (c/and int? (<= start val) (< val end))) -(defmacro long-in - "Returns a spec that validates longs in the range from start +(defmacro int-in + "Returns a spec that validates ints in the range from start (inclusive) to end (exclusive)." [start end] - `(spec (and c/long? #(long-in-range? ~start ~end %)) + `(spec (and int? #(int-in-range? ~start ~end %)) :gen #(gen/large-integer* {:min ~start :max (dec ~end)}))) (defmacro double-in diff --git a/src/clj/clojure/spec/gen.clj b/src/clj/clojure/spec/gen.clj index 1ea343f5..04ba2036 100644 --- a/src/clj/clojure/spec/gen.clj +++ b/src/clj/clojure/spec/gen.clj @@ -131,10 +131,10 @@ gens, each of which should generate something sequential." (let [simple (simple-type-printable)] {number? (one-of [(large-integer) (double)]) integer? (large-integer) - long? (large-integer) - pos-long? (large-integer* {:min 1}) - neg-long? (large-integer* {:max -1}) - nat-long? (large-integer* {:min 0}) + int? (large-integer) + pos-int? (large-integer* {:min 1}) + neg-int? (large-integer* {:max -1}) + nat-int? (large-integer* {:min 0}) float? (double) double? (double) boolean? (boolean) diff --git a/test/clojure/test_clojure/predicates.clj b/test/clojure/test_clojure/predicates.clj index 150f6a27..90681962 100644 --- a/test/clojure/test_clojure/predicates.clj +++ b/test/clojure/test_clojure/predicates.clj @@ -147,7 +147,7 @@ barray (byte-array 0) uri (java.net.URI. "http://clojure.org")] [' - [identity long? pos-long? neg-long? nat-long? double? boolean? indexed? seqable? ident? uuid? bigdec? inst? uri? bytes?] + [identity int? pos-int? neg-int? nat-int? double? boolean? indexed? seqable? ident? uuid? bigdec? inst? uri? bytes?] [0 true false false true false false false false false false false false false false] [1 true true false true false false false false false false false false false false] [-1 true false true false false false false false false false false false false false] diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 264e1173..76a15150 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -34,7 +34,7 @@ andre (s/& (s/* keyword?) even-count?) m (s/map-of keyword? string?) coll (s/coll-of keyword? []) - lrange (s/long-in 7 42) + lrange (s/int-in 7 42) drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2) irange (s/inst-in #inst "1939" #inst "1946") ] @@ -47,7 +47,7 @@ lrange 7 7 nil lrange 8 8 nil - lrange 42 ::s/invalid {[] {:pred '(long-in-range? 7 42 %), :val 42, :via [], :in []}} + lrange 42 ::s/invalid {[] {:pred '(int-in-range? 7 42 %), :val 42, :via [], :in []}} irange #inst "1938" ::s/invalid {[] {:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1938", :via [], :in []}} irange #inst "1942" #inst "1942" nil From 046d0ecd0db89804b8aad2a2b903b683fd521c31 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Wed, 15 Jun 2016 13:33:41 -0500 Subject: [PATCH 056/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha7 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..373c51d6 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha7 http://clojure.org/ Clojure core environment and runtime library. From 546ae41c5ba1cdad54c564a2f48f1400761a9acc Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Wed, 15 Jun 2016 13:33:41 -0500 Subject: [PATCH 057/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 373c51d6..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha7 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From 4978bf5cee35f74df87c49720fa82de7287d60a5 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 15 Jun 2016 16:05:28 -0400 Subject: [PATCH 058/246] fix def/fdef symbol resolution, replace fn-spec with more general get-spec --- src/clj/clojure/repl.clj | 2 +- src/clj/clojure/spec.clj | 57 +++++++++++++++++++---------------- src/clj/clojure/spec/test.clj | 4 +-- 3 files changed, 34 insertions(+), 29 deletions(-) diff --git a/src/clj/clojure/repl.clj b/src/clj/clojure/repl.clj index b59987ca..e77b7884 100644 --- a/src/clj/clojure/repl.clj +++ b/src/clj/clojure/repl.clj @@ -107,7 +107,7 @@ itself (not its value) is returned. The reader macro #'x expands to (var x)."}}) (println "Spec")) (when doc (println " " doc)) (when n - (when-let [fnspec (spec/fn-spec (symbol (str (ns-name n)) (name nm)))] + (when-let [fnspec (spec/get-spec (symbol (str (ns-name n)) (name nm)))] (println "Spec") (doseq [role [:args :ret :fn]] (when-let [spec (get fnspec role)] diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 918bd0a6..8c417240 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -261,24 +261,40 @@ (defn ^:skip-wiki def-impl "Do not call this directly, use 'def'" [k form spec] - (assert (c/and (named? k) (namespace k)) "k must be namespaced keyword/symbol") + (assert (c/and (named? k) (namespace k)) "k must be namespaced keyword or resolvable symbol") (let [spec (if (c/or (spec? spec) (regex? spec) (get @registry-ref spec)) spec (spec-impl form spec nil nil))] (swap! registry-ref assoc k spec) k)) +(defn ns-qualify + "Qualify symbol s by resolving it or using the current *ns*." + [s] + (if (namespace s) + (let [v (resolve s)] + (assert v (str "Unable to resolve: " s)) + (->sym v)) + (symbol (str (.name *ns*)) (str s)))) + (defmacro def - "Given a namespace-qualified keyword or symbol k, and a spec, spec-name, predicate or regex-op - makes an entry in the registry mapping k to the spec" + "Given a namespace-qualified keyword or resolvable symbol k, and a + spec, spec-name, predicate or regex-op makes an entry in the + registry mapping k to the spec" [k spec-form] - `(def-impl ~k '~(res spec-form) ~spec-form)) + (let [k (if (symbol? k) (ns-qualify k) k)] + `(def-impl '~k '~(res spec-form) ~spec-form))) (defn registry - "returns the registry map" + "returns the registry map, prefer 'get-spec' to lookup a spec by name" [] @registry-ref) +(defn get-spec + "Returns spec registered for keyword/symbol/var k, or nil." + [k] + (get (registry) (if (keyword? k) k (->sym k)))) + (declare map-spec) (defmacro spec @@ -488,8 +504,12 @@ and returns a spec whose conform/explain take a fn and validates it using generative testing. The conformed value is always the fn itself. + See 'fdef' for a single operation that creates an fspec and + registers it, as well as a full description of :args, :ret and :fn + Optionally takes :gen generator-fn, which must be a fn of no args that returns a test.check generator." + [& {:keys [args ret fn gen]}] `(fspec-impl (spec ~args) '~(res args) (spec ~ret) '~(res ret) @@ -504,15 +524,6 @@ `(tuple-impl '~(mapv res preds) ~(vec preds))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defn- ns-qualify - "Qualify symbol s by resolving it or using the current *ns*." - [s] - (if-let [resolved (resolve s)] - (->sym resolved) - (if (namespace s) - s - (symbol (str (.name *ns*)) (str s))))) - (defn- expect "Returns nil if v conforms to spec, else throws ex-info with explain-data." [spec v] @@ -523,11 +534,6 @@ [m] (c/or (:args m) (:ret m))) -(defn fn-spec - "Returns fspec of specs for var or symbol v, or nil." - [v] - (get (registry) (->sym v))) - (defmacro with-instrument-disabled "Disables instrument's checking of calls, within a scope." [& body] @@ -549,7 +555,7 @@ [& args] (if *instrument-enabled* (with-instrument-disabled - (let [specs (fn-spec v)] + (let [specs (get-spec v)] (when (:args specs) (conform! v :args (:args specs) args args)) (binding [*instrument-enabled* true] (.applyTo ^clojure.lang.IFn f args)))) @@ -557,7 +563,7 @@ (defn- macroexpand-check [v args] - (let [specs (fn-spec v)] + (let [specs (get-spec v)] (when-let [arg-spec (:args specs)] (when (= ::invalid (conform arg-spec args)) (let [ed (assoc (explain-data* arg-spec [:args] @@ -580,8 +586,8 @@ expected to contain predicates that relate those values Qualifies fn-sym with resolve, or using *ns* if no resolution found. - Registers specs in the global registry, where they can be retrieved - by calling fn-spec. + Registers an fspec in the global registry, where it can be retrieved + by calling get-spec with the var or fully-qualified symbol. Once registered, function specs are included in doc, checked by instrument, tested by the runner clojure.spec.test/run-tests, and (if @@ -601,8 +607,7 @@ :sym symbol?) :ret symbol?)" [fn-sym & specs] - (let [qn (ns-qualify fn-sym)] - `(clojure.spec/def '~qn (clojure.spec/fspec ~@specs)))) + `(clojure.spec/def ~fn-sym (clojure.spec/fspec ~@specs))) (defn- no-fn-spec [v specs] @@ -629,7 +634,7 @@ spec, if it exists, throwing an ex-info with explain-data if a check fails. Idempotent." [v] (let [v (->var v) - spec (fn-spec v)] + spec (get-spec v)] (if (fn-spec? spec) (locking instrumented-vars (let [{:keys [raw wrapped]} (get @instrumented-vars v) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index 02ed8049..daef2e5b 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -74,7 +74,7 @@ passed through to test.check/quick-check: Returns a map as quick-check, with :explain-data added if :result is false." [v & opts] - (let [specs (spec/fn-spec v)] + (let [specs (spec/get-spec v)] (if (:args specs) (apply check-fn @v specs opts) (throw (IllegalArgumentException. (str "No :args spec for " v)))))) @@ -102,7 +102,7 @@ Returns a map as quick-check, with :explain-data added if [& ns-syms] (if (seq ns-syms) (run-var-tests (->> (apply spec/speced-vars ns-syms) - (filter (fn [v] (:args (spec/fn-spec v)))))) + (filter (fn [v] (:args (spec/get-spec v)))))) (run-tests (.name ^clojure.lang.Namespace *ns*)))) (defn run-all-tests From aa9b5677789821de219006ece80836bd5c6c8b9b Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Thu, 16 Jun 2016 11:47:24 -0400 Subject: [PATCH 059/246] fspec gen ignores :fn rather than not gen. --- src/clj/clojure/spec.clj | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 8c417240..a83dbefb 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -507,6 +507,10 @@ See 'fdef' for a single operation that creates an fspec and registers it, as well as a full description of :args, :ret and :fn + fspecs can generate functions that validate the arguments and + fabricate a return value compliant with the :ret spec, ignoring + the :fn spec if present. + Optionally takes :gen generator-fn, which must be a fn of no args that returns a test.check generator." @@ -1440,11 +1444,10 @@ by ns-syms. Idempotent." {path {:pred 'ifn? :val f :via via :in in}})) (gen* [_ _ _ _] (if gfn (gfn) - (when-not fnspec - (gen/return - (fn [& args] - (assert (valid? argspec args) (with-out-str (explain argspec args))) - (gen/generate (gen retspec))))))) + (gen/return + (fn [& args] + (assert (valid? argspec args) (with-out-str (explain argspec args))) + (gen/generate (gen retspec)))))) (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn)) (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform))))) From 8f118b1f9223e540bfa3d2ee60705a8b35c38f24 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 17 Jun 2016 07:58:21 -0400 Subject: [PATCH 060/246] make explain-out public --- src/clj/clojure/spec.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index a83dbefb..27d41c1d 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -171,8 +171,8 @@ [spec x] (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) [] x)) -(defn- explain-out - "prints an explanation to *out*." +(defn explain-out + "prints explanation data (per 'explain-data') to *out*." [ed] (if ed (do From 6244247fca92c06c41bf186787f2205f1ee2269a Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 17 Jun 2016 10:36:34 -0400 Subject: [PATCH 061/246] specs are not ifns --- src/clj/clojure/spec.clj | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 27d41c1d..75a2af88 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -757,8 +757,6 @@ by ns-syms. Idempotent." keys->specs #(c/or (k->s %) %) id (java.util.UUID/randomUUID)] (reify - clojure.lang.IFn - (invoke [this x] (valid? this x)) Spec (conform* [_ m] (if (keys-pred m) @@ -841,8 +839,6 @@ by ns-syms. Idempotent." (named? pred) (cond-> (the-spec pred) gfn (with-gen gfn)) :else (reify - clojure.lang.IFn - (invoke [this x] (valid? this x)) Spec (conform* [_ x] (dt pred x form cpred?)) (unform* [_ x] (if cpred? @@ -873,8 +869,6 @@ by ns-syms. Idempotent." #(assoc %1 retag %2) retag)] (reify - clojure.lang.IFn - (invoke [this x] (valid? this x)) Spec (conform* [_ x] (if-let [pred (predx x)] (dt pred x form) @@ -913,8 +907,6 @@ by ns-syms. Idempotent." ([forms preds] (tuple-impl forms preds nil)) ([forms preds gfn] (reify - clojure.lang.IFn - (invoke [this x] (valid? this x)) Spec (conform* [_ x] (if-not (c/and (vector? x) @@ -983,8 +975,6 @@ by ns-syms. Idempotent." (tagged-ret (keys i) ret)))) ::invalid)))] (reify - clojure.lang.IFn - (invoke [this x] (valid? this x)) Spec (conform* [_ x] (cform x)) (unform* [_ [k x]] (unform (kps k) x)) @@ -1036,8 +1026,6 @@ by ns-syms. Idempotent." "Do not call this directly, use 'and'" [forms preds gfn] (reify - clojure.lang.IFn - (invoke [this x] (valid? this x)) Spec (conform* [_ x] (and-preds x preds forms)) (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) @@ -1366,8 +1354,6 @@ by ns-syms. Idempotent." "Do not call this directly, use 'spec' with a regex op argument" [re gfn] (reify - clojure.lang.IFn - (invoke [this x] (valid? this x)) Spec (conform* [_ x] (if (c/or (nil? x) (coll? x)) @@ -1413,9 +1399,6 @@ by ns-syms. Idempotent." [argspec aform retspec rform fnspec fform gfn] (let [specs {:args argspec :ret retspec :fn fnspec}] (reify - clojure.lang.IFn - (invoke [this x] (valid? this x)) - clojure.lang.ILookup (valAt [this k] (get specs k)) (valAt [_ k not-found] (get specs k not-found)) From 85a90b2eb46468b4a53da8ccf7f31a48508f5284 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 17 Jun 2016 16:57:47 -0400 Subject: [PATCH 062/246] added bounded-count --- src/clj/clojure/core.clj | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 67f3aa33..2bc08e78 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -7229,6 +7229,18 @@ (cons x (keepi (inc idx) (rest s)))))))))] (keepi 0 coll)))) +(defn bounded-count + "If coll is counted? returns its count, else will count at most the first n + elements of coll using its seq" + {:added "1.9"} + [n coll] + (if (counted? coll) + (count coll) + (loop [i 0 s (seq coll)] + (if (and s (< i n)) + (recur (inc i) (next s)) + i)))) + (defn every-pred "Takes a set of predicates and returns a function f that returns true if all of its composing predicates return a logical true value against all of its arguments, else it returns From 03496c03735cea634b5f448e966ed01d82f8f7ea Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 17 Jun 2016 16:59:30 -0400 Subject: [PATCH 063/246] first cut at every and every-kv --- src/clj/clojure/spec.clj | 140 +++++++++++++++++++++++++++++++++-- src/clj/clojure/spec/gen.clj | 2 +- 2 files changed, 134 insertions(+), 8 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 75a2af88..fc70c7bd 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -27,8 +27,12 @@ 21) (def ^:dynamic *coll-check-limit* - "The number of items validated in a collection spec'ed with 'coll'" - 100) + "The number of elements validated in a collection spec'ed with 'every'" + 101) + +(def ^:dynamic *coll-error-limit* + "The number of errors reported by explain in a collection spec'ed with 'every'" + 20) (def ^:private ^:dynamic *instrument-enabled* "if false, instrumented fns call straight through" @@ -179,25 +183,25 @@ ;;(prn {:ed ed}) (doseq [[path {:keys [pred val reason via in] :as prob}] (::problems ed)] (when-not (empty? in) - (print "In:" in "")) + (print "In:" (pr-str in) "")) (print "val: ") (pr val) (print " fails") (when-not (empty? via) - (print " spec:" (last via))) + (print " spec:" (pr-str (last via)))) (when-not (empty? path) - (print " at:" path)) + (print " at:" (pr-str path))) (print " predicate: ") (pr pred) (when reason (print ", " reason)) (doseq [[k v] prob] (when-not (#{:pred :val :reason :via :in} k) - (print "\n\t" k " ") + (print "\n\t" (pr-str k) " ") (pr v))) (newline)) (doseq [[k v] ed] (when-not (#{::problems} k) - (print k " ") + (print (pr-str k) " ") (pr v) (newline)))) (println "Success!"))) @@ -432,6 +436,40 @@ [& pred-forms] `(and-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) +(defmacro every + "takes a pred and validates collection elements against that pred. + + Note that 'every' does not do exhaustive checking, rather it samples + *coll-check-limit* elements. Nor (as a result) does it do any + conforming of elements. 'explain' will report at most *coll-error-limit* + problems. Thus 'every' should be suitable for potentially large + collections. + + Takes several kwargs options that further constrain the collection: + + :count - specifies coll has exactly this count (default nil) + :min-count, :max-count - coll has count (<= min count max) (default nil) + :distinct - all the elements are distinct (default nil) + + And additional args that control gen + + :gen-max - the maximum coll size to generate (default 20) + :gen-into - the default colection to generate into (will be emptied) (default []) + + Optionally takes :gen generator-fn, which must be a fn of no args that + returns a test.check generator +" + [pred & {:keys [count max-count min-count distinct gen-max gen-into gen] :as opts}] + `(every-impl '~pred ~pred ~(dissoc opts :gen) ~gen)) + +(defmacro every-kv + "like 'every' but takes separate key and val preds and works on associative collections. + + Same options as 'every'" + + [kpred vpred & opts] + `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (key v#)) :gen-into {} ~@opts)) + (defmacro * "Returns a regex op that matches zero or more values matching pred. Produces a vector of matches iff there is at least one match" @@ -1034,6 +1072,94 @@ by ns-syms. Idempotent." (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) (describe* [_] `(and ~@forms)))) +(defn ^:skip-wiki every-impl + "Do not call this directly, use 'every'" + ([form pred opts] (every-impl form pred opts nil)) + ([form pred {:keys [count max-count min-count distinct gen-max gen-into ::kfn] + :or {gen-max 20, gen-into []} + :as opts} + gfn] + (let [check? #(valid? pred %) + kfn (c/or kfn (fn [i v] i))] + (reify + Spec + (conform* [_ x] + (cond + (c/or (not (seqable? x)) + (c/and distinct (not (empty? x)) (not (apply distinct? x))) + (c/and count (not= count (bounded-count (inc count) x))) + (c/and (c/or min-count max-count) + (not (<= (c/or min-count 0) + (bounded-count (if max-count (inc max-count) min-count) x) + (c/or max-count Integer/MAX_VALUE))))) + :invalid + + :else + (if (indexed? x) + (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))] + (loop [i 0] + (if (>= i (c/count x)) + x + (if (check? (nth x i)) + (recur (c/+ i step)) + ::invalid)))) + (c/or (c/and (every? check? (take *coll-check-limit* x)) x) + ::invalid)))) + (unform* [_ x] x) + (explain* [_ path via in x] + (cond + (not (seqable? x)) + {path {:pred 'seqable? :val x :via via :in in}} + + (c/and distinct (not (empty? x)) (not (apply distinct? x))) + {path {:pred 'distinct? :val x :via via :in in}} + + (c/and count (not= count (bounded-count count x))) + {path {:pred `(= ~count (c/count %)) :val x :via via :in in}} + + (c/and (c/or min-count max-count) + (not (<= (c/or min-count 0) + (bounded-count (if max-count (inc max-count) min-count) x) + (c/or max-count Integer/MAX_VALUE)))) + {path {:pred `(<= ~(c/or min-count 0) (c/count %) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}} + + :else + (apply merge + (take *coll-error-limit* + (keep identity + (map (fn [i v] + (let [k (kfn i v)] + (when-not (check? v) + (let [prob (explain-1 form pred (conj path k) via (conj in k) v)] + prob)))) + (range) x)))))) + (gen* [_ overrides path rmap] + (if gfn + (gfn) + (let [init (empty gen-into) + pgen (gensub pred overrides path rmap form)] + (gen/fmap + #(if (vector? init) % (into init %)) + (cond + distinct + (if count + (gen/vector-distinct pgen {:num-elements count :max-tries 100}) + (gen/vector-distinct pgen {:min-elements (c/or min-count 0) + :max-elements (c/or max-count (max gen-max (c/* 2 (c/or min-count 0)))) + :max-tries 100})) + + count + (gen/vector pgen count) + + (c/or min-count max-count) + (gen/vector pgen (c/or min-count 0) (c/or max-count (max gen-max (c/* 2 (c/or min-count 0))))) + + :else + (gen/vector pgen 0 gen-max)))))) + + (with-gen* [_ gfn] (every-impl form pred opts gfn)) + (describe* [_] `(every ~form ~@(mapcat identity opts))))))) + ;;;;;;;;;;;;;;;;;;;;;;; regex ;;;;;;;;;;;;;;;;;;; ;;See: ;; http://matt.might.net/articles/implementation-of-regular-expression-matching-in-scheme-with-derivatives/ diff --git a/src/clj/clojure/spec/gen.clj b/src/clj/clojure/spec/gen.clj index 04ba2036..194721d9 100644 --- a/src/clj/clojure/spec/gen.clj +++ b/src/clj/clojure/spec/gen.clj @@ -89,7 +89,7 @@ (fn [s] (c/list 'lazy-combinator s)) syms))) -(lazy-combinators hash-map list map not-empty set vector fmap elements +(lazy-combinators hash-map list map not-empty set vector vector-distinct fmap elements bind choose fmap one-of such-that tuple sample return large-integer* double*) From 31b804223bc8f9387f5625dae870ffa9cf0281fc Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Sat, 18 Jun 2016 12:43:07 -0400 Subject: [PATCH 064/246] fix :invalid -> ::invalid --- src/clj/clojure/spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index fc70c7bd..aa98a629 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1092,7 +1092,7 @@ by ns-syms. Idempotent." (not (<= (c/or min-count 0) (bounded-count (if max-count (inc max-count) min-count) x) (c/or max-count Integer/MAX_VALUE))))) - :invalid + ::invalid :else (if (indexed? x) From b0c945447a09137eacaa95287ce2f484f9cfdaab Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 20 Jun 2016 11:02:33 -0400 Subject: [PATCH 065/246] support gen overrides by name in addition to path --- src/clj/clojure/spec.clj | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index aa98a629..72ddefbd 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -221,7 +221,8 @@ (defn- gensub [spec overrides path rmap form] ;;(prn {:spec spec :over overrides :path path :form form}) - (let [spec (specize spec)] + (let [spec (c/or (get overrides spec) spec) + spec (specize spec)] (if-let [g (c/or (get overrides path) (gen* spec overrides path rmap))] (gen/such-that #(valid? spec %) g 100) (throw (IllegalStateException. (str "Unable to construct gen at: " path " for: " (abbrev form))))))) @@ -229,12 +230,13 @@ (defn gen "Given a spec, returns the generator for it, or throws if none can be constructed. Optionally an overrides map can be provided which - should map paths (vectors of keywords) to generators. These will be - used instead of the generators at those paths. Note that parent - generator (in the spec or overrides map) will supersede those of any - subtrees. A generator for a regex op must always return a - sequential collection (i.e. a generator for s/? should return either - an empty sequence/vector or a sequence/vector with one item in it)" + should map spec names or paths (vectors of keywords) to + generators. These will be used instead of the generators at those + names/paths. Note that parent generator (in the spec or overrides + map) will supersede those of any subtrees. A generator for a regex + op must always return a sequential collection (i.e. a generator for + s/? should return either an empty sequence/vector or a + sequence/vector with one item in it)" ([spec] (gen spec nil)) ([spec overrides] (gensub spec overrides [] {::recursion-limit *recursion-limit*} spec))) From 22289b285e56b08154892a7ad317ba85d6e89d42 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 20 Jun 2016 10:50:24 -0500 Subject: [PATCH 066/246] Add conditional Inst support for java.time.Instant on Java 1.8+ Signed-off-by: Rich Hickey --- src/clj/clojure/core.clj | 6 ++++++ src/clj/clojure/core_instant18.clj | 17 +++++++++++++++++ 2 files changed, 23 insertions(+) create mode 100644 src/clj/clojure/core_instant18.clj diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 2bc08e78..fa91ba15 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -6639,6 +6639,12 @@ java.util.Date (inst-ms* [inst] (.getTime ^java.util.Date inst))) +;; conditionally extend to Instant on Java 8+ +(try + (Class/forName "java.time.Instant") + (load "core_instant18") + (catch ClassNotFoundException cnfe)) + (defn inst-ms "Return the number of milliseconds since January 1, 1970, 00:00:00 GMT" {:added "1.9"} diff --git a/src/clj/clojure/core_instant18.clj b/src/clj/clojure/core_instant18.clj new file mode 100644 index 00000000..1feb325e --- /dev/null +++ b/src/clj/clojure/core_instant18.clj @@ -0,0 +1,17 @@ +; Copyright (c) Rich Hickey. 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. + +(in-ns 'clojure.core) + +(import 'java.time.Instant) + +(set! *warn-on-reflection* true) + +(extend-protocol Inst + java.time.Instant + (inst-ms* [inst] (.toEpochMilli ^java.time.Instant inst))) From 574ea97ae94acf83fdfd89f95f5518abd2bbd57e Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Thu, 23 Jun 2016 13:22:16 -0400 Subject: [PATCH 067/246] instrument and test enhancements 5 Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 249 ++++++++++++++++++--------- src/clj/clojure/spec/test.clj | 314 +++++++++++++++++++++------------- 2 files changed, 357 insertions(+), 206 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 72ddefbd..e1c3b2bc 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -225,7 +225,9 @@ spec (specize spec)] (if-let [g (c/or (get overrides path) (gen* spec overrides path rmap))] (gen/such-that #(valid? spec %) g 100) - (throw (IllegalStateException. (str "Unable to construct gen at: " path " for: " (abbrev form))))))) + (let [abbr (abbrev form)] + (throw (ex-info (str "Unable to construct gen at: " path " for: " abbr) + {::path path ::no-gen-for form})))))) (defn gen "Given a spec, returns the generator for it, or throws if none can @@ -277,10 +279,9 @@ (defn ns-qualify "Qualify symbol s by resolving it or using the current *ns*." [s] - (if (namespace s) - (let [v (resolve s)] - (assert v (str "Unable to resolve: " s)) - (->sym v)) + (if-let [ns-sym (some-> s namespace symbol)] + (c/or (some-> (get (ns-aliases *ns*) ns-sym) str (symbol (name s))) + s) (symbol (str (.name *ns*)) (str s)))) (defmacro def @@ -585,8 +586,9 @@ ~@body)) (defn- spec-checking-fn - [v f] - (let [conform! (fn [v role spec data args] + [v f fn-spec] + (let [fn-spec (maybe-spec fn-spec) + conform! (fn [v role spec data args] (let [conformed (conform spec data)] (if (= ::invalid conformed) (let [ed (assoc (explain-data* spec [role] [] [] data) @@ -599,16 +601,15 @@ [& args] (if *instrument-enabled* (with-instrument-disabled - (let [specs (get-spec v)] - (when (:args specs) (conform! v :args (:args specs) args args)) - (binding [*instrument-enabled* true] - (.applyTo ^clojure.lang.IFn f args)))) + (when (:args fn-spec) (conform! v :args (:args fn-spec) args args)) + (binding [*instrument-enabled* true] + (.applyTo ^clojure.lang.IFn f args))) (.applyTo ^clojure.lang.IFn f args))))) (defn- macroexpand-check [v args] - (let [specs (get-spec v)] - (when-let [arg-spec (:args specs)] + (let [fn-spec (get-spec v)] + (when-let [arg-spec (:args fn-spec)] (when (= ::invalid (conform arg-spec args)) (let [ed (assoc (explain-data* arg-spec [:args] (if-let [name (spec-name arg-spec)] [name] []) [] args) @@ -654,13 +655,13 @@ `(clojure.spec/def ~fn-sym (clojure.spec/fspec ~@specs))) (defn- no-fn-spec - [v specs] + [v spec] (ex-info (str "Fn at " v " is not spec'ed.") - {:var v :specs specs})) + {:var v :spec spec})) (def ^:private instrumented-vars "Map for instrumented vars to :raw/:wrapped fns" - (atom {})) + (atom {})) (defn- ->var [s-or-v] @@ -671,87 +672,167 @@ v (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var"))))))) +(defn- instrument-choose-fn + "Helper for instrument." + [f spec sym {:keys [stub replace]}] + (if (some #{sym} stub) + (-> spec gen gen/generate) + (get replace sym f))) + +(defn- instrument-choose-spec + "Helper for instrument" + [spec sym {overrides :spec}] + (get overrides sym spec)) + +(defn- as-seqable + [x] + (if (seqable? x) x (list x))) + +(defn- instrument-1 + [s opts] + (when-let [v (resolve s)] + (let [spec (get-spec v) + {:keys [raw wrapped]} (get @instrumented-vars v) + current @v + to-wrap (if (= wrapped current) raw current) + ospec (c/or (instrument-choose-spec spec s opts) + (throw (no-fn-spec v spec))) + ofn (instrument-choose-fn to-wrap ospec s opts) + checked (spec-checking-fn v ofn ospec)] + (alter-var-root v (constantly checked)) + (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked})) + (->sym v))) + (defn instrument - "Instruments the var at v, a var or symbol, to check specs -registered with fdef. Wraps the fn at v to check the :args -spec, if it exists, throwing an ex-info with explain-data if a -check fails. Idempotent." - [v] - (let [v (->var v) - spec (get-spec v)] - (if (fn-spec? spec) - (locking instrumented-vars - (let [{:keys [raw wrapped]} (get @instrumented-vars v) - current @v] - (when-not (= wrapped current) - (let [checked (spec-checking-fn v current)] - (alter-var-root v (constantly checked)) - (swap! instrumented-vars assoc v {:raw current :wrapped checked})))) - v) - (throw (no-fn-spec v spec))))) + "Instruments the vars named by sym-or-syms, a symbol or a +collection of symbols. Idempotent. + +If a var has an :args fn-spec, sets the var's root binding to a +fn that checks arg conformance (throwing an exception on failure) +before delegating to the original fn. + +The opts map can be used to override registered specs, and/or to +replace fn implementations entirely: + + :spec a map from fn symbols to spec overrides + :stub a collection of fn symbols to stub + :replace a map from fn symbols to fn overrides + +:spec overrides registered fn-specs with specs your provide. Use +:spec overrides to provide specs for libraries that do not have +them, or to constrain your own use of a fn to a subset of its +spec'ed contract. + +:stub replaces a fn with a stub that checks :args, then uses the +:ret spec to generate a return value. + +:replace replaces a fn with a fn that check :args, then invokes +a fn you provide, enabling arbitrary stubbing and mocking. + +:spec can be used in combination with :stub or :replace. + +Opts for symbols not named by sym-or-syms are ignored. This +facilitates sharing a common options map across many different +calls to instrument. + +Returns a collection of syms naming the vars instrumented." + ([sym-or-syms] (instrument sym-or-syms nil)) + ([sym-or-syms opts] + (locking instrumented-vars + (into + [] + (comp (map #(instrument-1 % opts)) + (remove nil?)) + (as-seqable sym-or-syms))))) + +(defn- unstrument-1 + [s] + (when-let [v (resolve s)] + (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] + (let [current @v] + (when (= wrapped current) + (alter-var-root v (constantly raw)))) + (swap! instrumented-vars dissoc v)) + (->sym v))) (defn unstrument - "Undoes instrument on the var at v, a var or symbol. Idempotent." - [v] - (let [v (->var v)] - (locking instrumented-vars - (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] - (let [current @v] - (when (= wrapped current) - (alter-var-root v (constantly raw)))) - (swap! instrumented-vars dissoc v)) - v))) - -(defn speced-vars - "Returns the set of vars whose namespace is in ns-syms AND -whose vars have been speced with fdef. If no ns-syms are -specified, return speced vars from all namespaces." - [& ns-syms] - (let [ns-match? (if (seq ns-syms) - (set (map str ns-syms)) - (constantly true))] - (reduce-kv - (fn [s k _] - (if (c/and (symbol? k) - (ns-match? (namespace k))) - (if-let [v (resolve k)] - (conj s v) - s) - s)) - #{} - (registry)))) + "Undoes instrument on the vars named by sym-or-syms. Idempotent. +Returns a collection of syms naming the vars unstrumented." + [sym-or-syms] + (locking instrumented-vars + (into + [] + (comp (map #(unstrument-1 %)) + (remove nil?)) + (as-seqable sym-or-syms)))) + +(defn- opt-syms + "Returns set of symbols referenced by 'instrument' opts map" + [opts] + (reduce into #{} [(:stub opts) (c/keys (:replace opts)) (c/keys (:spec opts))])) + +(defn- ns-matcher + [ns-syms] + (let [ns-names (into #{} (map str) ns-syms)] + (fn [s] + (contains? ns-names (namespace s))))) (defn instrument-ns - "Call instrument for all speced-vars in namespaces named -by ns-syms. Idempotent." - [& ns-syms] - (when (seq ns-syms) - (locking instrumented-vars - (doseq [v (apply speced-vars ns-syms)] - (instrument v))))) + "Like instrument, but works on all symbols whose namespace is +in ns-or-nses, specified as a symbol or a seq of symbols." + ([] (instrument-ns (.name ^clojure.lang.Namespace *ns*))) + ([ns-or-nses] (instrument-ns ns-or-nses nil)) + ([ns-or-nses opts] + (let [ns-match? (ns-matcher (as-seqable ns-or-nses))] + (locking instrumented-vars + (into + [] + (comp c/cat + (filter symbol?) + (filter ns-match?) + (distinct) + (map #(instrument-1 % opts)) + (remove nil?)) + [(c/keys (registry)) (opt-syms opts)]))))) (defn unstrument-ns - "Call unstrument for all speced-vars in namespaces named -by ns-syms. Idempotent." - [& ns-syms] - (when (seq ns-syms) + "Like unstrument, but works on all symbols whose namespace is +in ns-or-nses, specified as a symbol or a seq of symbols." + [ns-or-nses] + (let [ns-match? (ns-matcher (as-seqable ns-or-nses))] (locking instrumented-vars - (doseq [v (apply speced-vars ns-syms)] - (unstrument v))))) + (into + [] + (comp (map ->sym) + (filter ns-match?) + (map unstrument-1) + (remove nil?)) + (c/keys @instrumented-vars))))) (defn instrument-all - "Call instrument for all speced-vars. Idempotent." - [] - (locking instrumented-vars - (doseq [v (speced-vars)] - (instrument v)))) + "Like instrument, but works on all vars." + ([] (instrument-all nil)) + ([opts] + (locking instrumented-vars + (into + [] + (comp c/cat + (filter symbol?) + (distinct) + (map #(instrument-1 % opts)) + (remove nil?)) + [(c/keys (registry)) (opt-syms opts)])))) (defn unstrument-all - "Call unstrument for all speced-vars. Idempotent" + "Like unstrument, but works on all vars." [] (locking instrumented-vars - (doseq [v (speced-vars)] - (unstrument v)))) + (into + [] + (comp (map ->sym) + (map unstrument-1) + (remove nil?)) + (c/keys @instrumented-vars)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- recur-limit? [rmap id path k] @@ -1674,4 +1755,4 @@ by ns-syms. Idempotent." ~@(when-not NaN? '[#(not (Double/isNaN %))]) ~@(when max `[#(<= % ~max)]) ~@(when min `[#(<= ~min %)])) - :gen #(gen/double* ~m))) \ No newline at end of file + :gen #(gen/double* ~m))) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index daef2e5b..c4044d2b 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -7,140 +7,210 @@ ; You must not remove this notice, or any other, from this software. (ns clojure.spec.test + (:refer-clojure :exclude [test]) (:require - [clojure.spec :as spec] + [clojure.pprint :as pp] + [clojure.spec :as s] [clojure.spec.gen :as gen])) -;; wrap spec/explain-data until specs always return nil for ok data -(defn- explain-data* - [spec v] - (when-not (spec/valid? spec v nil) - (spec/explain-data spec v))) - -;; wrap and unwrap spec failure data in an exception so that -;; quick-check will treat it as a failure. -(defn- wrap-failing - [explain-data step] - (ex-info "Wrapper" {::check-call (assoc explain-data :failed-on step)})) - -(defn- unwrap-failing - [ret] - (let [ret (if-let [explain (-> ret :result ex-data ::check-call)] - (assoc ret :result explain) - ret)] - (if-let [shrunk-explain (-> ret :shrunk :result ex-data ::check-call)] - (assoc-in ret [:shrunk :result] shrunk-explain) - ret))) +(in-ns 'clojure.spec.test.check) +(in-ns 'clojure.spec.test) +(alias 'stc 'clojure.spec.test.check) + +(defn- explain-test + [args spec v role] + (ex-info + "Specification-based test failed" + (when-not (s/valid? spec v nil) + (assoc (s/explain-data* spec [role] [] [] v) + ::args args + ::val v)))) (defn- check-call "Returns true if call passes specs, otherwise *returns* an exception -with explain-data plus a :failed-on key under ::check-call." +with explain-data under ::check-call." [f specs args] - (let [cargs (when (:args specs) (spec/conform (:args specs) args))] - (if (= cargs ::spec/invalid) - (wrap-failing (explain-data* (:args specs) args) :args) + (let [cargs (when (:args specs) (s/conform (:args specs) args))] + (if (= cargs ::s/invalid) + (explain-test args (:args specs) args :args) (let [ret (apply f args) - cret (when (:ret specs) (spec/conform (:ret specs) ret))] - (if (= cret ::spec/invalid) - (wrap-failing (explain-data* (:ret specs) ret) :ret) + cret (when (:ret specs) (s/conform (:ret specs) ret))] + (if (= cret ::s/invalid) + (explain-test args (:ret specs) ret :ret) (if (and (:args specs) (:ret specs) (:fn specs)) - (if (spec/valid? (:fn specs) {:args cargs :ret cret}) + (if (s/valid? (:fn specs) {:args cargs :ret cret}) true - (wrap-failing (explain-data* (:fn specs) {:args cargs :ret cret}) :fn)) + (explain-test args (:fn specs) {:args cargs :ret cret} :fn)) true)))))) -(defn check-fn - "Check a function using provided specs and test.check. -Same options and return as check-var" - [f specs - & {:keys [num-tests seed max-size reporter-fn] - :or {num-tests 100 max-size 200 reporter-fn (constantly nil)}}] - (let [g (spec/gen (:args specs)) - prop (gen/for-all* [g] #(check-call f specs %))] - (let [ret (gen/quick-check num-tests prop :seed seed :max-size max-size :reporter-fn reporter-fn)] - (if-let [[smallest] (-> ret :shrunk :smallest)] - (unwrap-failing ret) - ret)))) - -(defn check-var - "Checks a var's specs using test.check. Optional args are -passed through to test.check/quick-check: - - num-tests number of tests to run, default 100 - seed random seed - max-size how large an input to generate, max 200 - reporter-fn reporting fn - -Returns a map as quick-check, with :explain-data added if -:result is false." - [v & opts] - (let [specs (spec/get-spec v)] - (if (:args specs) - (apply check-fn @v specs opts) - (throw (IllegalArgumentException. (str "No :args spec for " v)))))) - -(defn- run-var-tests - "Helper for run-tests, run-all-tests." - [vs] - (let [reporter-fn println] - (reduce - (fn [totals v] - (let [_ (println "Checking" v) - ret (check-var v :reporter-fn reporter-fn)] - (prn ret) - (cond-> totals - true (update :test inc) - (true? (:result ret)) (update :pass inc) - (::spec/problems (:result ret)) (update :fail inc) - (instance? Throwable (:result ret)) (update :error inc)))) - {:test 0, :pass 0, :fail 0, :error 0} - vs))) - -(defn run-tests - "Like run-all-tests, but scoped to specific namespaces, or to -*ns* if no ns-sym are specified." - [& ns-syms] - (if (seq ns-syms) - (run-var-tests (->> (apply spec/speced-vars ns-syms) - (filter (fn [v] (:args (spec/get-spec v)))))) - (run-tests (.name ^clojure.lang.Namespace *ns*)))) - -(defn run-all-tests - "Like clojure.test/run-all-tests, but runs test.check tests -for all speced vars. Prints per-test results to *out*, and -returns a map with :test,:pass,:fail, and :error counts." - [] - (run-var-tests (spec/speced-vars))) - -(comment - (require '[clojure.pprint :as pp] - '[clojure.spec :as s] - '[clojure.spec.gen :as gen] - '[clojure.test :as ctest]) - - (require :reload '[clojure.spec.test :as test]) - - (load-file "examples/broken_specs.clj") - (load-file "examples/correct_specs.clj") - - ;; discover speced vars for your own test runner - (s/speced-vars) - - ;; check a single var - (test/check-var #'-) - (test/check-var #'+) - (test/check-var #'clojure.spec.broken-specs/throwing-fn) - - ;; old style example tests - (ctest/run-all-tests) - - (s/speced-vars 'clojure.spec.correct-specs) - ;; new style spec tests return same kind of map - (test/check-var #'subs) - (clojure.spec.test/run-tests 'clojure.core) - (test/run-all-tests) - - ) +(defn- throwable? + [x] + (instance? Throwable x)) + +(defn- check-fn + [f specs {gen :gen opts ::stc/opts}] + (let [{:keys [num-tests] :or {num-tests 100}} opts + g (try (s/gen (:args specs) gen) (catch Throwable t t))] + (if (throwable? g) + {:result g} + (let [prop (gen/for-all* [g] #(check-call f specs %))] + (apply gen/quick-check num-tests prop (mapcat identity opts)))))) + +(defn- unwrap-return + "Unwraps exceptions used to flow information through test.check." + [x] + (let [data (ex-data x)] + (if (or (::args data) (::s/args data) (::s/no-gen-for data)) + data + x))) + +(defn- result-type + [result] + (let [ret (::return result)] + (cond + (true? ret) :pass + (::s/args ret) :instrument-fail + (::s/no-gen-for ret) :no-gen + (::args ret) :fail + :default :error))) + +(defn- make-test-result + "Builds spec result map." + [test-sym spec test-check-ret] + (let [result (merge {::sym test-sym + ::spec spec + ::stc/ret test-check-ret} + (when-let [result (-> test-check-ret :result)] + {::return (unwrap-return result)}) + (when-let [shrunk (-> test-check-ret :shrunk)] + {::return (unwrap-return (:result shrunk))}))] + (assoc result ::result-type (result-type result)))) + +(defn- abbrev-result + [x] + (if (true? (::return x)) + (dissoc x ::spec ::stc/ret ::return) + (update (dissoc x ::stc/ret) ::spec s/describe))) + +(defn- default-result-callback + [x] + (pp/pprint (abbrev-result x)) + (flush)) + +(defn- test-1 + [{:keys [s f spec]} + {:keys [result-callback] :as opts + :or {result-callback default-result-callback}}] + (let [result (cond + (nil? f) + {::result-type :no-fn ::sym s ::spec spec} + + (:args spec) + (let [tcret (check-fn f spec opts)] + (make-test-result s spec tcret)) + + :default + {::result-type :no-args ::sym s ::spec spec})] + (result-callback result) + result)) + +;; duped from spec to avoid introducing public API +(defn- as-seqable + [x] + (if (seqable? x) x (list x))) + +;; duped from spec to avoid introducing public API +(defn- ns-matcher + [ns-syms] + (let [ns-names (into #{} (map str) ns-syms)] + (fn [s] + (contains? ns-names (namespace s))))) + +(defn- update-result-map + ([] + {:test 0 :pass 0 :fail 0 :error 0 + :no-fn 0 :no-args 0 :no-gen 0}) + ([m] m) + ([results result] + (-> results + (update :test inc) + (update (::result-type result) inc)))) + +(defn- sym->test-map + [s] + (let [v (resolve s)] + {:s s + :f (when v @v) + :spec (when v (s/get-spec v))})) + +(defn test-fn + "Runs generative tests for fn f using spec and opts. See +'test' for options and return." + ([f spec] (test-fn f spec nil)) + ([f spec opts] + (update-result-map + (update-result-map) + (test-1 {:f f :spec spec} opts)))) + +(defn test + "Checks specs for fns named by sym-or-syms using test.check. + +The opts map includes the following optional keys: + +:clojure.spec.test.check/opts opts to flow through test.check +:result-callback callback fn to handle test results +:gen overrides map for spec/gen + +The c.s.t.c/opts include :num-tests in addition to the keys +documented by test.check. + +The result-callback defaults to default-result-callback. + +Returns a map with the following keys: + +:test # of syms tested +:pass # of passing tests +:fail # of failing tests +:error # of throwing tests +:no-fn # of syms with no fn +:no-args # of syms with no argspec +:no-gen # of syms for which arg data gen failed" + ([sym-or-syms] (test sym-or-syms nil)) + ([sym-or-syms opts] + (transduce + (comp + (map sym->test-map) + (map #(test-1 % opts))) + update-result-map + (as-seqable sym-or-syms)))) + +(defn test-ns + "Like test, but scoped to specific namespaces, or to +*ns* if no arg specified." + ([] (test-ns (.name ^clojure.lang.Namespace *ns*))) + ([ns-or-nses] (test-ns ns-or-nses nil)) + ([ns-or-nses opts] + (let [ns-match? (ns-matcher (as-seqable ns-or-nses))] + (transduce + (comp (filter symbol?) + (filter ns-match?) + (map sym->test-map) + (map #(test-1 % opts))) + update-result-map + (keys (s/registry)))))) + +(defn test-all + "Like test, but tests all vars named by fn-specs in the spec +registry." + ([] (test-all nil)) + ([opts] + (transduce + (comp (filter symbol?) + (map sym->test-map) + (map #(test-1 % opts))) + update-result-map + (keys (s/registry))))) + From 43b029fb061f3b85679f7aa3dc8a94be57bba95c Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Thu, 23 Jun 2016 14:30:22 -0400 Subject: [PATCH 068/246] docstring tweaks --- src/clj/clojure/spec.clj | 28 ++++++++++++++-------------- src/clj/clojure/spec/test.clj | 2 +- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index e1c3b2bc..dcc7ed8a 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -712,11 +712,15 @@ fn that checks arg conformance (throwing an exception on failure) before delegating to the original fn. The opts map can be used to override registered specs, and/or to -replace fn implementations entirely: +replace fn implementations entirely. Opts for symbols not named by +sym-or-syms are ignored. This facilitates sharing a common options map +across many different calls to instrument. - :spec a map from fn symbols to spec overrides - :stub a collection of fn symbols to stub - :replace a map from fn symbols to fn overrides +The opts map may have the following keys: + + :spec a map from var-name symbols to override specs + :stub a collection of var-name symbols to be replaced by stubs + :replace a map from var-name symbols to replacement fns :spec overrides registered fn-specs with specs your provide. Use :spec overrides to provide specs for libraries that do not have @@ -726,15 +730,11 @@ spec'ed contract. :stub replaces a fn with a stub that checks :args, then uses the :ret spec to generate a return value. -:replace replaces a fn with a fn that check :args, then invokes -a fn you provide, enabling arbitrary stubbing and mocking. +:replace replaces a fn with a fn that checks args conformance, then +invokes the fn you provide, enabling arbitrary stubbing and mocking. :spec can be used in combination with :stub or :replace. -Opts for symbols not named by sym-or-syms are ignored. This -facilitates sharing a common options map across many different -calls to instrument. - Returns a collection of syms naming the vars instrumented." ([sym-or-syms] (instrument sym-or-syms nil)) ([sym-or-syms opts] @@ -778,8 +778,8 @@ Returns a collection of syms naming the vars unstrumented." (contains? ns-names (namespace s))))) (defn instrument-ns - "Like instrument, but works on all symbols whose namespace is -in ns-or-nses, specified as a symbol or a seq of symbols." + "Like instrument, but works on all symbols whose namespace name is +in ns-or-nses, a symbol or a collection of symbols." ([] (instrument-ns (.name ^clojure.lang.Namespace *ns*))) ([ns-or-nses] (instrument-ns ns-or-nses nil)) ([ns-or-nses opts] @@ -796,8 +796,8 @@ in ns-or-nses, specified as a symbol or a seq of symbols." [(c/keys (registry)) (opt-syms opts)]))))) (defn unstrument-ns - "Like unstrument, but works on all symbols whose namespace is -in ns-or-nses, specified as a symbol or a seq of symbols." + "Like unstrument, but works on all symbols whose namespace name is +in ns-or-nses, a symbol or a collection of symbols." [ns-or-nses] (let [ns-match? (ns-matcher (as-seqable ns-or-nses))] (locking instrumented-vars diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index c4044d2b..c0385570 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -153,7 +153,7 @@ with explain-data under ::check-call." (test-1 {:f f :spec spec} opts)))) (defn test - "Checks specs for fns named by sym-or-syms using test.check. + "Checks specs for fns named by sym-or-syms (a symbol or collection of symbols) using test.check. The opts map includes the following optional keys: From 6d48ae372a540903173be2974b66b8911371e05d Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Thu, 28 Apr 2016 13:24:09 -0500 Subject: [PATCH 069/246] CLJ-1910 Namespaced maps in reader and printer Signed-off-by: Rich Hickey --- src/clj/clojure/core_print.clj | 43 +++++++++-- src/jvm/clojure/lang/EdnReader.java | 55 ++++++++++++++ src/jvm/clojure/lang/LispReader.java | 102 ++++++++++++++++++++++++++ test/clojure/test_clojure/reader.cljc | 37 +++++++++- 4 files changed, 228 insertions(+), 9 deletions(-) diff --git a/src/clj/clojure/core_print.clj b/src/clj/clojure/core_print.clj index 12d8354b..7c162348 100644 --- a/src/clj/clojure/core_print.clj +++ b/src/clj/clojure/core_print.clj @@ -205,18 +205,45 @@ (print-meta v w) (print-sequential "[" pr-on " " "]" v w)) +(defn- print-prefix-map [prefix m print-one w] + (print-sequential + (str prefix "{") + (fn [e ^Writer w] + (do (print-one (key e) w) (.append w \space) (print-one (val e) w))) + ", " + "}" + (seq m) w)) + (defn- print-map [m print-one w] - (print-sequential - "{" - (fn [e ^Writer w] - (do (print-one (key e) w) (.append w \space) (print-one (val e) w))) - ", " - "}" - (seq m) w)) + (print-prefix-map nil m print-one w)) + +(defn- strip-ns + [named] + (if (symbol? named) + (symbol nil (name named)) + (keyword nil (name named)))) + +(defn- lift-ns + "Returns [lifted-ns lifted-map] or nil if m can't be lifted." + [m] + (loop [ns nil + [[k v :as entry] & entries] (seq m) + lm (empty m)] + (if entry + (when (or (keyword? k) (symbol? k)) + (if ns + (when (= ns (namespace k)) + (recur ns entries (assoc lm (strip-ns k) v))) + (when-let [new-ns (namespace k)] + (recur new-ns entries (assoc lm (strip-ns k) v))))) + [ns lm]))) (defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w] (print-meta m w) - (print-map m pr-on w)) + (let [[ns lift-map] (lift-ns m)] + (if ns + (print-prefix-map (str "#:" ns) lift-map pr-on w) + (print-map m pr-on w)))) (defmethod print-dup java.util.Map [m, ^Writer w] (print-ctor m #(print-map (seq %1) print-dup %2) w)) diff --git a/src/jvm/clojure/lang/EdnReader.java b/src/jvm/clojure/lang/EdnReader.java index 08cfe20f..5c3bd104 100644 --- a/src/jvm/clojure/lang/EdnReader.java +++ b/src/jvm/clojure/lang/EdnReader.java @@ -16,6 +16,7 @@ import java.math.BigDecimal; import java.math.BigInteger; import java.util.ArrayList; +import java.util.Iterator; import java.util.List; import java.util.regex.Matcher; import java.util.regex.Pattern; @@ -53,6 +54,7 @@ public class EdnReader{ dispatchMacros['{'] = new SetReader(); dispatchMacros['<'] = new UnreadableReader(); dispatchMacros['_'] = new DiscardReader(); + dispatchMacros[':'] = new NamespaceMapReader(); } static boolean nonConstituent(int ch){ @@ -482,6 +484,59 @@ public Object invoke(Object reader, Object underscore, Object opts) { } } +public static class NamespaceMapReader extends AFn{ + public Object invoke(Object reader, Object colon, Object opts) { + PushbackReader r = (PushbackReader) reader; + + // Read ns symbol + Object sym = read(r, true, null, false, opts); + if (!(sym instanceof Symbol) || ((Symbol)sym).getNamespace() != null) + throw new RuntimeException("Namespaced map must specify a valid namespace: " + sym); + String ns = ((Symbol)sym).getName(); + + // Read map + int nextChar = read1(r); + while(isWhitespace(nextChar)) + nextChar = read1(r); + if('{' != nextChar) + throw new RuntimeException("Namespaced map must specify a map"); + List kvs = readDelimitedList('}', r, true, opts); + if((kvs.size() & 1) == 1) + throw Util.runtimeException("Namespaced map literal must contain an even number of forms"); + + // Construct output map + IPersistentMap m = RT.map(); + Iterator iter = kvs.iterator(); + while(iter.hasNext()) { + Object key = iter.next(); + Object val = iter.next(); + + if(key instanceof Keyword) { + Keyword kw = (Keyword) key; + if (kw.getNamespace() == null) { + m = m.assoc(Keyword.intern(ns, kw.getName()), val); + } else if (kw.getNamespace().equals("_")) { + m = m.assoc(Keyword.intern(null, kw.getName()), val); + } else { + m = m.assoc(kw, val); + } + } else if(key instanceof Symbol) { + Symbol s = (Symbol) key; + if (s.getNamespace() == null) { + m = m.assoc(Symbol.intern(ns, s.getName()), val); + } else if (s.getNamespace().equals("_")) { + m = m.assoc(Symbol.intern(null, s.getName()), val); + } else { + m = m.assoc(s, val); + } + } else { + m = m.assoc(key, val); + } + } + return m; + } +} + public static class DispatchReader extends AFn{ public Object invoke(Object reader, Object hash, Object opts) { int ch = read1((Reader) reader); diff --git a/src/jvm/clojure/lang/LispReader.java b/src/jvm/clojure/lang/LispReader.java index 6441d452..a4afb847 100644 --- a/src/jvm/clojure/lang/LispReader.java +++ b/src/jvm/clojure/lang/LispReader.java @@ -31,6 +31,7 @@ import java.math.BigDecimal; import java.math.BigInteger; import java.util.ArrayList; +import java.util.Iterator; import java.util.LinkedList; import java.util.List; import java.util.Map; @@ -115,6 +116,7 @@ public class LispReader{ dispatchMacros['<'] = new UnreadableReader(); dispatchMacros['_'] = new DiscardReader(); dispatchMacros['?'] = new ConditionalReader(); + dispatchMacros[':'] = new NamespaceMapReader(); } static boolean isWhitespace(int ch){ @@ -597,6 +599,106 @@ public Object invoke(Object reader, Object underscore, Object opts, Object pendi } } +// :a.b{:c 1} => {:a.b/c 1} +// ::{:c 1} => {:a.b/c 1} (where *ns* = a.b) +// ::a{:c 1} => {:a.b/c 1} (where a is aliased to a.b) +public static class NamespaceMapReader extends AFn{ + public Object invoke(Object reader, Object colon, Object opts, Object pendingForms) { + PushbackReader r = (PushbackReader) reader; + + boolean auto = false; + int autoChar = read1(r); + if(autoChar == ':') + auto = true; + else + unread(r, autoChar); + + Object sym = null; + int nextChar = read1(r); + if(isWhitespace(nextChar)) { // the #:: { } case or an error + if(auto) { + while (isWhitespace(nextChar)) + nextChar = read1(r); + if(nextChar != '{') { + unread(r, nextChar); + throw Util.runtimeException("Namespaced map must specify a namespace"); + } + } else { + unread(r, nextChar); + throw Util.runtimeException("Namespaced map must specify a namespace"); + } + } else if(nextChar != '{') { // #:foo { } or #::foo { } + unread(r, nextChar); + sym = read(r, true, null, false, opts, pendingForms); + nextChar = read1(r); + while(isWhitespace(nextChar)) + nextChar = read1(r); + } + if(nextChar != '{') + throw Util.runtimeException("Namespaced map must specify a map"); + + // Resolve autoresolved ns + String ns; + if (auto) { + if (sym == null) { + ns = Compiler.currentNS().getName().getName(); + } else if (!(sym instanceof Symbol) || ((Symbol)sym).getNamespace() != null) { + throw Util.runtimeException("Namespaced map must specify a valid namespace: " + sym); + } else { + Namespace resolvedNS = Compiler.currentNS().lookupAlias((Symbol)sym); + if(resolvedNS == null) + resolvedNS = Namespace.find((Symbol)sym); + + if(resolvedNS == null) { + throw Util.runtimeException("Unknown auto-resolved namespace alias: " + sym); + } else { + ns = resolvedNS.getName().getName(); + } + } + } else if (!(sym instanceof Symbol) || ((Symbol)sym).getNamespace() != null) { + throw Util.runtimeException("Namespaced map must specify a valid namespace: " + sym); + } else { + ns = ((Symbol)sym).getName(); + } + + // Read map + List kvs = readDelimitedList('}', r, true, opts, ensurePending(pendingForms)); + if((kvs.size() & 1) == 1) + throw Util.runtimeException("Namespaced map literal must contain an even number of forms"); + + // Construct output map + IPersistentMap m = RT.map(); + Iterator iter = kvs.iterator(); + while(iter.hasNext()) { + Object key = iter.next(); + Object val = iter.next(); + + if(key instanceof Keyword) { + Keyword kw = (Keyword) key; + if (kw.getNamespace() == null) { + m = m.assoc(Keyword.intern(ns, kw.getName()), val); + } else if (kw.getNamespace().equals("_")) { + m = m.assoc(Keyword.intern(null, kw.getName()), val); + } else { + m = m.assoc(kw, val); + } + } else if(key instanceof Symbol) { + Symbol s = (Symbol) key; + if (s.getNamespace() == null) { + m = m.assoc(Symbol.intern(ns, s.getName()), val); + } else if (s.getNamespace().equals("_")) { + m = m.assoc(Symbol.intern(null, s.getName()), val); + } else { + m = m.assoc(s, val); + } + } else { + m = m.assoc(key, val); + } + } + return m; + } +} + public static class WrappingReader extends AFn{ final Symbol sym; diff --git a/test/clojure/test_clojure/reader.cljc b/test/clojure/test_clojure/reader.cljc index 6d03590d..91ce25ec 100644 --- a/test/clojure/test_clojure/reader.cljc +++ b/test/clojure/test_clojure/reader.cljc @@ -22,8 +22,10 @@ read-instant-calendar read-instant-timestamp]]) (:require clojure.walk + [clojure.edn :as edn] [clojure.test.generative :refer (defspec)] - [clojure.test-clojure.generators :as cgen]) + [clojure.test-clojure.generators :as cgen] + [clojure.edn :as edn]) (:import [clojure.lang BigInt Ratio] java.io.File java.util.TimeZone)) @@ -713,3 +715,36 @@ (is (= 23 (read-string {:eof 23} ""))) (is (= 23 (read {:eof 23} (clojure.lang.LineNumberingPushbackReader. (java.io.StringReader. "")))))) + +(require '[clojure.string :as s]) +(deftest namespaced-maps + (is (= #:a{1 nil, :b nil, :b/c nil, :_/d nil} + #:a {1 nil, :b nil, :b/c nil, :_/d nil} + {1 nil, :a/b nil, :b/c nil, :d nil})) + (is (= #::{1 nil, :a nil, :a/b nil, :_/d nil} + #:: {1 nil, :a nil, :a/b nil, :_/d nil} + {1 nil, :clojure.test-clojure.reader/a nil, :a/b nil, :d nil} )) + (is (= #::s{1 nil, :a nil, :a/b nil, :_/d nil} + #::s {1 nil, :a nil, :a/b nil, :_/d nil} + {1 nil, :clojure.string/a nil, :a/b nil, :d nil})) + (is (= #::clojure.core{1 nil, :a nil, :a/b nil, :_/d nil} {1 nil, :clojure.core/a nil, :a/b nil, :d nil})) + (is (= (read-string "#:a{b 1 b/c 2}") {'a/b 1, 'b/c 2})) + (is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::{b 1, b/c 2, _/d 3}")) {'clojure.test-clojure.reader/b 1, 'b/c 2, 'd 3})) + (is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::s{b 1, b/c 2, _/d 3}")) {'clojure.string/b 1, 'b/c 2, 'd 3})) + (is (= (read-string "#::clojure.core{b 1, b/c 2, _/d 3}") {'clojure.core/b 1, 'b/c 2, 'd 3}))) + +(deftest namespaced-map-errors + (are [err msg form] (thrown-with-msg? err msg (read-string form)) + Exception #"Invalid token" "#:::" + Exception #"Namespaced map literal must contain an even number of forms" "#:s{1}" + Exception #"Namespaced map must specify a valid namespace" "#:s/t{1 2}" + Exception #"Namespaced map literal must contain an even number of forms" "#::clojure.core{1}" + Exception #"Namespaced map must specify a valid namespace" "#::clojure.core/t{1 2}" + Exception #"Unknown auto-resolved namespace alias" "#::BOGUS{1 2}" + Exception #"Namespaced map must specify a namespace" "#:: clojure.core{:a 1}" + Exception #"Namespaced map must specify a namespace" "#: clojure.core{:a 1}")) + +(deftest namespaced-map-edn + (is (= {1 1, :a/b 2, :b/c 3, :d 4} + (edn/read-string "#:a{1 1, :b 2, :b/c 3, :_/d 4}") + (edn/read-string "#:a {1 1, :b 2, :b/c 3, :_/d 4}")))) \ No newline at end of file From d274b2b96588b100c70be065f949e1fdc9e7e14d Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 14 Jun 2016 09:33:50 -0500 Subject: [PATCH 070/246] CLJ-1919 Destructuring namespaced keys and symbols Signed-off-by: Rich Hickey --- src/clj/clojure/core.clj | 40 +++++++++++++++-------- test/clojure/test_clojure/special.clj | 46 ++++++++++++++++++--------- 2 files changed, 57 insertions(+), 29 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index fa91ba15..cd070d91 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -4381,24 +4381,36 @@ (if (:as b) (conj ret (:as b) gmap) ret)))) - bes (reduce1 - (fn [bes entry] - (reduce1 #(assoc %1 %2 ((val entry) %2)) - (dissoc bes (key entry)) - ((key entry) bes))) - (dissoc b :as :or) - {:keys #(if (keyword? %) % (keyword (str %))), - :strs str, :syms #(list `quote %)})] + bes (let [transforms + (reduce1 + (fn [transforms mk] + (if (keyword? mk) + (let [mkns (namespace mk) + mkn (name mk)] + (cond (= mkn "keys") (assoc transforms mk #(keyword (or mkns (namespace %)) (name %))) + (= mkn "syms") (assoc transforms mk #(list `quote (symbol (or mkns (namespace %)) (name %)))) + (= mkn "strs") (assoc transforms mk str) + :else transforms)) + transforms)) + {} + (keys b))] + (reduce1 + (fn [bes entry] + (reduce1 #(assoc %1 %2 ((val entry) %2)) + (dissoc bes (key entry)) + ((key entry) bes))) + (dissoc b :as :or) + transforms))] (if (seq bes) (let [bb (key (first bes)) bk (val (first bes)) - bv (if (contains? defaults bb) - (list `get gmap bk (defaults bb)) + local (if (instance? clojure.lang.Named bb) (symbol nil (name bb)) bb) + bv (if (contains? defaults local) + (list `get gmap bk (defaults local)) (list `get gmap bk))] - (recur (cond - (symbol? bb) (-> ret (conj (if (namespace bb) (symbol (name bb)) bb)) (conj bv)) - (keyword? bb) (-> ret (conj (symbol (name bb)) bv)) - :else (pb ret bb bv)) + (recur (if (ident? bb) + (-> ret (conj local bv)) + (pb ret bb bv)) (next bes))) ret))))] (cond diff --git a/test/clojure/test_clojure/special.clj b/test/clojure/test_clojure/special.clj index 9432c456..87f0e3ff 100644 --- a/test/clojure/test_clojure/special.clj +++ b/test/clojure/test_clojure/special.clj @@ -33,24 +33,37 @@ (is (= {} x)))) (deftest keywords-in-destructuring - (let [{:keys [:a :b]} {:a 1 :b 2}] - (is (= 1 a)) - (is (= 2 b)))) + (let [m {:a 1 :b 2}] + (let [{:keys [:a :b]} m] + (is (= [1 2] [a b]))) + (let [{:keys [:a :b :c] :or {c 3}} m] + (is (= [1 2 3] [a b c]))))) (deftest namespaced-keywords-in-destructuring - (let [{:keys [:a/b :c/d]} {:a/b 1 :c/d 2}] - (is (= 1 b)) - (is (= 2 d)))) + (let [m {:a/b 1 :c/d 2}] + (let [{:keys [:a/b :c/d]} m] + (is (= [1 2] [b d]))) + (let [{:keys [:a/b :c/d :e/f] :or {f 3}} m] + (is (= [1 2 3] [b d f]))))) (deftest namespaced-keys-in-destructuring - (let [{:keys [a/b c/d]} {:a/b 1 :c/d 2}] - (is (= 1 b)) - (is (= 2 d)))) + (let [m {:a/b 1 :c/d 2}] + (let [{:keys [a/b c/d]} m] + (is (= [1 2] [b d]))) + (let [{:keys [a/b c/d e/f] :or {f 3}} m] + (is (= [1 2 3] [b d f]))))) (deftest namespaced-syms-in-destructuring - (let [{:syms [a/b c/d]} {'a/b 1 'c/d 2}] - (is (= 1 b)) - (is (= 2 d)))) + (let [{:syms [a/b c/d e/f] :or {f 3}} {'a/b 1 'c/d 2}] + (is (= [1 2 3] [b d f])))) + +(deftest namespaced-keys-syntax + (let [{:a/keys [b c d] :or {d 3}} {:a/b 1 :a/c 2}] + (is (= [1 2 3] [b c d])))) + +(deftest namespaced-syms-syntax + (let [{:a/syms [b c d] :or {d 3}} {'a/b 1 'a/c 2}] + (is (= [1 2 3] [b c d])))) (deftest keywords-not-allowed-in-let-bindings (is (thrown-with-msg? Exception #"Unsupported binding form: :a" @@ -68,11 +81,14 @@ (is (thrown-with-msg? Exception #"Can't let qualified name: a/x" (eval '(let [[a/x] [1]] x))))) +(deftest or-doesnt-create-bindings + (is (thrown-with-msg? Exception #"Unable to resolve symbol: b" + (eval '(let [{:keys [a] :or {b 2}} {:a 1}] [a b]))))) + (require '[clojure.string :as s]) (deftest resolve-keyword-ns-alias-in-destructuring - (let [{:keys [::s/x ::s/y]} {:clojure.string/x 1 :clojure.string/y 2}] - (is (= x 1)) - (is (= y 2)))) + (let [{:keys [::s/x ::s/y ::s/z] :or {z 3}} {:clojure.string/x 1 :clojure.string/y 2}] + (is (= [1 2 3] [x y z])))) (deftest quote-with-multiple-args (let [ex (is (thrown? clojure.lang.Compiler$CompilerException From daf0811dcc304a73e3169f7034edc44a465352a1 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Thu, 23 Jun 2016 17:54:29 -0400 Subject: [PATCH 071/246] fix gen override by name, use in fspec ret gen --- src/clj/clojure/spec.clj | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index dcc7ed8a..ceea0f4d 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -221,9 +221,10 @@ (defn- gensub [spec overrides path rmap form] ;;(prn {:spec spec :over overrides :path path :form form}) - (let [spec (c/or (get overrides spec) spec) - spec (specize spec)] - (if-let [g (c/or (get overrides path) (gen* spec overrides path rmap))] + (let [spec (specize spec)] + (if-let [g (c/or (get overrides (c/or (spec-name spec) spec)) + (get overrides path) + (gen* spec overrides path rmap))] (gen/such-that #(valid? spec %) g 100) (let [abbr (abbrev form)] (throw (ex-info (str "Unable to construct gen at: " path " for: " abbr) @@ -1634,12 +1635,12 @@ in ns-or-nses, a symbol or a collection of symbols." (let [cargs (conform argspec args)] (explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret}))))))))) {path {:pred 'ifn? :val f :via via :in in}})) - (gen* [_ _ _ _] (if gfn + (gen* [_ overrides _ _] (if gfn (gfn) (gen/return (fn [& args] (assert (valid? argspec args) (with-out-str (explain argspec args))) - (gen/generate (gen retspec)))))) + (gen/generate (gen retspec overrides)))))) (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn)) (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform))))) From dc8903d294337638f63af8c86fe335f9c29ab526 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 24 Jun 2016 10:31:35 -0400 Subject: [PATCH 072/246] added exercise-fn per dchelimsky --- src/clj/clojure/spec.clj | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index ceea0f4d..5f18fe51 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1679,6 +1679,18 @@ in ns-or-nses, a symbol or a collection of symbols." ([spec n overrides] (map #(vector % (conform spec %)) (gen/sample (gen spec overrides) n)))) +(defn exercise-fn + "exercises the fn named by sym (a symbol) by applying it to + n (default 10) generated samples of its args spec. When fspec is + supplied its arg spec is used, and sym-or-f can be a fn. Returns a + sequence of tuples of [args ret]. " + ([sym] (exercise-fn sym 10)) + ([sym n] (exercise-fn sym n (get-spec sym))) + ([sym-or-f n fspec] + (let [f (if (symbol? sym-or-f) (resolve sym-or-f) sym-or-f)] + (for [args (gen/sample (gen (:args fspec)) n)] + [args (apply f args)])))) + (defn coll-checker "returns a predicate function that checks *coll-check-limit* items in a collection with pred" [pred] From e8c72929f9648f99e7914e939602c7bdd7928022 Mon Sep 17 00:00:00 2001 From: puredanger Date: Thu, 23 Jun 2016 16:00:45 -0500 Subject: [PATCH 073/246] preparation for using clojure.core specs Signed-off-by: Rich Hickey --- build.xml | 7 ++++++- src/clj/clojure/core/specs.clj | 4 ++++ src/jvm/clojure/lang/Compiler.java | 30 +++++++++++++++++------------- src/jvm/clojure/lang/RT.java | 1 + 4 files changed, 28 insertions(+), 14 deletions(-) create mode 100644 src/clj/clojure/core/specs.clj diff --git a/build.xml b/build.xml index a2e867c1..535ac017 100644 --- a/build.xml +++ b/build.xml @@ -59,6 +59,7 @@ + @@ -81,9 +82,13 @@ - + + + diff --git a/src/clj/clojure/core/specs.clj b/src/clj/clojure/core/specs.clj new file mode 100644 index 00000000..08503861 --- /dev/null +++ b/src/clj/clojure/core/specs.clj @@ -0,0 +1,4 @@ +(ns ^{:skip-wiki true} clojure.core.specs + (:require [clojure.spec :as s])) + +(alias 'cc 'clojure.core) \ No newline at end of file diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index 8d5ce3ab..c455d32c 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -6771,20 +6771,24 @@ public static Object macroexpand1(Object x) { Var v = isMacro(op); if(v != null) { - try - { - final Namespace checkns = Namespace.find(Symbol.intern("clojure.spec")); - if (checkns != null) - { - final Var check = Var.find(Symbol.intern("clojure.spec/macroexpand-check")); - if ((check != null) && (check.isBound())) - check.applyTo(RT.cons(v, RT.list(form.next()))); - } - Symbol.intern("clojure.spec"); - } - catch(IllegalArgumentException e) + // Do not check specs while inside clojure.spec + if(! "clojure/spec.clj".equals(SOURCE_PATH.deref())) { - throw new CompilerException((String) SOURCE_PATH.deref(), lineDeref(), columnDeref(), e); + try + { + final Namespace checkns = Namespace.find(Symbol.intern("clojure.spec")); + if (checkns != null) + { + final Var check = Var.find(Symbol.intern("clojure.spec/macroexpand-check")); + if ((check != null) && (check.isBound())) + check.applyTo(RT.cons(v, RT.list(form.next()))); + } + Symbol.intern("clojure.spec"); + } + catch(IllegalArgumentException e) + { + throw new CompilerException((String) SOURCE_PATH.deref(), lineDeref(), columnDeref(), e); + } } try { diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index 95e9a944..0682c805 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -460,6 +460,7 @@ else if(!loaded && failIfNotFound) static void doInit() throws ClassNotFoundException, IOException{ load("clojure/core"); load("clojure/spec"); + load("clojure/core/specs"); Var.pushThreadBindings( RT.mapUniqueKeys(CURRENT_NS, CURRENT_NS.deref(), From 758d009c37f75e85e94a65d227d77ced56f16118 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Fri, 24 Jun 2016 04:08:01 -0400 Subject: [PATCH 074/246] test results as seqs, flow gen Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 22 ++-- src/clj/clojure/spec/test.clj | 186 ++++++++++++++++++---------------- 2 files changed, 115 insertions(+), 93 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 5f18fe51..5624a669 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -675,9 +675,9 @@ (defn- instrument-choose-fn "Helper for instrument." - [f spec sym {:keys [stub replace]}] + [f spec sym {over :gen :keys [stub replace]}] (if (some #{sym} stub) - (-> spec gen gen/generate) + (-> spec (gen over) gen/generate) (get replace sym f))) (defn- instrument-choose-spec @@ -685,9 +685,11 @@ [spec sym {overrides :spec}] (get overrides sym spec)) -(defn- as-seqable +(defn- collectionize [x] - (if (seqable? x) x (list x))) + (if (symbol? x) + (list x) + x)) (defn- instrument-1 [s opts] @@ -721,6 +723,7 @@ The opts map may have the following keys: :spec a map from var-name symbols to override specs :stub a collection of var-name symbols to be replaced by stubs + :gen a map from spec names to generator overrides :replace a map from var-name symbols to replacement fns :spec overrides registered fn-specs with specs your provide. Use @@ -731,6 +734,8 @@ spec'ed contract. :stub replaces a fn with a stub that checks :args, then uses the :ret spec to generate a return value. +:gen overrides are used only for :stub generation. + :replace replaces a fn with a fn that checks args conformance, then invokes the fn you provide, enabling arbitrary stubbing and mocking. @@ -739,12 +744,13 @@ invokes the fn you provide, enabling arbitrary stubbing and mocking. Returns a collection of syms naming the vars instrumented." ([sym-or-syms] (instrument sym-or-syms nil)) ([sym-or-syms opts] + (assert (every? ident? (c/keys (:gen opts))) "instrument :gen expects ident keys") (locking instrumented-vars (into [] (comp (map #(instrument-1 % opts)) (remove nil?)) - (as-seqable sym-or-syms))))) + (collectionize sym-or-syms))))) (defn- unstrument-1 [s] @@ -765,7 +771,7 @@ Returns a collection of syms naming the vars unstrumented." [] (comp (map #(unstrument-1 %)) (remove nil?)) - (as-seqable sym-or-syms)))) + (collectionize sym-or-syms)))) (defn- opt-syms "Returns set of symbols referenced by 'instrument' opts map" @@ -784,7 +790,7 @@ in ns-or-nses, a symbol or a collection of symbols." ([] (instrument-ns (.name ^clojure.lang.Namespace *ns*))) ([ns-or-nses] (instrument-ns ns-or-nses nil)) ([ns-or-nses opts] - (let [ns-match? (ns-matcher (as-seqable ns-or-nses))] + (let [ns-match? (ns-matcher (collectionize ns-or-nses))] (locking instrumented-vars (into [] @@ -800,7 +806,7 @@ in ns-or-nses, a symbol or a collection of symbols." "Like unstrument, but works on all symbols whose namespace name is in ns-or-nses, a symbol or a collection of symbols." [ns-or-nses] - (let [ns-match? (ns-matcher (as-seqable ns-or-nses))] + (let [ns-match? (ns-matcher (collectionize ns-or-nses))] (locking instrumented-vars (into [] diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index c0385570..d2f7a00a 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -66,10 +66,10 @@ with explain-data under ::check-call." (defn- result-type [result] - (let [ret (::return result)] + (let [ret (:result result)] (cond (true? ret) :pass - (::s/args ret) :instrument-fail + (::s/args ret) :no-argspec (::s/no-gen-for ret) :no-gen (::args ret) :fail :default :error))) @@ -77,47 +77,35 @@ with explain-data under ::check-call." (defn- make-test-result "Builds spec result map." [test-sym spec test-check-ret] - (let [result (merge {::sym test-sym - ::spec spec + (let [result (merge {:spec spec ::stc/ret test-check-ret} + (when test-sym + {:sym test-sym}) (when-let [result (-> test-check-ret :result)] - {::return (unwrap-return result)}) + {:result (unwrap-return result)}) (when-let [shrunk (-> test-check-ret :shrunk)] - {::return (unwrap-return (:result shrunk))}))] - (assoc result ::result-type (result-type result)))) - -(defn- abbrev-result - [x] - (if (true? (::return x)) - (dissoc x ::spec ::stc/ret ::return) - (update (dissoc x ::stc/ret) ::spec s/describe))) - -(defn- default-result-callback - [x] - (pp/pprint (abbrev-result x)) - (flush)) + {:result (unwrap-return (:result shrunk))}))] + (assoc result :type (result-type result)))) (defn- test-1 - [{:keys [s f spec]} - {:keys [result-callback] :as opts - :or {result-callback default-result-callback}}] - (let [result (cond - (nil? f) - {::result-type :no-fn ::sym s ::spec spec} + [{:keys [s f spec]} {:keys [result-callback] :as opts}] + (cond + (nil? f) + {:type :no-fn :sym s :spec spec} - (:args spec) - (let [tcret (check-fn f spec opts)] - (make-test-result s spec tcret)) + (:args spec) + (let [tcret (check-fn f spec opts)] + (make-test-result s spec tcret)) - :default - {::result-type :no-args ::sym s ::spec spec})] - (result-callback result) - result)) + :default + {:type :no-argspec :sym s :spec spec})) ;; duped from spec to avoid introducing public API -(defn- as-seqable +(defn- collectionize [x] - (if (seqable? x) x (list x))) + (if (symbol? x) + (list x) + x)) ;; duped from spec to avoid introducing public API (defn- ns-matcher @@ -126,16 +114,6 @@ with explain-data under ::check-call." (fn [s] (contains? ns-names (namespace s))))) -(defn- update-result-map - ([] - {:test 0 :pass 0 :fail 0 :error 0 - :no-fn 0 :no-args 0 :no-gen 0}) - ([m] m) - ([results result] - (-> results - (update :test inc) - (update (::result-type result) inc)))) - (defn- sym->test-map [s] (let [v (resolve s)] @@ -143,46 +121,63 @@ with explain-data under ::check-call." :f (when v @v) :spec (when v (s/get-spec v))})) +(defn- validate-opts + [opts] + (assert (every? ident? (keys (:gen opts))) "test :gen expects ident keys")) + (defn test-fn "Runs generative tests for fn f using spec and opts. See 'test' for options and return." ([f spec] (test-fn f spec nil)) ([f spec opts] - (update-result-map - (update-result-map) - (test-1 {:f f :spec spec} opts)))) + (validate-opts opts) + (test-1 {:f f :spec spec} opts))) (defn test - "Checks specs for fns named by sym-or-syms (a symbol or collection of symbols) using test.check. + "Checks specs for fns named by sym-or-syms (a symbol or +collection of symbols) using test.check. -The opts map includes the following optional keys: +The opts map includes the following optional keys, where stc +aliases clojure.spec.test.check: -:clojure.spec.test.check/opts opts to flow through test.check -:result-callback callback fn to handle test results -:gen overrides map for spec/gen +::stc/opts opts to flow through test.check/quick-check +:gen map from spec names to generator overrides -The c.s.t.c/opts include :num-tests in addition to the keys -documented by test.check. +The ::stc/opts include :num-tests in addition to the keys +documented by test.check. Generator overrides are passed to +spec/gen when generating function args. -The result-callback defaults to default-result-callback. +Returns a lazy sequence of test result maps with the following +keys -Returns a map with the following keys: +:spec the spec tested +:type the type of the test result +:sym optional symbol naming the var tested +:result optional test result +::stc/ret optional value returned by test.check/quick-check -:test # of syms tested -:pass # of passing tests -:fail # of failing tests -:error # of throwing tests -:no-fn # of syms with no fn -:no-args # of syms with no argspec -:no-gen # of syms for which arg data gen failed" +Values for the :result key can be one of + +true passing test +exception code under test threw +map with explain-data under :clojure.spec/problems + +Values for the :type key can be one of + +:pass test passed +:fail test failed +:error test threw +:no-argspec no :args in fn-spec +:no-gen unable to generate :args +:no-fn unable to resolve fn to test +" ([sym-or-syms] (test sym-or-syms nil)) ([sym-or-syms opts] - (transduce - (comp - (map sym->test-map) - (map #(test-1 % opts))) - update-result-map - (as-seqable sym-or-syms)))) + (validate-opts opts) + (->> (eduction + (map sym->test-map) + (collectionize sym-or-syms)) + (pmap #(test-1 % opts))))) (defn test-ns "Like test, but scoped to specific namespaces, or to @@ -190,29 +185,50 @@ Returns a map with the following keys: ([] (test-ns (.name ^clojure.lang.Namespace *ns*))) ([ns-or-nses] (test-ns ns-or-nses nil)) ([ns-or-nses opts] - (let [ns-match? (ns-matcher (as-seqable ns-or-nses))] - (transduce - (comp (filter symbol?) - (filter ns-match?) - (map sym->test-map) - (map #(test-1 % opts))) - update-result-map - (keys (s/registry)))))) + (validate-opts opts) + (let [ns-match? (ns-matcher (collectionize ns-or-nses))] + (->> (eduction + (filter symbol?) + (filter ns-match?) + (map sym->test-map) + (keys (s/registry))) + (pmap #(test-1 % opts)))))) (defn test-all "Like test, but tests all vars named by fn-specs in the spec registry." ([] (test-all nil)) ([opts] - (transduce - (comp (filter symbol?) - (map sym->test-map) - (map #(test-1 % opts))) - update-result-map - (keys (s/registry))))) - - + (validate-opts opts) + (->> (eduction + (filter symbol?) + (map sym->test-map) + (keys (s/registry))) + (pmap #(test-1 % opts))))) + +(defn abbrev-result + "Given a test result, returns an abbreviated version +suitable for summary use." + [x] + (if (true? (:result x)) + (dissoc x :spec ::stc/ret :result) + (update (dissoc x ::stc/ret) :spec s/describe))) + +(defn summarize-results + "Given a collection of test-results, e.g. from 'test', +pretty prints the abbrev-result of each. + +Returns a map with :total, the total number of results, plus a +key with a count for each different :type of result." + [test-results] + (reduce + (fn [summary result] + (pp/pprint (abbrev-result result)) + (-> summary + (update :total inc) + (update (:type result) (fnil inc 0)))) + {:total 0} + test-results)) - From 7ff29181ee3fdbebba1e5a888960871807573995 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Fri, 24 Jun 2016 11:01:17 -0400 Subject: [PATCH 075/246] fold *strument and *strument-ns down into single fns Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 127 ++++++++++++++++++--------------------- 1 file changed, 59 insertions(+), 68 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 5624a669..301d9869 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -706,18 +706,50 @@ (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked})) (->sym v))) +(defn- unstrument-1 + [s] + (when-let [v (resolve s)] + (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] + (let [current @v] + (when (= wrapped current) + (alter-var-root v (constantly raw)))) + (swap! instrumented-vars dissoc v)) + (->sym v))) + +(defn- opt-syms + "Returns set of symbols referenced by 'instrument' opts map" + [opts] + (reduce into #{} [(:stub opts) (c/keys (:replace opts)) (c/keys (:spec opts))])) + +(defn- sym-matcher + "Returns a fn that matches symbols that are either in syms, +or whose namespace is in syms." + [syms] + (let [names (into #{} (map str) syms)] + (fn [s] + (c/or (contains? names (namespace s)) + (contains? names (str s)))))) + +(defn- validate-opts + [opts] + (assert (every? ident? (c/keys (:gen opts))) "instrument :gen expects ident keys")) + (defn instrument - "Instruments the vars named by sym-or-syms, a symbol or a -collection of symbols. Idempotent. + "Instruments the vars matched by ns-or-names, a symbol or a +collection of symbols. Instruments the current namespace if +ns-or-names not specified. Idempotent. + +A var matches ns-or-names if ns-or-names includes either the var's +fully qualified name or the var's namespace. If a var has an :args fn-spec, sets the var's root binding to a fn that checks arg conformance (throwing an exception on failure) before delegating to the original fn. The opts map can be used to override registered specs, and/or to -replace fn implementations entirely. Opts for symbols not named by -sym-or-syms are ignored. This facilitates sharing a common options map -across many different calls to instrument. +replace fn implementations entirely. Opts for symbols not matched +by ns-or-names are ignored. This facilitates sharing a common +options map across many different calls to instrument. The opts map may have the following keys: @@ -742,84 +774,43 @@ invokes the fn you provide, enabling arbitrary stubbing and mocking. :spec can be used in combination with :stub or :replace. Returns a collection of syms naming the vars instrumented." - ([sym-or-syms] (instrument sym-or-syms nil)) - ([sym-or-syms opts] - (assert (every? ident? (c/keys (:gen opts))) "instrument :gen expects ident keys") - (locking instrumented-vars - (into - [] - (comp (map #(instrument-1 % opts)) - (remove nil?)) - (collectionize sym-or-syms))))) - -(defn- unstrument-1 - [s] - (when-let [v (resolve s)] - (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] - (let [current @v] - (when (= wrapped current) - (alter-var-root v (constantly raw)))) - (swap! instrumented-vars dissoc v)) - (->sym v))) - -(defn unstrument - "Undoes instrument on the vars named by sym-or-syms. Idempotent. -Returns a collection of syms naming the vars unstrumented." - [sym-or-syms] - (locking instrumented-vars - (into - [] - (comp (map #(unstrument-1 %)) - (remove nil?)) - (collectionize sym-or-syms)))) - -(defn- opt-syms - "Returns set of symbols referenced by 'instrument' opts map" - [opts] - (reduce into #{} [(:stub opts) (c/keys (:replace opts)) (c/keys (:spec opts))])) - -(defn- ns-matcher - [ns-syms] - (let [ns-names (into #{} (map str) ns-syms)] - (fn [s] - (contains? ns-names (namespace s))))) - -(defn instrument-ns - "Like instrument, but works on all symbols whose namespace name is -in ns-or-nses, a symbol or a collection of symbols." - ([] (instrument-ns (.name ^clojure.lang.Namespace *ns*))) - ([ns-or-nses] (instrument-ns ns-or-nses nil)) - ([ns-or-nses opts] - (let [ns-match? (ns-matcher (collectionize ns-or-nses))] + ([] (instrument (.name ^clojure.lang.Namespace *ns*))) + ([ns-or-names] (instrument ns-or-names nil)) + ([ns-or-names opts] + (validate-opts opts) + (let [match? (sym-matcher (collectionize ns-or-names))] (locking instrumented-vars (into [] (comp c/cat (filter symbol?) - (filter ns-match?) + (filter match?) (distinct) (map #(instrument-1 % opts)) (remove nil?)) [(c/keys (registry)) (opt-syms opts)]))))) -(defn unstrument-ns - "Like unstrument, but works on all symbols whose namespace name is -in ns-or-nses, a symbol or a collection of symbols." - [ns-or-nses] - (let [ns-match? (ns-matcher (collectionize ns-or-nses))] - (locking instrumented-vars - (into - [] - (comp (map ->sym) - (filter ns-match?) - (map unstrument-1) - (remove nil?)) - (c/keys @instrumented-vars))))) +(defn unstrument + "Undoes instrument on the vars matched by ns-or-names, specified +as in instrument. Returns a collection of syms naming the vars +unstrumented." + ([] (unstrument (.name ^clojure.lang.Namespace *ns*))) + ([ns-or-names] + (let [match? (sym-matcher (collectionize ns-or-names))] + (locking instrumented-vars + (into + [] + (comp (map ->sym) + (filter match?) + (map unstrument-1) + (remove nil?)) + (c/keys @instrumented-vars)))))) (defn instrument-all "Like instrument, but works on all vars." ([] (instrument-all nil)) ([opts] + (validate-opts opts) (locking instrumented-vars (into [] From e8557891642a313bbdb97e2d3a61022ec816d132 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 24 Jun 2016 19:10:23 -0400 Subject: [PATCH 076/246] first cut of conforming coll-of and map-of with count constraints --- src/clj/clojure/spec.clj | 155 +++++++++++++++++------------ test/clojure/test_clojure/spec.clj | 1 - 2 files changed, 93 insertions(+), 63 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 301d9869..c6fd93ef 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -462,6 +462,8 @@ Optionally takes :gen generator-fn, which must be a fn of no args that returns a test.check generator + + See also - coll-of, every-kv " [pred & {:keys [count max-count min-count distinct gen-max gen-into gen] :as opts}] `(every-impl '~pred ~pred ~(dissoc opts :gen) ~gen)) @@ -469,10 +471,37 @@ (defmacro every-kv "like 'every' but takes separate key and val preds and works on associative collections. - Same options as 'every'" + Same options as 'every' + + See also - map-of" + + [kpred vpred & opts] + `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :gen-into {} ~@opts)) + +(defmacro coll-of + "Returns a spec for a collection of items satisfying pred. The + generator will fill an empty init-coll. Unlike 'every', coll-of + will exhaustively conform every value. + + Same options as 'every'. + + See also - every, map-of" + [pred init-coll & opts] + `(every ~pred ::conform-all true :gen-into ~init-coll ~@opts)) + +(defmacro map-of + "Returns a spec for a map whose keys satisfy kpred and vals satisfy + vpred. Unlike 'every-kv', map-of will exhaustively conform every + value. + + Same options as 'every', with the addition of: + + :conform-keys - conform keys as well as values (default false) + See also - every-kv" [kpred vpred & opts] - `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (key v#)) :gen-into {} ~@opts)) + `(and (every-kv ~kpred ~vpred ::conform-all true ~@opts) map?)) + (defmacro * "Returns a regex op that matches zero or more values matching @@ -1153,28 +1182,76 @@ unstrumented." (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) (describe* [_] `(and ~@forms)))) +(defn- coll-prob [x distinct count min-count max-count + path via in] + (cond + (not (seqable? x)) + {path {:pred 'seqable? :val x :via via :in in}} + + (c/and distinct (not (empty? x)) (not (apply distinct? x))) + {path {:pred 'distinct? :val x :via via :in in}} + + (c/and count (not= count (bounded-count count x))) + {path {:pred `(= ~count (c/count %)) :val x :via via :in in}} + + (c/and (c/or min-count max-count) + (not (<= (c/or min-count 0) + (bounded-count (if max-count (inc max-count) min-count) x) + (c/or max-count Integer/MAX_VALUE)))) + {path {:pred `(<= ~(c/or min-count 0) (c/count %) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}})) + (defn ^:skip-wiki every-impl - "Do not call this directly, use 'every'" + "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'" ([form pred opts] (every-impl form pred opts nil)) - ([form pred {:keys [count max-count min-count distinct gen-max gen-into ::kfn] + ([form pred {:keys [count max-count min-count distinct gen-max gen-into ::kfn + conform-keys ::conform-all] :or {gen-max 20, gen-into []} :as opts} gfn] (let [check? #(valid? pred %) - kfn (c/or kfn (fn [i v] i))] + kfn (c/or kfn (fn [i v] i)) + addcv (fn [ret i v cv] (conj ret cv)) + cfns (fn [x] + ;;returns a tuple of [init add complete] fns + (cond + (vector? x) + [identity + (fn [ret i v cv] + (if (identical? v cv) + ret + (assoc ret i cv))) + identity] + + (map? x) + [(if conform-keys empty identity) + (fn [ret i v cv] + (if (c/and (identical? v cv) (not conform-keys)) + ret + (assoc ret (nth (if conform-keys cv v) 0) (nth cv 1)))) + identity] + + (list? x) [empty addcv reverse] + + :else [empty addcv identity]))] (reify Spec (conform* [_ x] (cond - (c/or (not (seqable? x)) - (c/and distinct (not (empty? x)) (not (apply distinct? x))) - (c/and count (not= count (bounded-count (inc count) x))) - (c/and (c/or min-count max-count) - (not (<= (c/or min-count 0) - (bounded-count (if max-count (inc max-count) min-count) x) - (c/or max-count Integer/MAX_VALUE))))) + (coll-prob x distinct count min-count max-count + nil nil nil) ::invalid + conform-all + (let [[init add complete] (cfns x)] + (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)] + (if vseq + (let [cv (dt pred v nil)] + (if (= ::invalid cv) + ::invalid + (recur (add ret i v cv) (inc i) vs))) + (complete ret)))) + + :else (if (indexed? x) (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))] @@ -1188,25 +1265,10 @@ unstrumented." ::invalid)))) (unform* [_ x] x) (explain* [_ path via in x] - (cond - (not (seqable? x)) - {path {:pred 'seqable? :val x :via via :in in}} - - (c/and distinct (not (empty? x)) (not (apply distinct? x))) - {path {:pred 'distinct? :val x :via via :in in}} - - (c/and count (not= count (bounded-count count x))) - {path {:pred `(= ~count (c/count %)) :val x :via via :in in}} - - (c/and (c/or min-count max-count) - (not (<= (c/or min-count 0) - (bounded-count (if max-count (inc max-count) min-count) x) - (c/or max-count Integer/MAX_VALUE)))) - {path {:pred `(<= ~(c/or min-count 0) (c/count %) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}} - - :else - (apply merge - (take *coll-error-limit* + (c/or (coll-prob x distinct count min-count max-count + path via in) + (apply merge + ((if conform-all identity (partial take *coll-error-limit*)) (keep identity (map (fn [i v] (let [k (kfn i v)] @@ -1688,37 +1750,6 @@ unstrumented." (for [args (gen/sample (gen (:args fspec)) n)] [args (apply f args)])))) -(defn coll-checker - "returns a predicate function that checks *coll-check-limit* items in a collection with pred" - [pred] - (let [check? #(valid? pred %)] - (fn [coll] - (c/or (nil? coll) - (c/and - (coll? coll) - (every? check? (take *coll-check-limit* coll))))))) - -(defn coll-gen - "returns a function of no args that returns a generator of - collections of items conforming to pred, with the same shape as - init-coll" - [pred init-coll] - (let [init (empty init-coll)] - (fn [] - (gen/fmap - #(if (vector? init) % (into init %)) - (gen/vector (gen pred)))))) - -(defmacro coll-of - "Returns a spec for a collection of items satisfying pred. The generator will fill an empty init-coll." - [pred init-coll] - `(spec (coll-checker ~pred) :gen (coll-gen ~pred ~init-coll))) - -(defmacro map-of - "Returns a spec for a map whose keys satisfy kpred and vals satisfy vpred." - [kpred vpred] - `(and (coll-of (tuple ~kpred ~vpred) {}) map?)) - (defn inst-in-range? "Return true if inst at or after start and before end" [start end inst] diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 76a15150..82e5aacd 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -120,7 +120,6 @@ m nil ::s/invalid '{[] {:pred map?, :val nil, :via []}} m {} {} nil m {:a "b"} {:a "b"} nil - m {:a :b} ::s/invalid '{[] {:pred (coll-checker (tuple keyword? string?)), :val {:a :b}, :via []}} coll nil nil nil coll [] [] nil From c86375c585c1ad3f7635075f57793dfc2e31593e Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 27 Jun 2016 12:00:09 -0400 Subject: [PATCH 077/246] use gen-into targets for vec/map opts --- src/clj/clojure/spec.clj | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index c6fd93ef..c74fbf41 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -277,7 +277,7 @@ (swap! registry-ref assoc k spec) k)) -(defn ns-qualify +(defn- ns-qualify "Qualify symbol s by resolving it or using the current *ns*." [s] (if-let [ns-sym (some-> s namespace symbol)] @@ -1214,7 +1214,7 @@ unstrumented." cfns (fn [x] ;;returns a tuple of [init add complete] fns (cond - (vector? x) + (c/and (vector? x) (vector? gen-into)) [identity (fn [ret i v cv] (if (identical? v cv) @@ -1222,7 +1222,7 @@ unstrumented." (assoc ret i cv))) identity] - (map? x) + (c/and (map? x) (map? gen-into)) [(if conform-keys empty identity) (fn [ret i v cv] (if (c/and (identical? v cv) (not conform-keys)) From 3528b32ed43d98d3d1231ca8bcb59a7f4ebef953 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 27 Jun 2016 12:05:34 -0400 Subject: [PATCH 078/246] use gen-into targets only for map opts --- src/clj/clojure/spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index c74fbf41..43b440cc 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1214,7 +1214,7 @@ unstrumented." cfns (fn [x] ;;returns a tuple of [init add complete] fns (cond - (c/and (vector? x) (vector? gen-into)) + (vector? x) [identity (fn [ret i v cv] (if (identical? v cv) From 40d875a6af1bf1c7415265a347a0a77de9c3cd94 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 27 Jun 2016 12:44:33 -0400 Subject: [PATCH 079/246] typos --- src/clj/clojure/spec.clj | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 43b440cc..6ccd5bb4 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -452,7 +452,7 @@ Takes several kwargs options that further constrain the collection: :count - specifies coll has exactly this count (default nil) - :min-count, :max-count - coll has count (<= min count max) (default nil) + :min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil) :distinct - all the elements are distinct (default nil) And additional args that control gen @@ -1173,11 +1173,11 @@ unstrumented." (defn ^:skip-wiki and-spec-impl "Do not call this directly, use 'and'" [forms preds gfn] - (reify - Spec - (conform* [_ x] (and-preds x preds forms)) - (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) - (explain* [_ path via in x] (explain-pred-list forms preds path via in x)) + (reify + Spec + (conform* [_ x] (and-preds x preds forms)) + (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) + (explain* [_ path via in x] (explain-pred-list forms preds path via in x)) (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms)))) (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) (describe* [_] `(and ~@forms)))) @@ -1192,13 +1192,13 @@ unstrumented." {path {:pred 'distinct? :val x :via via :in in}} (c/and count (not= count (bounded-count count x))) - {path {:pred `(= ~count (c/count %)) :val x :via via :in in}} + {path {:pred `(= ~count ~(c/count x)) :val x :via via :in in}} (c/and (c/or min-count max-count) (not (<= (c/or min-count 0) (bounded-count (if max-count (inc max-count) min-count) x) (c/or max-count Integer/MAX_VALUE)))) - {path {:pred `(<= ~(c/or min-count 0) (c/count %) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}})) + {path {:pred `(<= ~(c/or min-count 0) ~(c/count x) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}})) (defn ^:skip-wiki every-impl "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'" From 23e3ec3f8bceeedee70beed7a17846c25eba05a6 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 27 Jun 2016 18:39:49 -0400 Subject: [PATCH 080/246] added merge, merges keys specs new explain-data format - probs collection of prob-maps, :path in maps :into and :kind for every and coll-of no more init-coll for coll-of, use :into or :kind (or not) --- src/clj/clojure/spec.clj | 184 ++++++++++++++++++----------- test/clojure/test_clojure/spec.clj | 70 +++++------ 2 files changed, 152 insertions(+), 102 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 6ccd5bb4..9f7d7839 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -7,7 +7,7 @@ ; You must not remove this notice, or any other, from this software. (ns clojure.spec - (:refer-clojure :exclude [+ * and or cat def keys]) + (:refer-clojure :exclude [+ * and or cat def keys merge]) (:require [clojure.walk :as walk] [clojure.spec.gen :as gen] [clojure.string :as str])) @@ -169,7 +169,7 @@ (defn explain-data "Given a spec and a value x which ought to conform, returns nil if x conforms, else a map with at least the key ::problems whose value is - a path->problem-map, where problem-map has at least :pred and :val + a collection of problem-maps, where problem-map has at least :path :pred and :val keys describing the predicate and the value that failed at that path." [spec x] @@ -181,7 +181,7 @@ (if ed (do ;;(prn {:ed ed}) - (doseq [[path {:keys [pred val reason via in] :as prob}] (::problems ed)] + (doseq [{:keys [path pred val reason via in] :as prob} (::problems ed)] (when-not (empty? in) (print "In:" (pr-str in) "")) (print "val: ") @@ -195,7 +195,7 @@ (pr pred) (when reason (print ", " reason)) (doseq [[k v] prob] - (when-not (#{:pred :val :reason :via :in} k) + (when-not (#{:path :pred :val :reason :via :in} k) (print "\n\t" (pr-str k) " ") (pr v))) (newline)) @@ -440,6 +440,15 @@ [& pred-forms] `(and-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) +(defmacro merge + "Takes map-validating specs (e.g. 'keys' specs) and + returns a spec that returns a conformed map satisfying all of the + specs. Successive conformed values propagate through rest of + predicates. Unlike 'and', merge can generate maps satisfying the + union of the predicates." + [& pred-forms] + `(merge-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) + (defmacro every "takes a pred and validates collection elements against that pred. @@ -451,6 +460,7 @@ Takes several kwargs options that further constrain the collection: + :kind - one of [], (), {}, #{} - must be this kind of collection - (default nil) :count - specifies coll has exactly this count (default nil) :min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil) :distinct - all the elements are distinct (default nil) @@ -458,49 +468,50 @@ And additional args that control gen :gen-max - the maximum coll size to generate (default 20) - :gen-into - the default colection to generate into (will be emptied) (default []) + :into - one of [], (), {}, #{} - the default collection to generate into (default same as :kind if supplied, else []) Optionally takes :gen generator-fn, which must be a fn of no args that returns a test.check generator See also - coll-of, every-kv " - [pred & {:keys [count max-count min-count distinct gen-max gen-into gen] :as opts}] + [pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}] `(every-impl '~pred ~pred ~(dissoc opts :gen) ~gen)) (defmacro every-kv "like 'every' but takes separate key and val preds and works on associative collections. - Same options as 'every' + Same options as 'every', :into defaults to {} See also - map-of" [kpred vpred & opts] - `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :gen-into {} ~@opts)) + `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :into {} ~@opts)) (defmacro coll-of - "Returns a spec for a collection of items satisfying pred. The - generator will fill an empty init-coll. Unlike 'every', coll-of - will exhaustively conform every value. + "Returns a spec for a collection of items satisfying pred. Unlike + 'every', coll-of will exhaustively conform every value. - Same options as 'every'. + Same options as 'every'. conform will produce a collection + corresponding to :into if supplied, else will match the input collection, + avoiding rebuilding when possible. See also - every, map-of" - [pred init-coll & opts] - `(every ~pred ::conform-all true :gen-into ~init-coll ~@opts)) + [pred & opts] + `(every ~pred ::conform-all true ~@opts)) (defmacro map-of "Returns a spec for a map whose keys satisfy kpred and vals satisfy vpred. Unlike 'every-kv', map-of will exhaustively conform every value. - Same options as 'every', with the addition of: + Same options as 'every', :kind set to {}, with the addition of: :conform-keys - conform keys as well as values (default false) See also - every-kv" [kpred vpred & opts] - `(and (every-kv ~kpred ~vpred ::conform-all true ~@opts) map?)) + `(every-kv ~kpred ~vpred ::conform-all true ~@opts :kind {})) (defmacro * @@ -894,7 +905,7 @@ unstrumented." (let [pred (maybe-spec pred)] (if (spec? pred) (explain* pred path (if-let [name (spec-name pred)] (conj via name) via) in v) - {path {:pred (abbrev form) :val v :via via :in in}}))) + [{:path path :pred (abbrev form) :val v :via via :in in}]))) (defn ^:skip-wiki map-spec-impl "Do not call this directly, use 'spec' with a map argument" @@ -934,14 +945,14 @@ unstrumented." ret)))) (explain* [_ path via in x] (if-not (map? x) - {path {:pred 'map? :val x :via via :in in}} + [{:path path :pred 'map? :val x :via via :in in}] (let [reg (registry)] - (apply merge + (apply concat (when-let [probs (->> (map (fn [pred form] (when-not (pred x) (abbrev form))) pred-exprs pred-forms) (keep identity) seq)] - {path {:pred (vec probs) :val x :via via :in in}}) + [{:path path :pred (vec probs) :val x :via via :in in}]) (map (fn [[k v]] (when-not (c/or (not (contains? reg (keys->specs k))) (valid? (keys->specs k) v k)) @@ -996,7 +1007,7 @@ unstrumented." x)) (explain* [_ path via in x] (when (= ::invalid (dt pred x form cpred?)) - {path {:pred (abbrev form) :val x :via via :in in}})) + [{:path path :pred (abbrev form) :val x :via via :in in}])) (gen* [_ _ _ _] (if gfn (gfn) (gen/gen-for-pred pred))) @@ -1029,7 +1040,7 @@ unstrumented." path (conj path dv)] (if-let [pred (predx x)] (explain-1 form pred path via in x) - {path {:pred form :val x :reason "no method" :via via :in in}}))) + [{:path path :pred form :val x :reason "no method" :via via :in in}]))) (gen* [_ overrides path rmap] (if gfn (gfn) @@ -1082,13 +1093,13 @@ unstrumented." (explain* [_ path via in x] (cond (not (vector? x)) - {path {:pred 'vector? :val x :via via :in in}} + [{:path path :pred 'vector? :val x :via via :in in}] (not= (count x) (count preds)) - {path {:pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}} + [{:path path :pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}] :else - (apply merge + (apply concat (map (fn [i form pred] (let [v (x i)] (when-not (valid? pred v) @@ -1128,7 +1139,7 @@ unstrumented." (unform* [_ [k x]] (unform (kps k) x)) (explain* [this path via in x] (when-not (valid? this x) - (apply merge + (apply concat (map (fn [k form pred] (when-not (valid? pred x) (explain-1 form pred (conj path k) via in x))) @@ -1182,39 +1193,70 @@ unstrumented." (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) (describe* [_] `(and ~@forms)))) -(defn- coll-prob [x distinct count min-count max-count +(defn ^:skip-wiki merge-spec-impl + "Do not call this directly, use 'merge'" + [forms preds gfn] + (reify + Spec + (conform* [_ x] (and-preds x preds forms)) + (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) + (explain* [_ path via in x] + (apply concat + (map #(explain-1 %1 %2 path via in x) + forms preds))) + (gen* [_ overrides path rmap] + (if gfn + (gfn) + (gen/fmap + #(apply c/merge %) + (apply gen/tuple (map #(gensub %1 overrides path rmap %2) + preds forms))))) + (with-gen* [_ gfn] (merge-spec-impl forms preds gfn)) + (describe* [_] `(merge ~@forms)))) + +(defn- coll-prob [x kfn kform distinct count min-count max-count path via in] - (cond - (not (seqable? x)) - {path {:pred 'seqable? :val x :via via :in in}} + (let [] + (cond + (not (kfn x)) + [{:path path :pred kform :val x :via via :in in}] - (c/and distinct (not (empty? x)) (not (apply distinct? x))) - {path {:pred 'distinct? :val x :via via :in in}} + (c/and distinct (not (empty? x)) (not (apply distinct? x))) + [{:path path :pred 'distinct? :val x :via via :in in}] - (c/and count (not= count (bounded-count count x))) - {path {:pred `(= ~count ~(c/count x)) :val x :via via :in in}} + (c/and count (not= count (bounded-count count x))) + [{:path path :pred `(= ~count (c/count ~'%)) :val x :via via :in in}] - (c/and (c/or min-count max-count) - (not (<= (c/or min-count 0) - (bounded-count (if max-count (inc max-count) min-count) x) - (c/or max-count Integer/MAX_VALUE)))) - {path {:pred `(<= ~(c/or min-count 0) ~(c/count x) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}})) + (c/and (c/or min-count max-count) + (not (<= (c/or min-count 0) + (bounded-count (if max-count (inc max-count) min-count) x) + (c/or max-count Integer/MAX_VALUE)))) + [{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}]))) (defn ^:skip-wiki every-impl "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'" ([form pred opts] (every-impl form pred opts nil)) - ([form pred {:keys [count max-count min-count distinct gen-max gen-into ::kfn + ([form pred {gen-into :into + :keys [kind count max-count min-count distinct gen-max ::kfn conform-keys ::conform-all] - :or {gen-max 20, gen-into []} + :or {gen-max 20} :as opts} gfn] - (let [check? #(valid? pred %) + (let [conform-into (c/or gen-into kind) + gen-into (c/or gen-into kind []) + check? #(valid? pred %) kfn (c/or kfn (fn [i v] i)) addcv (fn [ret i v cv] (conj ret cv)) + [kindfn kindform] (cond + (map? kind) [map? `map?] + (vector? kind) [vector? `vector?] + (list? kind) [list? `list?] + (set? kind) [set? `set?] + :else [seqable? `seqable?]) cfns (fn [x] ;;returns a tuple of [init add complete] fns (cond - (vector? x) + (c/and (vector? x) (c/or (not conform-into) (vector? conform-into))) [identity (fn [ret i v cv] (if (identical? v cv) @@ -1222,7 +1264,7 @@ unstrumented." (assoc ret i cv))) identity] - (c/and (map? x) (map? gen-into)) + (c/and (map? x) (map? conform-into)) [(if conform-keys empty identity) (fn [ret i v cv] (if (c/and (identical? v cv) (not conform-keys)) @@ -1230,14 +1272,15 @@ unstrumented." (assoc ret (nth (if conform-keys cv v) 0) (nth cv 1)))) identity] - (list? x) [empty addcv reverse] + (c/or (list? conform-into) (c/and (not conform-into) (list? x))) + [(constantly ()) addcv reverse] - :else [empty addcv identity]))] + :else [#(empty (c/or conform-into %)) addcv identity]))] (reify Spec (conform* [_ x] (cond - (coll-prob x distinct count min-count max-count + (coll-prob x kindfn kindform distinct count min-count max-count nil nil nil) ::invalid @@ -1265,15 +1308,15 @@ unstrumented." ::invalid)))) (unform* [_ x] x) (explain* [_ path via in x] - (c/or (coll-prob x distinct count min-count max-count + (c/or (coll-prob x kindfn kindform distinct count min-count max-count path via in) - (apply merge + (apply concat ((if conform-all identity (partial take *coll-error-limit*)) (keep identity (map (fn [i v] (let [k (kfn i v)] (when-not (check? v) - (let [prob (explain-1 form pred (conj path k) via (conj in k) v)] + (let [prob (explain-1 form pred path via (conj in k) v)] prob)))) (range) x)))))) (gen* [_ overrides path rmap] @@ -1498,11 +1541,12 @@ unstrumented." {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve! p) via (if-let [name (spec-name p)] (conj via name) via) insufficient (fn [path form] - {path {:reason "Insufficient input" - :pred (abbrev form) - :val () - :via via - :in in}})] + [{:path path + :reason "Insufficient input" + :pred (abbrev form) + :val () + :via via + :in in}])] (when p (case op ::accept nil @@ -1530,7 +1574,7 @@ unstrumented." (op-explain form pred path via in input))) ::alt (if (empty? input) (insufficient path (op-describe p)) - (apply merge + (apply concat (map (fn [k form pred] (op-explain (c/or form (op-describe pred)) pred @@ -1607,17 +1651,19 @@ unstrumented." (if (accept? p) (if (= (::op p) ::pcat) (op-explain (op-describe p) p path via (conj in i) (seq data)) - {path {:reason "Extra input" - :pred (abbrev (op-describe re)) - :val data - :via via - :in (conj in i)}}) + [{:path path + :reason "Extra input" + :pred (abbrev (op-describe re)) + :val data + :via via + :in (conj in i)}]) (c/or (op-explain (op-describe p) p path via (conj in i) (seq data)) - {path {:reason "Extra input" - :pred (abbrev (op-describe p)) - :val data - :via via - :in (conj in i)}})))))) + [{:path path + :reason "Extra input" + :pred (abbrev (op-describe p)) + :val data + :via via + :in (conj in i)}])))))) (defn ^:skip-wiki regex-spec-impl "Do not call this directly, use 'spec' with a regex op argument" @@ -1632,7 +1678,7 @@ unstrumented." (explain* [_ path via in x] (if (c/or (nil? x) (coll? x)) (re-explain path via in re (seq x)) - {path {:pred (abbrev (op-describe re)) :val x :via via :in in}})) + [{:path path :pred (abbrev (op-describe re)) :val x :via via :in in}])) (gen* [_ overrides path rmap] (if gfn (gfn) @@ -1685,7 +1731,7 @@ unstrumented." (let [ret (try (apply f args) (catch Throwable t t))] (if (instance? Throwable ret) ;;TODO add exception data - {path {:pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via :in in}} + [{:path path :pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via :in in}] (let [cret (dt retspec ret rform)] (if (= ::invalid cret) @@ -1693,7 +1739,7 @@ unstrumented." (when fnspec (let [cargs (conform argspec args)] (explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret}))))))))) - {path {:pred 'ifn? :val f :via via :in in}})) + [{:path path :pred 'ifn? :val f :via via :in in}])) (gen* [_ overrides _ _] (if gfn (gfn) (gen/return diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 82e5aacd..6c68bcba 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -23,7 +23,11 @@ m1) (= m1 m2))) -(deftest conform-explain +(defn- ne [probs] + (let [[path prob] (first probs)] + [(assoc prob :path path)])) + +#_(deftest conform-explain (let [a (s/and #(> % 5) #(< % 10)) o (s/or :s string? :k keyword?) c (s/cat :a string? :b keyword?) @@ -47,77 +51,77 @@ lrange 7 7 nil lrange 8 8 nil - lrange 42 ::s/invalid {[] {:pred '(int-in-range? 7 42 %), :val 42, :via [], :in []}} + lrange 42 ::s/invalid [{:path [] :pred '(int-in-range? 7 42 %), :val 42, :via [], :in []}] - irange #inst "1938" ::s/invalid {[] {:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1938", :via [], :in []}} + irange #inst "1938" ::s/invalid [{:path [] :pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1938", :via [], :in []}] irange #inst "1942" #inst "1942" nil - irange #inst "1946" ::s/invalid {[] {:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1946", :via [], :in []}} + irange #inst "1946" ::s/invalid [{:path [] :pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1946", :via [], :in []}] - drange 3.0 ::s/invalid {[] {:pred '(<= 3.1 %), :val 3.0, :via [], :in []}} + drange 3.0 ::s/invalid [{:path [] :pred '(<= 3.1 %), :val 3.0, :via [], :in []}] drange 3.1 3.1 nil drange 3.2 3.2 nil - drange Double/POSITIVE_INFINITY ::s/invalid {[] {:pred '(not (isInfinite %)), :val Double/POSITIVE_INFINITY, :via [], :in []}} + drange Double/POSITIVE_INFINITY ::s/invalid [ {:path [] :pred '(not (isInfinite %)), :val Double/POSITIVE_INFINITY, :via [], :in []}] ;; can't use equality-based test for Double/NaN ;; drange Double/NaN ::s/invalid {[] {:pred '(not (isNaN %)), :val Double/NaN, :via [], :in []}} keyword? :k :k nil - keyword? nil ::s/invalid {[] {:pred ::s/unknown :val nil :via []}} - keyword? "abc" ::s/invalid {[] {:pred ::s/unknown :val "abc" :via []}} + keyword? nil ::s/invalid (ne {[] {:pred ::s/unknown :val nil :via []}}) + keyword? "abc" ::s/invalid (ne {[] {:pred ::s/unknown :val "abc" :via []}}) a 6 6 nil - a 3 ::s/invalid '{[] {:pred (> % 5), :val 3 :via []}} - a 20 ::s/invalid '{[] {:pred (< % 10), :val 20 :via []}} + a 3 ::s/invalid (ne '{[] {:pred (> % 5), :val 3 :via []}}) + a 20 ::s/invalid (ne '{[] {:pred (< % 10), :val 20 :via []}}) a nil "java.lang.NullPointerException" "java.lang.NullPointerException" a :k "java.lang.ClassCastException" "java.lang.ClassCastException" o "a" [:s "a"] nil o :a [:k :a] nil - o 'a ::s/invalid '{[:s] {:pred string?, :val a :via []}, [:k] {:pred keyword?, :val a :via []}} + o 'a ::s/invalid (ne '{[:s] {:pred string?, :val a :via []}, [:k] {:pred keyword?, :val a :via []}}) - c nil ::s/invalid '{[:a] {:reason "Insufficient input", :pred string?, :val (), :via []}} - c [] ::s/invalid '{[:a] {:reason "Insufficient input", :pred string?, :val (), :via []}} - c [:a] ::s/invalid '{[:a] {:pred string?, :val :a, :via []}} - c ["a"] ::s/invalid '{[:b] {:reason "Insufficient input", :pred keyword?, :val (), :via []}} + c nil ::s/invalid (ne '{[:a] {:reason "Insufficient input", :pred string?, :val (), :via []}}) + c [] ::s/invalid (ne '{[:a] {:reason "Insufficient input", :pred string?, :val (), :via []}}) + c [:a] ::s/invalid (ne '{[:a] {:pred string?, :val :a, :via []}}) + c ["a"] ::s/invalid (ne '{[:b] {:reason "Insufficient input", :pred keyword?, :val (), :via []}}) c ["s" :k] '{:a "s" :b :k} nil - c ["s" :k 5] ::s/invalid '{[] {:reason "Extra input", :pred (cat :a string? :b keyword?), :val (5), :via []}} + c ["s" :k 5] ::s/invalid (ne '{[] {:reason "Extra input", :pred (cat :a string? :b keyword?), :val (5), :via []}}) (s/cat) nil {} nil - (s/cat) [5] ::s/invalid '{[] {:reason "Extra input", :pred (cat), :val (5), :via [], :in [0]}} + (s/cat) [5] ::s/invalid (ne '{[] {:reason "Extra input", :pred (cat), :val (5), :via [], :in [0]}}) - either nil ::s/invalid '{[] {:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}} - either [] ::s/invalid '{[] {:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}} + either nil ::s/invalid (ne '{[] {:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}}) + either [] ::s/invalid (ne '{[] {:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}}) either [:k] [:b :k] nil either ["s"] [:a "s"] nil - either [:b "s"] ::s/invalid '{[] {:reason "Extra input", :pred (alt :a string? :b keyword?), :val ("s") :via []}} + either [:b "s"] ::s/invalid (ne '{[] {:reason "Extra input", :pred (alt :a string? :b keyword?), :val ("s") :via []}}) star nil [] nil star [] [] nil star [:k] [:k] nil star [:k1 :k2] [:k1 :k2] nil - star [:k1 :k2 "x"] ::s/invalid '{[] {:pred keyword?, :val "x" :via []}} - star ["a"] ::s/invalid {[] '{:pred keyword?, :val "a" :via []}} + star [:k1 :k2 "x"] ::s/invalid (ne '{[] {:pred keyword?, :val "x" :via []}}) + star ["a"] ::s/invalid (ne {[] '{:pred keyword?, :val "a" :via []}}) - plus nil ::s/invalid '{[] {:reason "Insufficient input", :pred keyword?, :val () :via []}} - plus [] ::s/invalid '{[] {:reason "Insufficient input", :pred keyword?, :val () :via []}} + plus nil ::s/invalid (ne '{[] {:reason "Insufficient input", :pred keyword?, :val () :via []}}) + plus [] ::s/invalid (ne '{[] {:reason "Insufficient input", :pred keyword?, :val () :via []}}) plus [:k] [:k] nil plus [:k1 :k2] [:k1 :k2] nil - plus [:k1 :k2 "x"] ::s/invalid '{[] {:pred keyword?, :val "x", :via [], :in [2]}} - plus ["a"] ::s/invalid '{[] {:pred keyword?, :val "a" :via []}} + plus [:k1 :k2 "x"] ::s/invalid (ne '{[] {:pred keyword?, :val "x", :via [], :in [2]}}) + plus ["a"] ::s/invalid (ne '{[] {:pred keyword?, :val "a" :via []}}) opt nil nil nil opt [] nil nil - opt :k ::s/invalid '{[] {:pred (? keyword?), :val :k, :via []}} + opt :k ::s/invalid (ne '{[] {:pred (? keyword?), :val :k, :via []}}) opt [:k] :k nil - opt [:k1 :k2] ::s/invalid '{[] {:reason "Extra input", :pred (? keyword?), :val (:k2), :via []}} - opt [:k1 :k2 "x"] ::s/invalid '{[] {:reason "Extra input", :pred (? keyword?), :val (:k2 "x"), :via []}} - opt ["a"] ::s/invalid '{[] {:pred keyword?, :val "a", :via []}} + opt [:k1 :k2] ::s/invalid (ne '{[] {:reason "Extra input", :pred (? keyword?), :val (:k2), :via []}}) + opt [:k1 :k2 "x"] ::s/invalid (ne '{[] {:reason "Extra input", :pred (? keyword?), :val (:k2 "x"), :via []}}) + opt ["a"] ::s/invalid (ne '{[] {:pred keyword?, :val "a", :via []}}) andre nil nil nil andre [] nil nil - andre :k :clojure.spec/invalid '{[] {:pred (& (* keyword?) even-count?), :val :k, :via []}} - andre [:k] ::s/invalid '{[] {:pred even-count?, :val [:k], :via []}} + andre :k :clojure.spec/invalid (ne '{[] {:pred (& (* keyword?) even-count?), :val :k, :via []}}) + andre [:k] ::s/invalid (ne '{[] {:pred even-count?, :val [:k], :via []}}) andre [:j :k] [:j :k] nil - m nil ::s/invalid '{[] {:pred map?, :val nil, :via []}} + m nil ::s/invalid (ne '{[] {:pred map?, :val nil, :via []}}) m {} {} nil m {:a "b"} {:a "b"} nil From bacc9a1bdfc425fc9e2eedf5dd442befb05812d2 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Fri, 24 Jun 2016 15:52:59 -0400 Subject: [PATCH 081/246] separate what-to-test from test Signed-off-by: Stuart Halloway Signed-off-by: Rich Hickey --- src/clj/clojure/spec/test.clj | 69 +++++++++++++++-------------------- 1 file changed, 29 insertions(+), 40 deletions(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index d2f7a00a..f7864392 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -107,12 +107,14 @@ with explain-data under ::check-call." (list x) x)) -;; duped from spec to avoid introducing public API -(defn- ns-matcher - [ns-syms] - (let [ns-names (into #{} (map str) ns-syms)] +(defn- sym-matcher + "Returns a fn that matches symbols that are either in syms, +or whose namespace is in syms." + [syms] + (let [names (into #{} (map str) syms)] (fn [s] - (contains? ns-names (namespace s))))) + (or (contains? names (namespace s)) + (contains? names (str s)))))) (defn- sym->test-map [s] @@ -125,6 +127,24 @@ with explain-data under ::check-call." [opts] (assert (every? ident? (keys (:gen opts))) "test :gen expects ident keys")) +(defn syms-to-test + "Returns a coll of registered syms matching ns-or-names (a symbol or +collection of symbols). + +A symbol matches ns-or-names if ns-or-names includes either the symbol +itself or the symbol's namespace symbol. + +If no ns-or-names specified, returns all registered syms." + ([] (sequence + (filter symbol?) + (keys (s/registry)))) + ([ns-or-names] + (let [match? (sym-matcher (collectionize ns-or-names))] + (sequence + (comp (filter symbol?) + (filter match?)) + (keys (s/registry)))))) + (defn test-fn "Runs generative tests for fn f using spec and opts. See 'test' for options and return." @@ -134,8 +154,7 @@ with explain-data under ::check-call." (test-1 {:f f :spec spec} opts))) (defn test - "Checks specs for fns named by sym-or-syms (a symbol or -collection of symbols) using test.check. + "Checks specs for vars named by syms using test.check. The opts map includes the following optional keys, where stc aliases clojure.spec.test.check: @@ -171,40 +190,10 @@ Values for the :type key can be one of :no-gen unable to generate :args :no-fn unable to resolve fn to test " - ([sym-or-syms] (test sym-or-syms nil)) - ([sym-or-syms opts] - (validate-opts opts) - (->> (eduction - (map sym->test-map) - (collectionize sym-or-syms)) - (pmap #(test-1 % opts))))) - -(defn test-ns - "Like test, but scoped to specific namespaces, or to -*ns* if no arg specified." - ([] (test-ns (.name ^clojure.lang.Namespace *ns*))) - ([ns-or-nses] (test-ns ns-or-nses nil)) - ([ns-or-nses opts] - (validate-opts opts) - (let [ns-match? (ns-matcher (collectionize ns-or-nses))] - (->> (eduction - (filter symbol?) - (filter ns-match?) - (map sym->test-map) - (keys (s/registry))) - (pmap #(test-1 % opts)))))) - -(defn test-all - "Like test, but tests all vars named by fn-specs in the spec -registry." - ([] (test-all nil)) - ([opts] + ([syms] (test syms nil)) + ([syms opts] (validate-opts opts) - (->> (eduction - (filter symbol?) - (map sym->test-map) - (keys (s/registry))) - (pmap #(test-1 % opts))))) + (pmap #(test-1 (sym->test-map %) opts) syms))) (defn abbrev-result "Given a test result, returns an abbreviated version From 20ade931fc115c6384e906f9fd4fce112db42363 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Mon, 27 Jun 2016 10:55:02 -0400 Subject: [PATCH 082/246] move instrument from spec to spec.test Signed-off-by: Stuart Halloway Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 219 ---------------------------------- src/clj/clojure/spec/test.clj | 217 +++++++++++++++++++++++++++++++++ 2 files changed, 217 insertions(+), 219 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 9f7d7839..720da415 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -34,10 +34,6 @@ "The number of errors reported by explain in a collection spec'ed with 'every'" 20) -(def ^:private ^:dynamic *instrument-enabled* - "if false, instrumented fns call straight through" - true) - (defprotocol Spec (conform* [spec x]) (unform* [spec y]) @@ -608,44 +604,6 @@ [& preds] (assert (not (empty? preds))) `(tuple-impl '~(mapv res preds) ~(vec preds))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- expect - "Returns nil if v conforms to spec, else throws ex-info with explain-data." - [spec v] - ) - -(defn- fn-spec? - "Fn-spec must include at least :args or :ret specs." - [m] - (c/or (:args m) (:ret m))) - -(defmacro with-instrument-disabled - "Disables instrument's checking of calls, within a scope." - [& body] - `(binding [*instrument-enabled* nil] - ~@body)) - -(defn- spec-checking-fn - [v f fn-spec] - (let [fn-spec (maybe-spec fn-spec) - conform! (fn [v role spec data args] - (let [conformed (conform spec data)] - (if (= ::invalid conformed) - (let [ed (assoc (explain-data* spec [role] [] [] data) - ::args args)] - (throw (ex-info - (str "Call to " v " did not conform to spec:\n" (with-out-str (explain-out ed))) - ed))) - conformed)))] - (c/fn - [& args] - (if *instrument-enabled* - (with-instrument-disabled - (when (:args fn-spec) (conform! v :args (:args fn-spec) args args)) - (binding [*instrument-enabled* true] - (.applyTo ^clojure.lang.IFn f args))) - (.applyTo ^clojure.lang.IFn f args))))) (defn- macroexpand-check [v args] @@ -695,183 +653,6 @@ [fn-sym & specs] `(clojure.spec/def ~fn-sym (clojure.spec/fspec ~@specs))) -(defn- no-fn-spec - [v spec] - (ex-info (str "Fn at " v " is not spec'ed.") - {:var v :spec spec})) - -(def ^:private instrumented-vars - "Map for instrumented vars to :raw/:wrapped fns" - (atom {})) - -(defn- ->var - [s-or-v] - (if (var? s-or-v) - s-or-v - (let [v (c/and (symbol? s-or-v) (resolve s-or-v))] - (if (var? v) - v - (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var"))))))) - -(defn- instrument-choose-fn - "Helper for instrument." - [f spec sym {over :gen :keys [stub replace]}] - (if (some #{sym} stub) - (-> spec (gen over) gen/generate) - (get replace sym f))) - -(defn- instrument-choose-spec - "Helper for instrument" - [spec sym {overrides :spec}] - (get overrides sym spec)) - -(defn- collectionize - [x] - (if (symbol? x) - (list x) - x)) - -(defn- instrument-1 - [s opts] - (when-let [v (resolve s)] - (let [spec (get-spec v) - {:keys [raw wrapped]} (get @instrumented-vars v) - current @v - to-wrap (if (= wrapped current) raw current) - ospec (c/or (instrument-choose-spec spec s opts) - (throw (no-fn-spec v spec))) - ofn (instrument-choose-fn to-wrap ospec s opts) - checked (spec-checking-fn v ofn ospec)] - (alter-var-root v (constantly checked)) - (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked})) - (->sym v))) - -(defn- unstrument-1 - [s] - (when-let [v (resolve s)] - (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] - (let [current @v] - (when (= wrapped current) - (alter-var-root v (constantly raw)))) - (swap! instrumented-vars dissoc v)) - (->sym v))) - -(defn- opt-syms - "Returns set of symbols referenced by 'instrument' opts map" - [opts] - (reduce into #{} [(:stub opts) (c/keys (:replace opts)) (c/keys (:spec opts))])) - -(defn- sym-matcher - "Returns a fn that matches symbols that are either in syms, -or whose namespace is in syms." - [syms] - (let [names (into #{} (map str) syms)] - (fn [s] - (c/or (contains? names (namespace s)) - (contains? names (str s)))))) - -(defn- validate-opts - [opts] - (assert (every? ident? (c/keys (:gen opts))) "instrument :gen expects ident keys")) - -(defn instrument - "Instruments the vars matched by ns-or-names, a symbol or a -collection of symbols. Instruments the current namespace if -ns-or-names not specified. Idempotent. - -A var matches ns-or-names if ns-or-names includes either the var's -fully qualified name or the var's namespace. - -If a var has an :args fn-spec, sets the var's root binding to a -fn that checks arg conformance (throwing an exception on failure) -before delegating to the original fn. - -The opts map can be used to override registered specs, and/or to -replace fn implementations entirely. Opts for symbols not matched -by ns-or-names are ignored. This facilitates sharing a common -options map across many different calls to instrument. - -The opts map may have the following keys: - - :spec a map from var-name symbols to override specs - :stub a collection of var-name symbols to be replaced by stubs - :gen a map from spec names to generator overrides - :replace a map from var-name symbols to replacement fns - -:spec overrides registered fn-specs with specs your provide. Use -:spec overrides to provide specs for libraries that do not have -them, or to constrain your own use of a fn to a subset of its -spec'ed contract. - -:stub replaces a fn with a stub that checks :args, then uses the -:ret spec to generate a return value. - -:gen overrides are used only for :stub generation. - -:replace replaces a fn with a fn that checks args conformance, then -invokes the fn you provide, enabling arbitrary stubbing and mocking. - -:spec can be used in combination with :stub or :replace. - -Returns a collection of syms naming the vars instrumented." - ([] (instrument (.name ^clojure.lang.Namespace *ns*))) - ([ns-or-names] (instrument ns-or-names nil)) - ([ns-or-names opts] - (validate-opts opts) - (let [match? (sym-matcher (collectionize ns-or-names))] - (locking instrumented-vars - (into - [] - (comp c/cat - (filter symbol?) - (filter match?) - (distinct) - (map #(instrument-1 % opts)) - (remove nil?)) - [(c/keys (registry)) (opt-syms opts)]))))) - -(defn unstrument - "Undoes instrument on the vars matched by ns-or-names, specified -as in instrument. Returns a collection of syms naming the vars -unstrumented." - ([] (unstrument (.name ^clojure.lang.Namespace *ns*))) - ([ns-or-names] - (let [match? (sym-matcher (collectionize ns-or-names))] - (locking instrumented-vars - (into - [] - (comp (map ->sym) - (filter match?) - (map unstrument-1) - (remove nil?)) - (c/keys @instrumented-vars)))))) - -(defn instrument-all - "Like instrument, but works on all vars." - ([] (instrument-all nil)) - ([opts] - (validate-opts opts) - (locking instrumented-vars - (into - [] - (comp c/cat - (filter symbol?) - (distinct) - (map #(instrument-1 % opts)) - (remove nil?)) - [(c/keys (registry)) (opt-syms opts)])))) - -(defn unstrument-all - "Like unstrument, but works on all vars." - [] - (locking instrumented-vars - (into - [] - (comp (map ->sym) - (map unstrument-1) - (remove nil?)) - (c/keys @instrumented-vars)))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- recur-limit? [rmap id path k] (c/and (> (get rmap id) (::recursion-limit rmap)) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index f7864392..87772527 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -17,6 +17,223 @@ (in-ns 'clojure.spec.test) (alias 'stc 'clojure.spec.test.check) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def ^:private ^:dynamic *instrument-enabled* + "if false, instrumented fns call straight through" + true) + +(defn- fn-spec? + "Fn-spec must include at least :args or :ret specs." + [m] + (or (:args m) (:ret m))) + +(defmacro with-instrument-disabled + "Disables instrument's checking of calls, within a scope." + [& body] + `(binding [*instrument-enabled* nil] + ~@body)) + +(defn- spec-checking-fn + [v f fn-spec] + (let [fn-spec (@#'s/maybe-spec fn-spec) + conform! (fn [v role spec data args] + (let [conformed (s/conform spec data)] + (if (= ::s/invalid conformed) + (let [ed (assoc (s/explain-data* spec [role] [] [] data) + ::s/args args)] + (throw (ex-info + (str "Call to " v " did not conform to spec:\n" (with-out-str (s/explain-out ed))) + ed))) + conformed)))] + (fn + [& args] + (if *instrument-enabled* + (with-instrument-disabled + (when (:args fn-spec) (conform! v :args (:args fn-spec) args args)) + (binding [*instrument-enabled* true] + (.applyTo ^clojure.lang.IFn f args))) + (.applyTo ^clojure.lang.IFn f args))))) + + +(defn- no-fn-spec + [v spec] + (ex-info (str "Fn at " v " is not spec'ed.") + {:var v :spec spec})) + +(def ^:private instrumented-vars + "Map for instrumented vars to :raw/:wrapped fns" + (atom {})) + +(defn- ->var + [s-or-v] + (if (var? s-or-v) + s-or-v + (let [v (and (symbol? s-or-v) (resolve s-or-v))] + (if (var? v) + v + (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var"))))))) + +(defn- instrument-choose-fn + "Helper for instrument." + [f spec sym {over :gen :keys [stub replace]}] + (if (some #{sym} stub) + (-> spec (s/gen over) gen/generate) + (get replace sym f))) + +(defn- instrument-choose-spec + "Helper for instrument" + [spec sym {overrides :spec}] + (get overrides sym spec)) + +(defn- collectionize + [x] + (if (symbol? x) + (list x) + x)) + +(def ->sym @#'s/->sym) + +(defn- instrument-1 + [s opts] + (when-let [v (resolve s)] + (let [spec (s/get-spec v) + {:keys [raw wrapped]} (get @instrumented-vars v) + current @v + to-wrap (if (= wrapped current) raw current) + ospec (or (instrument-choose-spec spec s opts) + (throw (no-fn-spec v spec))) + ofn (instrument-choose-fn to-wrap ospec s opts) + checked (spec-checking-fn v ofn ospec)] + (alter-var-root v (constantly checked)) + (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked})) + (->sym v))) + +(defn- unstrument-1 + [s] + (when-let [v (resolve s)] + (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] + (let [current @v] + (when (= wrapped current) + (alter-var-root v (constantly raw)))) + (swap! instrumented-vars dissoc v)) + (->sym v))) + +(defn- opt-syms + "Returns set of symbols referenced by 'instrument' opts map" + [opts] + (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))])) + +(defn- sym-matcher + "Returns a fn that matches symbols that are either in syms, +or whose namespace is in syms." + [syms] + (let [names (into #{} (map str) syms)] + (fn [s] + (or (contains? names (namespace s)) + (contains? names (str s)))))) + +(defn- validate-opts + [opts] + (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys")) + +(defn instrument + "Instruments the vars matched by ns-or-names, a symbol or a +collection of symbols. Instruments the current namespace if +ns-or-names not specified. Idempotent. + +A var matches ns-or-names if ns-or-names includes either the var's +fully qualified name or the var's namespace. + +If a var has an :args fn-spec, sets the var's root binding to a +fn that checks arg conformance (throwing an exception on failure) +before delegating to the original fn. + +The opts map can be used to override registered specs, and/or to +replace fn implementations entirely. Opts for symbols not matched +by ns-or-names are ignored. This facilitates sharing a common +options map across many different calls to instrument. + +The opts map may have the following keys: + + :spec a map from var-name symbols to override specs + :stub a collection of var-name symbols to be replaced by stubs + :gen a map from spec names to generator overrides + :replace a map from var-name symbols to replacement fns + +:spec overrides registered fn-specs with specs your provide. Use +:spec overrides to provide specs for libraries that do not have +them, or to constrain your own use of a fn to a subset of its +spec'ed contract. + +:stub replaces a fn with a stub that checks :args, then uses the +:ret spec to generate a return value. + +:gen overrides are used only for :stub generation. + +:replace replaces a fn with a fn that checks args conformance, then +invokes the fn you provide, enabling arbitrary stubbing and mocking. + +:spec can be used in combination with :stub or :replace. + +Returns a collection of syms naming the vars instrumented." + ([] (instrument (.name ^clojure.lang.Namespace *ns*))) + ([ns-or-names] (instrument ns-or-names nil)) + ([ns-or-names opts] + (validate-opts opts) + (let [match? (sym-matcher (collectionize ns-or-names))] + (locking instrumented-vars + (into + [] + (comp cat + (filter symbol?) + (filter match?) + (distinct) + (map #(instrument-1 % opts)) + (remove nil?)) + [(keys (s/registry)) (opt-syms opts)]))))) + +(defn unstrument + "Undoes instrument on the vars matched by ns-or-names, specified +as in instrument. Returns a collection of syms naming the vars +unstrumented." + ([] (unstrument (.name ^clojure.lang.Namespace *ns*))) + ([ns-or-names] + (let [match? (sym-matcher (collectionize ns-or-names))] + (locking instrumented-vars + (into + [] + (comp (map ->sym) + (filter match?) + (map unstrument-1) + (remove nil?)) + (keys @instrumented-vars)))))) + +(defn instrument-all + "Like instrument, but works on all vars." + ([] (instrument-all nil)) + ([opts] + (validate-opts opts) + (locking instrumented-vars + (into + [] + (comp cat + (filter symbol?) + (distinct) + (map #(instrument-1 % opts)) + (remove nil?)) + [(keys (s/registry)) (opt-syms opts)])))) + +(defn unstrument-all + "Like unstrument, but works on all vars." + [] + (locking instrumented-vars + (into + [] + (comp (map ->sym) + (map unstrument-1) + (remove nil?)) + (keys @instrumented-vars)))) + (defn- explain-test [args spec v role] (ex-info From 5ff3cb6658511672acab1dce24994b732c28a6b8 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Mon, 27 Jun 2016 11:36:39 -0400 Subject: [PATCH 083/246] unstrument var under test for duration of test Signed-off-by: Stuart Halloway Signed-off-by: Rich Hickey --- src/clj/clojure/spec/test.clj | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index 87772527..b211401f 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -305,17 +305,21 @@ with explain-data under ::check-call." (assoc result :type (result-type result)))) (defn- test-1 - [{:keys [s f spec]} {:keys [result-callback] :as opts}] - (cond - (nil? f) - {:type :no-fn :sym s :spec spec} - - (:args spec) - (let [tcret (check-fn f spec opts)] - (make-test-result s spec tcret)) - - :default - {:type :no-argspec :sym s :spec spec})) + [{:keys [s f v spec]} {:keys [result-callback] :as opts}] + (when v (unstrument s)) + (try + (cond + (nil? f) + {:type :no-fn :sym s :spec spec} + + (:args spec) + (let [tcret (check-fn f spec opts)] + (make-test-result s spec tcret)) + + :default + {:type :no-argspec :sym s :spec spec}) + (finally + (when v (instrument s))))) ;; duped from spec to avoid introducing public API (defn- collectionize @@ -337,7 +341,7 @@ or whose namespace is in syms." [s] (let [v (resolve s)] {:s s - :f (when v @v) + :v v :spec (when v (s/get-spec v))})) (defn- validate-opts From a4477453db5b195dd6d1041f1da31c75af21c939 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Mon, 27 Jun 2016 15:56:25 -0400 Subject: [PATCH 084/246] separate enumeration from instrument and test Signed-off-by: Stuart Halloway Signed-off-by: Rich Hickey --- src/clj/clojure/spec/test.clj | 274 +++++++++++++++------------------- 1 file changed, 121 insertions(+), 153 deletions(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index b211401f..584d7d6a 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -17,7 +17,44 @@ (in-ns 'clojure.spec.test) (alias 'stc 'clojure.spec.test.check) +(defn- throwable? + [x] + (instance? Throwable x)) + +(defn ->sym + [x] + (@#'s/->sym x)) + +(defn- ->var + [s-or-v] + (if (var? s-or-v) + s-or-v + (let [v (and (symbol? s-or-v) (resolve s-or-v))] + (if (var? v) + v + (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var"))))))) + +(defn- collectionize + [x] + (if (symbol? x) + (list x) + x)) + +(defn enumerate-namespace + "Given a symbol naming an ns, or a collection of such symbols, +returns the set of all symbols naming vars in those nses." + [ns-sym-or-syms] + (into + #{} + (mapcat (fn [ns-sym] + (map + (fn [name-sym] + (symbol (name ns-sym) (name name-sym))) + (keys (ns-interns ns-sym))))) + (collectionize ns-sym-or-syms))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (def ^:private ^:dynamic *instrument-enabled* "if false, instrumented fns call straight through" true) @@ -54,7 +91,6 @@ (.applyTo ^clojure.lang.IFn f args))) (.applyTo ^clojure.lang.IFn f args))))) - (defn- no-fn-spec [v spec] (ex-info (str "Fn at " v " is not spec'ed.") @@ -64,15 +100,6 @@ "Map for instrumented vars to :raw/:wrapped fns" (atom {})) -(defn- ->var - [s-or-v] - (if (var? s-or-v) - s-or-v - (let [v (and (symbol? s-or-v) (resolve s-or-v))] - (if (var? v) - v - (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var"))))))) - (defn- instrument-choose-fn "Helper for instrument." [f spec sym {over :gen :keys [stub replace]}] @@ -85,14 +112,6 @@ [spec sym {overrides :spec}] (get overrides sym spec)) -(defn- collectionize - [x] - (if (symbol? x) - (list x) - x)) - -(def ->sym @#'s/->sym) - (defn- instrument-1 [s opts] (when-let [v (resolve s)] @@ -123,40 +142,39 @@ [opts] (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))])) -(defn- sym-matcher - "Returns a fn that matches symbols that are either in syms, -or whose namespace is in syms." - [syms] - (let [names (into #{} (map str) syms)] - (fn [s] - (or (contains? names (namespace s)) - (contains? names (str s)))))) +(defn- fn-spec-name? + [s] + (symbol? s)) -(defn- validate-opts - [opts] - (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys")) +(defn instrumentable-syms + "Given an opts map as per instrument, returns the set of syms +that can be instrumented." + ([] (instrumentable-syms nil)) + ([opts] + (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys") + (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) + (keys (:spec opts)) + (:stub opts) + (keys (:replace opts))]))) (defn instrument - "Instruments the vars matched by ns-or-names, a symbol or a -collection of symbols. Instruments the current namespace if -ns-or-names not specified. Idempotent. - -A var matches ns-or-names if ns-or-names includes either the var's -fully qualified name or the var's namespace. + "Instruments the vars named by sym-or-syms, a symbol or collection +of symbols, or all instrumentable vars if sym-or-syms is not +specified. If a var has an :args fn-spec, sets the var's root binding to a fn that checks arg conformance (throwing an exception on failure) before delegating to the original fn. The opts map can be used to override registered specs, and/or to -replace fn implementations entirely. Opts for symbols not matched -by ns-or-names are ignored. This facilitates sharing a common +replace fn implementations entirely. Opts for symbols not included +in sym-or-syms are ignored. This facilitates sharing a common options map across many different calls to instrument. The opts map may have the following keys: :spec a map from var-name symbols to override specs - :stub a collection of var-name symbols to be replaced by stubs + :stub a set of var-name symbols to be replaced by stubs :gen a map from spec names to generator overrides :replace a map from var-name symbols to replacement fns @@ -176,63 +194,33 @@ invokes the fn you provide, enabling arbitrary stubbing and mocking. :spec can be used in combination with :stub or :replace. Returns a collection of syms naming the vars instrumented." - ([] (instrument (.name ^clojure.lang.Namespace *ns*))) - ([ns-or-names] (instrument ns-or-names nil)) - ([ns-or-names opts] - (validate-opts opts) - (let [match? (sym-matcher (collectionize ns-or-names))] - (locking instrumented-vars - (into - [] - (comp cat - (filter symbol?) - (filter match?) - (distinct) - (map #(instrument-1 % opts)) - (remove nil?)) - [(keys (s/registry)) (opt-syms opts)]))))) - -(defn unstrument - "Undoes instrument on the vars matched by ns-or-names, specified -as in instrument. Returns a collection of syms naming the vars -unstrumented." - ([] (unstrument (.name ^clojure.lang.Namespace *ns*))) - ([ns-or-names] - (let [match? (sym-matcher (collectionize ns-or-names))] - (locking instrumented-vars - (into - [] - (comp (map ->sym) - (filter match?) - (map unstrument-1) - (remove nil?)) - (keys @instrumented-vars)))))) - -(defn instrument-all - "Like instrument, but works on all vars." - ([] (instrument-all nil)) - ([opts] - (validate-opts opts) + ([] (instrument (instrumentable-syms))) + ([sym-or-syms] (instrument sym-or-syms nil)) + ([sym-or-syms opts] (locking instrumented-vars (into [] - (comp cat - (filter symbol?) + (comp (filter (instrumentable-syms opts)) (distinct) (map #(instrument-1 % opts)) (remove nil?)) - [(keys (s/registry)) (opt-syms opts)])))) - -(defn unstrument-all - "Like unstrument, but works on all vars." - [] - (locking instrumented-vars - (into - [] - (comp (map ->sym) - (map unstrument-1) - (remove nil?)) - (keys @instrumented-vars)))) + (collectionize sym-or-syms))))) + +(defn unstrument + "Undoes instrument on the vars named by sym-or-syms, specified +as in instrument. With no args, unstruments all instrumented vars. +Returns a collection of syms naming the vars unstrumented." + ([] (unstrument (map ->sym (keys @instrumented-vars)))) + ([sym-or-syms] + (locking instrumented-vars + (into + [] + (comp (filter symbol?) + (map unstrument-1) + (remove nil?)) + (collectionize sym-or-syms))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- explain-test [args spec v role] @@ -260,10 +248,6 @@ with explain-data under ::check-call." (explain-test args (:fn specs) {:args cargs :ret cret} :fn)) true)))))) -(defn- throwable? - [x] - (instance? Throwable x)) - (defn- check-fn [f specs {gen :gen opts ::stc/opts}] (let [{:keys [num-tests] :or {num-tests 100}} opts @@ -308,35 +292,20 @@ with explain-data under ::check-call." [{:keys [s f v spec]} {:keys [result-callback] :as opts}] (when v (unstrument s)) (try - (cond - (nil? f) - {:type :no-fn :sym s :spec spec} + (let [f (or f (when v @v))] + (cond + (nil? f) + {:type :no-fn :sym s :spec spec} - (:args spec) - (let [tcret (check-fn f spec opts)] - (make-test-result s spec tcret)) + (:args spec) + (let [tcret (check-fn f spec opts)] + (make-test-result s spec tcret)) - :default - {:type :no-argspec :sym s :spec spec}) + :default + {:type :no-argspec :sym s :spec spec})) (finally (when v (instrument s))))) -;; duped from spec to avoid introducing public API -(defn- collectionize - [x] - (if (symbol? x) - (list x) - x)) - -(defn- sym-matcher - "Returns a fn that matches symbols that are either in syms, -or whose namespace is in syms." - [syms] - (let [names (into #{} (map str) syms)] - (fn [s] - (or (contains? names (namespace s)) - (contains? names (str s)))))) - (defn- sym->test-map [s] (let [v (resolve s)] @@ -344,38 +313,31 @@ or whose namespace is in syms." :v v :spec (when v (s/get-spec v))})) -(defn- validate-opts +(defn- validate-test-opts [opts] (assert (every? ident? (keys (:gen opts))) "test :gen expects ident keys")) -(defn syms-to-test - "Returns a coll of registered syms matching ns-or-names (a symbol or -collection of symbols). - -A symbol matches ns-or-names if ns-or-names includes either the symbol -itself or the symbol's namespace symbol. - -If no ns-or-names specified, returns all registered syms." - ([] (sequence - (filter symbol?) - (keys (s/registry)))) - ([ns-or-names] - (let [match? (sym-matcher (collectionize ns-or-names))] - (sequence - (comp (filter symbol?) - (filter match?)) - (keys (s/registry)))))) - (defn test-fn "Runs generative tests for fn f using spec and opts. See 'test' for options and return." ([f spec] (test-fn f spec nil)) ([f spec opts] - (validate-opts opts) + (validate-test-opts opts) (test-1 {:f f :spec spec} opts))) +(defn testable-syms + "Given an opts map as per test, returns the set of syms that +can be tested." + ([] (testable-syms nil)) + ([opts] + (validate-test-opts opts) + (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) + (keys (:spec opts))]))) + (defn test - "Checks specs for vars named by syms using test.check. + "Run generative tests for spec conformance on vars named by +sym-or-syms, a symbol or collection of symbols. If sym-or-syms +is not specified, test all testable vars. The opts map includes the following optional keys, where stc aliases clojure.spec.test.check: @@ -411,10 +373,15 @@ Values for the :type key can be one of :no-gen unable to generate :args :no-fn unable to resolve fn to test " - ([syms] (test syms nil)) - ([syms opts] - (validate-opts opts) - (pmap #(test-1 (sym->test-map %) opts) syms))) + ([] (test (testable-syms))) + ([sym-or-syms] (test sym-or-syms nil)) + ([sym-or-syms opts] + (->> (collectionize sym-or-syms) + (filter (testable-syms opts)) + (pmap + #(test-1 (sym->test-map %) opts))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; test reporting ;;;;;;;;;;;;;;;;;;;;;;;; (defn abbrev-result "Given a test result, returns an abbreviated version @@ -425,20 +392,21 @@ suitable for summary use." (update (dissoc x ::stc/ret) :spec s/describe))) (defn summarize-results - "Given a collection of test-results, e.g. from 'test', -pretty prints the abbrev-result of each. + "Given a collection of test-results, e.g. from 'test', pretty +prints the summary-result (default abbrev-result) of each. Returns a map with :total, the total number of results, plus a key with a count for each different :type of result." - [test-results] - (reduce - (fn [summary result] - (pp/pprint (abbrev-result result)) - (-> summary - (update :total inc) - (update (:type result) (fnil inc 0)))) - {:total 0} - test-results)) + ([test-results] (summarize-results test-results abbrev-result)) + ([test-results summary-result] + (reduce + (fn [summary result] + (pp/pprint (summary-result result)) + (-> summary + (update :total inc) + (update (:type result) (fnil inc 0)))) + {:total 0} + test-results))) From 75da0465f300519a74f6fa13582ea8eb8877b148 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Mon, 27 Jun 2016 16:02:43 -0400 Subject: [PATCH 085/246] dump training wheel tests Signed-off-by: Rich Hickey --- test/clojure/test_clojure/spec.clj | 73 ------------------------------ 1 file changed, 73 deletions(-) diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 6c68bcba..cabed04e 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -132,82 +132,9 @@ ;;coll [:a "b"] ::s/invalid '{[] {:pred (coll-checker keyword?), :val [:a b], :via []}} ))) -(s/fdef flip-nums - :args (s/cat :arg1 integer? :arg2 integer?) - :ret vector? - :fn (fn [{:keys [args ret]}] - (= ret [(:arg2 args) (:arg1 args)]))) - -(def ^:dynamic *break-flip-nums* false) -(defn flip-nums - "Set *break-flip-nums* to break this fns compatibility with -its spec for test purposes." - [a b] - (if *break-flip-nums* - (when-not (= a b) - (vec (sort [a b]))) - [b a])) - -(defmacro get-ex-data - [x] - `(try - ~x - nil - (catch Throwable t# - (ex-data t#)))) - -;; Note the the complicated equality comparisons below are exactly the -;; kind of thing that spec helps you avoid, used here only because we -;; are near the bottom, testing spec itself. -(deftest test-instrument-flip-nums - (when-not (= "true" (System/getProperty "clojure.compiler.direct-linking")) - (binding [*break-flip-nums* true] - (try - (= [1 2] (flip-nums 2 1)) - (= [:a :b] (flip-nums :a :b)) - (= [1 2] (flip-nums 1 2)) - (is (nil? (flip-nums 1 1))) - (s/instrument `flip-nums) - (is (= [1 2] (flip-nums 2 1))) - (is (submap? '{:clojure.spec/problems {[:args :arg1] {:pred integer?, :val :a, :via []}}, :clojure.spec/args (:a :b)} - (get-ex-data (flip-nums :a :b)))) - (is (submap? '{:clojure.spec/problems {[:fn] {:pred (fn [{:keys [args ret]}] (= ret [(:arg2 args) (:arg1 args)])), :val {:args {:arg1 1, :arg2 2}, :ret [1 2]}, :via []}}, :clojure.spec/args (1 2)} - (get-ex-data (flip-nums 1 2)))) - (is (submap? '{:clojure.spec/problems {[:ret] {:pred vector?, :val nil, :via []}}, :clojure.spec/args (1 1)} - (get-ex-data (flip-nums 1 1)))) - (s/unstrument `flip-nums) - (= [1 2] (flip-nums 2 1)) - (= [:a :b] (flip-nums :a :b)) - (= [1 2] (flip-nums 1 2)) - (is (nil? (flip-nums 1 1))) - (s/unstrument `flip-nums))))) - -(def core-pred-syms - (into #{} - (comp (map first) (filter (fn [s] (.endsWith (name s) "?")))) - (ns-publics 'clojure.core))) - -(def generatable-core-pred-syms - (into #{} - (filter #(gen/gen-for-pred @ (resolve %))) - core-pred-syms)) - -(s/fdef generate-from-core-pred - :args (s/cat :s generatable-core-pred-syms) - :ret ::s/any - :fn (fn [{:keys [args ret]}] - (@(resolve (:s args)) ret))) - -(defn generate-from-core-pred - [s] - (gen/generate (gen/gen-for-pred @(resolve s)))) - (comment (require '[clojure.test :refer (run-tests)]) (in-ns 'clojure.test-clojure.spec) (run-tests) - (stest/run-all-tests) - (stest/check-var #'generate-from-core-pred :num-tests 10000) - ) From 20b877f0e7c0a40497c1ca8e1d9988bdf2a84587 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 28 Jun 2016 12:33:54 -0500 Subject: [PATCH 086/246] update test for explain-data Signed-off-by: Rich Hickey --- test/clojure/test_clojure/spec.clj | 98 +++++++++++++++++------------- 1 file changed, 56 insertions(+), 42 deletions(-) diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index cabed04e..b1de85d1 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -23,11 +23,7 @@ m1) (= m1 m2))) -(defn- ne [probs] - (let [[path prob] (first probs)] - [(assoc prob :path path)])) - -#_(deftest conform-explain +(deftest conform-explain (let [a (s/and #(> % 5) #(< % 10)) o (s/or :s string? :k keyword?) c (s/cat :a string? :b keyword?) @@ -37,7 +33,11 @@ opt (s/? keyword?) andre (s/& (s/* keyword?) even-count?) m (s/map-of keyword? string?) - coll (s/coll-of keyword? []) + mkeys (s/map-of (s/and keyword? (s/conformer name)) ::s/any) + mkeys2 (s/map-of (s/and keyword? (s/conformer name)) ::s/any :conform-keys true) + s (s/coll-of (s/spec (s/cat :tag keyword? :val ::s/any)) :kind ()) + v (s/coll-of keyword? :kind []) + coll (s/coll-of keyword?) lrange (s/int-in 7 42) drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2) irange (s/inst-in #inst "1939" #inst "1946") @@ -46,90 +46,104 @@ (let [co (result-or-ex (s/conform spec x)) e (result-or-ex (::s/problems (s/explain-data spec x)))] (when (not= conformed co) (println "conform fail\n\texpect=" conformed "\n\tactual=" co)) - (when (not (submap? ed e)) (println "explain fail\n\texpect=" ed "\n\tactual=" e)) - (and (= conformed co) (submap? ed e))) + (when (not (every? true? (map submap? ed e))) + (println "explain failures\n\texpect=" ed "\n\tactual failures=" e "\n\tsubmap?=" (map submap? ed e))) + (and (= conformed co) (every? true? (map submap? ed e)))) lrange 7 7 nil lrange 8 8 nil - lrange 42 ::s/invalid [{:path [] :pred '(int-in-range? 7 42 %), :val 42, :via [], :in []}] + lrange 42 ::s/invalid [{:pred '(int-in-range? 7 42 %), :val 42}] - irange #inst "1938" ::s/invalid [{:path [] :pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1938", :via [], :in []}] + irange #inst "1938" ::s/invalid [{:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1938"}] irange #inst "1942" #inst "1942" nil - irange #inst "1946" ::s/invalid [{:path [] :pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1946", :via [], :in []}] + irange #inst "1946" ::s/invalid [{:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1946"}] - drange 3.0 ::s/invalid [{:path [] :pred '(<= 3.1 %), :val 3.0, :via [], :in []}] + drange 3.0 ::s/invalid [{:pred '(<= 3.1 %), :val 3.0}] drange 3.1 3.1 nil drange 3.2 3.2 nil - drange Double/POSITIVE_INFINITY ::s/invalid [ {:path [] :pred '(not (isInfinite %)), :val Double/POSITIVE_INFINITY, :via [], :in []}] + drange Double/POSITIVE_INFINITY ::s/invalid [{:pred '(not (isInfinite %)), :val Double/POSITIVE_INFINITY}] ;; can't use equality-based test for Double/NaN - ;; drange Double/NaN ::s/invalid {[] {:pred '(not (isNaN %)), :val Double/NaN, :via [], :in []}} + ;; drange Double/NaN ::s/invalid {[] {:pred '(not (isNaN %)), :val Double/NaN}} keyword? :k :k nil - keyword? nil ::s/invalid (ne {[] {:pred ::s/unknown :val nil :via []}}) - keyword? "abc" ::s/invalid (ne {[] {:pred ::s/unknown :val "abc" :via []}}) + keyword? nil ::s/invalid [{:pred ::s/unknown :val nil}] + keyword? "abc" ::s/invalid [{:pred ::s/unknown :val "abc"}] a 6 6 nil - a 3 ::s/invalid (ne '{[] {:pred (> % 5), :val 3 :via []}}) - a 20 ::s/invalid (ne '{[] {:pred (< % 10), :val 20 :via []}}) + a 3 ::s/invalid '[{:pred (> % 5), :val 3}] + a 20 ::s/invalid '[{:pred (< % 10), :val 20}] a nil "java.lang.NullPointerException" "java.lang.NullPointerException" a :k "java.lang.ClassCastException" "java.lang.ClassCastException" o "a" [:s "a"] nil o :a [:k :a] nil - o 'a ::s/invalid (ne '{[:s] {:pred string?, :val a :via []}, [:k] {:pred keyword?, :val a :via []}}) + o 'a ::s/invalid '[{:pred string?, :val a, :path [:s]} {:pred keyword?, :val a :path [:k]}] - c nil ::s/invalid (ne '{[:a] {:reason "Insufficient input", :pred string?, :val (), :via []}}) - c [] ::s/invalid (ne '{[:a] {:reason "Insufficient input", :pred string?, :val (), :via []}}) - c [:a] ::s/invalid (ne '{[:a] {:pred string?, :val :a, :via []}}) - c ["a"] ::s/invalid (ne '{[:b] {:reason "Insufficient input", :pred keyword?, :val (), :via []}}) + c nil ::s/invalid '[{:reason "Insufficient input", :pred string?, :val (), :path [:a]}] + c [] ::s/invalid '[{:reason "Insufficient input", :pred string?, :val (), :path [:a]}] + c [:a] ::s/invalid '[{:pred string?, :val :a, :path [:a], :in [0]}] + c ["a"] ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val (), :path [:b]}] c ["s" :k] '{:a "s" :b :k} nil - c ["s" :k 5] ::s/invalid (ne '{[] {:reason "Extra input", :pred (cat :a string? :b keyword?), :val (5), :via []}}) + c ["s" :k 5] ::s/invalid '[{:reason "Extra input", :pred (cat :a string? :b keyword?), :val (5)}] (s/cat) nil {} nil - (s/cat) [5] ::s/invalid (ne '{[] {:reason "Extra input", :pred (cat), :val (5), :via [], :in [0]}}) + (s/cat) [5] ::s/invalid '[{:reason "Extra input", :pred (cat), :val (5), :in [0]}] - either nil ::s/invalid (ne '{[] {:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}}) - either [] ::s/invalid (ne '{[] {:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}}) + either nil ::s/invalid '[{:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}] + either [] ::s/invalid '[{:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}] either [:k] [:b :k] nil either ["s"] [:a "s"] nil - either [:b "s"] ::s/invalid (ne '{[] {:reason "Extra input", :pred (alt :a string? :b keyword?), :val ("s") :via []}}) + either [:b "s"] ::s/invalid '[{:reason "Extra input", :pred (alt :a string? :b keyword?), :val ("s") :via []}] star nil [] nil star [] [] nil star [:k] [:k] nil star [:k1 :k2] [:k1 :k2] nil - star [:k1 :k2 "x"] ::s/invalid (ne '{[] {:pred keyword?, :val "x" :via []}}) - star ["a"] ::s/invalid (ne {[] '{:pred keyword?, :val "a" :via []}}) + star [:k1 :k2 "x"] ::s/invalid '[{:pred keyword?, :val "x" :via []}] + star ["a"] ::s/invalid '[{:pred keyword?, :val "a" :via []}] - plus nil ::s/invalid (ne '{[] {:reason "Insufficient input", :pred keyword?, :val () :via []}}) - plus [] ::s/invalid (ne '{[] {:reason "Insufficient input", :pred keyword?, :val () :via []}}) + plus nil ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val () :via []}] + plus [] ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val () :via []}] plus [:k] [:k] nil plus [:k1 :k2] [:k1 :k2] nil - plus [:k1 :k2 "x"] ::s/invalid (ne '{[] {:pred keyword?, :val "x", :via [], :in [2]}}) - plus ["a"] ::s/invalid (ne '{[] {:pred keyword?, :val "a" :via []}}) + plus [:k1 :k2 "x"] ::s/invalid '[{:pred keyword?, :val "x", :in [2]}] + plus ["a"] ::s/invalid '[{:pred keyword?, :val "a" :via []}] opt nil nil nil opt [] nil nil - opt :k ::s/invalid (ne '{[] {:pred (? keyword?), :val :k, :via []}}) + opt :k ::s/invalid '[{:pred (? keyword?), :val :k}] opt [:k] :k nil - opt [:k1 :k2] ::s/invalid (ne '{[] {:reason "Extra input", :pred (? keyword?), :val (:k2), :via []}}) - opt [:k1 :k2 "x"] ::s/invalid (ne '{[] {:reason "Extra input", :pred (? keyword?), :val (:k2 "x"), :via []}}) - opt ["a"] ::s/invalid (ne '{[] {:pred keyword?, :val "a", :via []}}) + opt [:k1 :k2] ::s/invalid '[{:reason "Extra input", :pred (? keyword?), :val (:k2)}] + opt [:k1 :k2 "x"] ::s/invalid '[{:reason "Extra input", :pred (? keyword?), :val (:k2 "x")}] + opt ["a"] ::s/invalid '[{:pred keyword?, :val "a"}] andre nil nil nil andre [] nil nil - andre :k :clojure.spec/invalid (ne '{[] {:pred (& (* keyword?) even-count?), :val :k, :via []}}) - andre [:k] ::s/invalid (ne '{[] {:pred even-count?, :val [:k], :via []}}) + andre :k :clojure.spec/invalid '[{:pred (& (* keyword?) even-count?), :val :k}] + andre [:k] ::s/invalid '[{:pred even-count?, :val [:k]}] andre [:j :k] [:j :k] nil - m nil ::s/invalid (ne '{[] {:pred map?, :val nil, :via []}}) + m nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] m {} {} nil m {:a "b"} {:a "b"} nil + mkeys nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] + mkeys {} {} nil + mkeys {:a 1 :b 2} {:a 1 :b 2} nil + + mkeys2 nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] + mkeys2 {} {} nil + mkeys2 {:a 1 :b 2} {"a" 1 "b" 2} nil + + s '([:a 1] [:b "2"]) '({:tag :a :val 1} {:tag :b :val "2"}) nil + + v [:a :b] [:a :b] nil + v '(:a :b) ::s/invalid '[{:pred clojure.core/vector? :val (:a :b)}] + coll nil nil nil coll [] [] nil coll [:a] [:a] nil coll [:a :b] [:a :b] nil - ;;coll [:a "b"] ::s/invalid '{[] {:pred (coll-checker keyword?), :val [:a b], :via []}} + ;;coll [:a "b"] ::s/invalid '[{:pred (coll-checker keyword?), :val [:a b]}] ))) (comment From baa6c45b103dcdc8f8e551ace12943886b59f397 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Tue, 28 Jun 2016 13:28:54 -0400 Subject: [PATCH 087/246] common key for all kinds of failures in ex-data, interpret ex-data only in test summaries Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 2 +- src/clj/clojure/spec/test.clj | 67 ++++++++++++++++++----------------- 2 files changed, 36 insertions(+), 33 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 720da415..61970046 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -224,7 +224,7 @@ (gen/such-that #(valid? spec %) g 100) (let [abbr (abbrev form)] (throw (ex-info (str "Unable to construct gen at: " path " for: " abbr) - {::path path ::no-gen-for form})))))) + {::path path ::form form ::failure :no-gen})))))) (defn gen "Given a spec, returns the generator for it, or throws if none can diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index 584d7d6a..c6eea49a 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -77,7 +77,8 @@ returns the set of all symbols naming vars in those nses." (let [conformed (s/conform spec data)] (if (= ::s/invalid conformed) (let [ed (assoc (s/explain-data* spec [role] [] [] data) - ::s/args args)] + ::s/args args + ::s/failure :instrument-check-failed)] (throw (ex-info (str "Call to " v " did not conform to spec:\n" (with-out-str (s/explain-out ed))) ed))) @@ -94,7 +95,7 @@ returns the set of all symbols naming vars in those nses." (defn- no-fn-spec [v spec] (ex-info (str "Fn at " v " is not spec'ed.") - {:var v :spec spec})) + {:var v :spec spec ::s/failure :no-fn-spec})) (def ^:private instrumented-vars "Map for instrumented vars to :raw/:wrapped fns" @@ -229,7 +230,8 @@ Returns a collection of syms naming the vars unstrumented." (when-not (s/valid? spec v nil) (assoc (s/explain-data* spec [role] [] [] v) ::args args - ::val v)))) + ::val v + ::s/failure :test-failed)))) (defn- check-call "Returns true if call passes specs, otherwise *returns* an exception @@ -257,36 +259,21 @@ with explain-data under ::check-call." (let [prop (gen/for-all* [g] #(check-call f specs %))] (apply gen/quick-check num-tests prop (mapcat identity opts)))))) -(defn- unwrap-return - "Unwraps exceptions used to flow information through test.check." +(defn- failure-type [x] - (let [data (ex-data x)] - (if (or (::args data) (::s/args data) (::s/no-gen-for data)) - data - x))) - -(defn- result-type - [result] - (let [ret (:result result)] - (cond - (true? ret) :pass - (::s/args ret) :no-argspec - (::s/no-gen-for ret) :no-gen - (::args ret) :fail - :default :error))) + (::s/failure (ex-data x))) (defn- make-test-result "Builds spec result map." [test-sym spec test-check-ret] - (let [result (merge {:spec spec - ::stc/ret test-check-ret} - (when test-sym - {:sym test-sym}) - (when-let [result (-> test-check-ret :result)] - {:result (unwrap-return result)}) - (when-let [shrunk (-> test-check-ret :shrunk)] - {:result (unwrap-return (:result shrunk))}))] - (assoc result :type (result-type result)))) + (merge {:spec spec + ::stc/ret test-check-ret} + (when test-sym + {:sym test-sym}) + (when-let [result (-> test-check-ret :result)] + {:result result}) + (when-let [shrunk (-> test-check-ret :shrunk)] + {:result (:result shrunk)}))) (defn- test-1 [{:keys [s f v spec]} {:keys [result-callback] :as opts}] @@ -295,14 +282,14 @@ with explain-data under ::check-call." (let [f (or f (when v @v))] (cond (nil? f) - {:type :no-fn :sym s :spec spec} + {::s/failure :no-fn :sym s :spec spec} (:args spec) (let [tcret (check-fn f spec opts)] (make-test-result s spec tcret)) :default - {:type :no-argspec :sym s :spec spec})) + {::s/failure :no-args-spec :sym s :spec spec})) (finally (when v (instrument s))))) @@ -383,13 +370,29 @@ Values for the :type key can be one of ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; test reporting ;;;;;;;;;;;;;;;;;;;;;;;; +(defn- unwrap-failure + [x] + (if (failure-type x) + (ex-data x) + x)) + +(defn- result-type + [ret] + (let [result (:result ret)] + (cond + (true? result) :test-passed + (failure-type result) (failure-type result) + :default :test-threw))) + (defn abbrev-result "Given a test result, returns an abbreviated version suitable for summary use." [x] (if (true? (:result x)) (dissoc x :spec ::stc/ret :result) - (update (dissoc x ::stc/ret) :spec s/describe))) + (-> (dissoc x ::stc/ret) + (update :spec s/describe) + (update :result unwrap-failure)))) (defn summarize-results "Given a collection of test-results, e.g. from 'test', pretty @@ -404,7 +407,7 @@ key with a count for each different :type of result." (pp/pprint (summary-result result)) (-> summary (update :total inc) - (update (:type result) (fnil inc 0)))) + (update (result-type result) (fnil inc 0)))) {:total 0} test-results))) From 386e7e63485bcb7bed050df2c2b54a6ceca05e5f Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 28 Jun 2016 16:05:16 -0400 Subject: [PATCH 088/246] every/coll :kind is pred/spec --- src/clj/clojure/spec.clj | 95 ++++++++++++++++-------------- test/clojure/test_clojure/spec.clj | 14 ++--- 2 files changed, 58 insertions(+), 51 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 61970046..32bcd3db 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -159,8 +159,9 @@ (with-gen* (specize spec) gen-fn)) (defn explain-data* [spec path via in x] - (when-let [probs (explain* (specize spec) path via in x)] - {::problems probs})) + (let [probs (explain* (specize spec) path via in x)] + (when-not (empty? probs) + {::problems probs}))) (defn explain-data "Given a spec and a value x which ought to conform, returns nil if x @@ -188,7 +189,7 @@ (when-not (empty? path) (print " at:" (pr-str path))) (print " predicate: ") - (pr pred) + (pr (abbrev pred)) (when reason (print ", " reason)) (doseq [[k v] prob] (when-not (#{:path :pred :val :reason :via :in} k) @@ -456,7 +457,9 @@ Takes several kwargs options that further constrain the collection: - :kind - one of [], (), {}, #{} - must be this kind of collection - (default nil) + :kind - a pred/spec that the collection type must satisfy, e.g. vector? + (default nil) Note that if :kind is specified and :into is + not, this pred must generate in order for every to generate. :count - specifies coll has exactly this count (default nil) :min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil) :distinct - all the elements are distinct (default nil) @@ -464,7 +467,8 @@ And additional args that control gen :gen-max - the maximum coll size to generate (default 20) - :into - one of [], (), {}, #{} - the default collection to generate into (default same as :kind if supplied, else []) + :into - one of [], (), {}, #{} - the default collection to generate into + (default: empty coll as generated by :kind pred if supplied, else []) Optionally takes :gen generator-fn, which must be a fn of no args that returns a test.check generator @@ -472,7 +476,8 @@ See also - coll-of, every-kv " [pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}] - `(every-impl '~pred ~pred ~(dissoc opts :gen) ~gen)) + (let [nopts (-> opts (dissoc :gen) (assoc ::kind-form `'~(res (:kind opts))))] + `(every-impl '~pred ~pred ~nopts ~gen))) (defmacro every-kv "like 'every' but takes separate key and val preds and works on associative collections. @@ -501,13 +506,13 @@ vpred. Unlike 'every-kv', map-of will exhaustively conform every value. - Same options as 'every', :kind set to {}, with the addition of: + Same options as 'every', :kind defaults to map?, with the addition of: :conform-keys - conform keys as well as values (default false) See also - every-kv" [kpred vpred & opts] - `(every-kv ~kpred ~vpred ::conform-all true ~@opts :kind {})) + `(every-kv ~kpred ~vpred ::conform-all true :kind map? ~@opts)) (defmacro * @@ -733,7 +738,9 @@ pred-exprs pred-forms) (keep identity) seq)] - [{:path path :pred (vec probs) :val x :via via :in in}]) + (map + #(identity {:path path :pred % :val x :via via :in in}) + probs)) (map (fn [[k v]] (when-not (c/or (not (contains? reg (keys->specs k))) (valid? (keys->specs k) v k)) @@ -821,7 +828,7 @@ path (conj path dv)] (if-let [pred (predx x)] (explain-1 form pred path via in x) - [{:path path :pred form :val x :reason "no method" :via via :in in}]))) + [{:path path :pred (abbrev form) :val x :reason "no method" :via via :in in}]))) (gen* [_ overrides path rmap] (if gfn (gfn) @@ -997,10 +1004,11 @@ (defn- coll-prob [x kfn kform distinct count min-count max-count path via in] - (let [] + (let [pred (c/or kfn coll?) + kform (c/or kform `coll?)] (cond - (not (kfn x)) - [{:path path :pred kform :val x :via via :in in}] + (not (valid? pred x)) + (explain-1 kform pred path via in x) (c/and distinct (not (empty? x)) (not (apply distinct? x))) [{:path path :pred 'distinct? :val x :via via :in in}] @@ -1018,22 +1026,15 @@ "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'" ([form pred opts] (every-impl form pred opts nil)) ([form pred {gen-into :into - :keys [kind count max-count min-count distinct gen-max ::kfn + :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn conform-keys ::conform-all] :or {gen-max 20} :as opts} gfn] - (let [conform-into (c/or gen-into kind) - gen-into (c/or gen-into kind []) + (let [conform-into gen-into check? #(valid? pred %) kfn (c/or kfn (fn [i v] i)) addcv (fn [ret i v cv] (conj ret cv)) - [kindfn kindform] (cond - (map? kind) [map? `map?] - (vector? kind) [vector? `vector?] - (list? kind) [list? `list?] - (set? kind) [set? `set?] - :else [seqable? `seqable?]) cfns (fn [x] ;;returns a tuple of [init add complete] fns (cond @@ -1045,7 +1046,7 @@ (assoc ret i cv))) identity] - (c/and (map? x) (map? conform-into)) + (c/and (map? x) (c/or (c/and kind (not conform-into)) (map? conform-into))) [(if conform-keys empty identity) (fn [ret i v cv] (if (c/and (identical? v cv) (not conform-keys)) @@ -1061,7 +1062,7 @@ Spec (conform* [_ x] (cond - (coll-prob x kindfn kindform distinct count min-count max-count + (coll-prob x kind kind-form distinct count min-count max-count nil nil nil) ::invalid @@ -1089,7 +1090,7 @@ ::invalid)))) (unform* [_ x] x) (explain* [_ path via in x] - (c/or (coll-prob x kindfn kindform distinct count min-count max-count + (c/or (coll-prob x kind kind-form distinct count min-count max-count path via in) (apply concat ((if conform-all identity (partial take *coll-error-limit*)) @@ -1103,26 +1104,32 @@ (gen* [_ overrides path rmap] (if gfn (gfn) - (let [init (empty gen-into) - pgen (gensub pred overrides path rmap form)] - (gen/fmap - #(if (vector? init) % (into init %)) + (let [pgen (gensub pred overrides path rmap form)] + (gen/bind (cond - distinct - (if count - (gen/vector-distinct pgen {:num-elements count :max-tries 100}) - (gen/vector-distinct pgen {:min-elements (c/or min-count 0) - :max-elements (c/or max-count (max gen-max (c/* 2 (c/or min-count 0)))) - :max-tries 100})) - - count - (gen/vector pgen count) - - (c/or min-count max-count) - (gen/vector pgen (c/or min-count 0) (c/or max-count (max gen-max (c/* 2 (c/or min-count 0))))) - - :else - (gen/vector pgen 0 gen-max)))))) + gen-into (gen/return (empty gen-into)) + kind (gen/fmap #(if (empty? %) % (empty %)) + (gensub kind overrides path rmap form)) + :else (gen/return [])) + (fn [init] + (gen/fmap + #(if (vector? init) % (into init %)) + (cond + distinct + (if count + (gen/vector-distinct pgen {:num-elements count :max-tries 100}) + (gen/vector-distinct pgen {:min-elements (c/or min-count 0) + :max-elements (c/or max-count (max gen-max (c/* 2 (c/or min-count 0)))) + :max-tries 100})) + + count + (gen/vector pgen count) + + (c/or min-count max-count) + (gen/vector pgen (c/or min-count 0) (c/or max-count (max gen-max (c/* 2 (c/or min-count 0))))) + + :else + (gen/vector pgen 0 gen-max)))))))) (with-gen* [_ gfn] (every-impl form pred opts gfn)) (describe* [_] `(every ~form ~@(mapcat identity opts))))))) diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index b1de85d1..1ad805f1 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -35,8 +35,8 @@ m (s/map-of keyword? string?) mkeys (s/map-of (s/and keyword? (s/conformer name)) ::s/any) mkeys2 (s/map-of (s/and keyword? (s/conformer name)) ::s/any :conform-keys true) - s (s/coll-of (s/spec (s/cat :tag keyword? :val ::s/any)) :kind ()) - v (s/coll-of keyword? :kind []) + s (s/coll-of (s/spec (s/cat :tag keyword? :val ::s/any)) :kind list?) + v (s/coll-of keyword? :kind vector?) coll (s/coll-of keyword?) lrange (s/int-in 7 42) drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2) @@ -122,24 +122,24 @@ andre [:k] ::s/invalid '[{:pred even-count?, :val [:k]}] andre [:j :k] [:j :k] nil - m nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] + m nil ::s/invalid '[{:pred map?, :val nil}] m {} {} nil m {:a "b"} {:a "b"} nil - mkeys nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] + mkeys nil ::s/invalid '[{:pred map?, :val nil}] mkeys {} {} nil mkeys {:a 1 :b 2} {:a 1 :b 2} nil - mkeys2 nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] + mkeys2 nil ::s/invalid '[{:pred map?, :val nil}] mkeys2 {} {} nil mkeys2 {:a 1 :b 2} {"a" 1 "b" 2} nil s '([:a 1] [:b "2"]) '({:tag :a :val 1} {:tag :b :val "2"}) nil v [:a :b] [:a :b] nil - v '(:a :b) ::s/invalid '[{:pred clojure.core/vector? :val (:a :b)}] + v '(:a :b) ::s/invalid '[{:pred vector? :val (:a :b)}] - coll nil nil nil + coll nil ::s/invalid '[{:path [], :pred coll?, :val nil, :via [], :in []}] coll [] [] nil coll [:a] [:a] nil coll [:a :b] [:a :b] nil From c31a8eaf43ad84827f50b8e33cf519ee9f5f19ea Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 28 Jun 2016 16:07:52 -0500 Subject: [PATCH 089/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha8 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..b019f2df 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha8 http://clojure.org/ Clojure core environment and runtime library. From 36bebcd2ecd2a9a89e60c24c7cab533a8d4d6be2 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 28 Jun 2016 16:07:53 -0500 Subject: [PATCH 090/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index b019f2df..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha8 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From cd64b71ddb297c10e459537f818cf2cba9a743ec Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Thu, 30 Jun 2016 16:58:48 -0400 Subject: [PATCH 091/246] make StackTraceElement into data Signed-off-by: Rich Hickey --- src/clj/clojure/core_print.clj | 13 ++++++++++--- test/clojure/test_clojure/printer.clj | 22 +++------------------- 2 files changed, 13 insertions(+), 22 deletions(-) diff --git a/src/clj/clojure/core_print.clj b/src/clj/clojure/core_print.clj index 7c162348..bcbc77cb 100644 --- a/src/clj/clojure/core_print.clj +++ b/src/clj/clojure/core_print.clj @@ -440,14 +440,20 @@ (defmethod print-method StackTraceElement [^StackTraceElement o ^Writer w] (print-method [(symbol (.getClassName o)) (symbol (.getMethodName o)) (.getFileName o) (.getLineNumber o)] w)) +(defn StackTraceElement->vec + "Constructs a data representation for a StackTraceElement" + {:added "1.9"} + [^StackTraceElement o] + [(symbol (.getClassName o)) (symbol (.getMethodName o)) (.getFileName o) (.getLineNumber o)]) + (defn Throwable->map "Constructs a data representation for a Throwable." {:added "1.7"} [^Throwable o] (let [base (fn [^Throwable t] - (let [m {:type (class t) + (let [m {:type (symbol (.getName (class t))) :message (.getLocalizedMessage t) - :at (get (.getStackTrace t) 0)} + :at (StackTraceElement->vec (get (.getStackTrace t) 0))} data (ex-data t)] (if data (assoc m :data data) @@ -459,7 +465,8 @@ ^Throwable root (peek via) m {:cause (.getLocalizedMessage root) :via (vec (map base via)) - :trace (vec (.getStackTrace ^Throwable (or root o)))} + :trace (vec (map StackTraceElement->vec + (.getStackTrace ^Throwable (or root o))))} data (ex-data root)] (if data (assoc m :data data) diff --git a/test/clojure/test_clojure/printer.clj b/test/clojure/test_clojure/printer.clj index 30fd2215..aa75d105 100644 --- a/test/clojure/test_clojure/printer.clj +++ b/test/clojure/test_clojure/printer.clj @@ -119,27 +119,9 @@ #'var-with-meta "#'clojure.test-clojure.printer/var-with-meta" #'var-with-type "#'clojure.test-clojure.printer/var-with-type")) -(defn ^:private ednize-stack-trace-element - [^StackTraceElement ste] - [(symbol (.getClassName ste)) - (symbol (.getMethodName ste)) - (.getFileName ste) - (.getLineNumber ste)]) - -(defn ^:private ednize-throwable-data - [throwable-data] - (-> throwable-data - (update :via (fn [vias] - (map (fn [via] - (-> via - (update :type #(symbol (.getName %))) - (update :at ednize-stack-trace-element))) - vias))) - (update :trace #(map ednize-stack-trace-element %)))) - (deftest print-throwable (binding [*data-readers* {'error identity}] - (are [e] (= (-> e Throwable->map ednize-throwable-data) + (are [e] (= (-> e Throwable->map) (-> e pr-str read-string)) (Exception. "heyo") (Throwable. "I can a throwable" @@ -151,3 +133,5 @@ (Error. "less outer" (ex-info "the root" {:with "even" :more 'data}))))))) + + From 99d10ceb26a3078698a5b970a912ed88f95e688a Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Thu, 30 Jun 2016 16:59:06 -0400 Subject: [PATCH 092/246] report ::caller that caused instrument failre Signed-off-by: Rich Hickey --- src/clj/clojure/spec/test.clj | 59 ++++++++++++++++++++++++++++++++--- 1 file changed, 54 insertions(+), 5 deletions(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index c6eea49a..e4312af3 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -11,7 +11,8 @@ (:require [clojure.pprint :as pp] [clojure.spec :as s] - [clojure.spec.gen :as gen])) + [clojure.spec.gen :as gen] + [clojure.string :as str])) (in-ns 'clojure.spec.test.check) (in-ns 'clojure.spec.test) @@ -70,15 +71,63 @@ returns the set of all symbols naming vars in those nses." `(binding [*instrument-enabled* nil] ~@body)) +(defn- interpret-stack-trace-element + "Given the vector-of-syms form of a stacktrace element produced +by e.g. Throwable->map, returns a map form that adds some keys +guessing the original Clojure names. Returns a map with + + :class class name symbol from stack trace + :method method symbol from stack trace + :file filename from stack trace + :line line number from stack trace + :var-scope optional Clojure var symbol scoping fn def + :local-fn optional local Clojure symbol scoping fn def + +For non-Clojure fns, :scope and :local-fn will be absent." + [[cls method file line]] + (let [clojure? (contains? '#{invoke invokeStatic} method) + demunge #(clojure.lang.Compiler/demunge %) + degensym #(str/replace % #"--.*" "") + [ns-sym name-sym local] (when clojure? + (->> (str/split (str cls) #"\$" 3) + (map demunge)))] + (merge {:file file + :line line + :method method + :class cls} + (when (and ns-sym name-sym) + {:var-scope (symbol ns-sym name-sym)}) + (when local + {:local-fn (symbol (degensym local))})))) + +(defn- stacktrace-relevant-to-instrument + "Takes a coll of stack trace elements (as returned by +StackTraceElement->vec) and returns a coll of maps as per +interpret-stack-trace-element that are relevant to a +failure in instrument." + [elems] + (let [plumbing? (fn [{:keys [var-scope]}] + (contains? '#{clojure.spec.test/spec-checking-fn} var-scope))] + (sequence (comp (map StackTraceElement->vec) + (map interpret-stack-trace-element) + (filter :var-scope) + (drop-while plumbing?)) + elems))) + (defn- spec-checking-fn [v f fn-spec] (let [fn-spec (@#'s/maybe-spec fn-spec) conform! (fn [v role spec data args] (let [conformed (s/conform spec data)] (if (= ::s/invalid conformed) - (let [ed (assoc (s/explain-data* spec [role] [] [] data) - ::s/args args - ::s/failure :instrument-check-failed)] + (let [caller (->> (.getStackTrace (Thread/currentThread)) + stacktrace-relevant-to-instrument + first) + ed (merge (assoc (s/explain-data* spec [role] [] [] data) + ::s/args args + ::s/failure :instrument-check-failed) + (when caller + {::caller (dissoc caller :class :method)}))] (throw (ex-info (str "Call to " v " did not conform to spec:\n" (with-out-str (s/explain-out ed))) ed))) @@ -252,7 +301,7 @@ with explain-data under ::check-call." (defn- check-fn [f specs {gen :gen opts ::stc/opts}] - (let [{:keys [num-tests] :or {num-tests 100}} opts + (let [{:keys [num-tests] :or {num-tests 1000}} opts g (try (s/gen (:args specs) gen) (catch Throwable t t))] (if (throwable? g) {:result g} From 0f2e5e575b26a7937d3b94e3c4270137d247690a Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 1 Jul 2016 12:18:24 -0400 Subject: [PATCH 093/246] merge, not flow, in merge conform/unform --- src/clj/clojure/spec.clj | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 32bcd3db..f7cf9db9 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -986,8 +986,11 @@ [forms preds gfn] (reify Spec - (conform* [_ x] (and-preds x preds forms)) - (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) + (conform* [_ x] (let [ms (map #(dt %1 x %2) preds forms)] + (if (some #{::invalid} ms) + ::invalid + (apply c/merge ms)))) + (unform* [_ x] (apply c/merge (map #(unform % x) (reverse preds)))) (explain* [_ path via in x] (apply concat (map #(explain-1 %1 %2 path via in x) From 12e0e417285f81be67d2de6f3141c18b8eccc22d Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Sat, 2 Jul 2016 12:00:21 -0400 Subject: [PATCH 094/246] spec assert Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 80 +++++++++++++++++++++++++++++++----- src/jvm/clojure/lang/RT.java | 11 +++++ 2 files changed, 81 insertions(+), 10 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index f7cf9db9..6139ee41 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -7,7 +7,7 @@ ; You must not remove this notice, or any other, from this software. (ns clojure.spec - (:refer-clojure :exclude [+ * and or cat def keys merge]) + (:refer-clojure :exclude [+ * and assert or cat def keys merge]) (:require [clojure.walk :as walk] [clojure.spec.gen :as gen] [clojure.string :as str])) @@ -267,7 +267,7 @@ (defn ^:skip-wiki def-impl "Do not call this directly, use 'def'" [k form spec] - (assert (c/and (named? k) (namespace k)) "k must be namespaced keyword or resolvable symbol") + (c/assert (c/and (named? k) (namespace k)) "k must be namespaced keyword or resolvable symbol") (let [spec (if (c/or (spec? spec) (regex? spec) (get @registry-ref spec)) spec (spec-impl form spec nil nil))] @@ -382,8 +382,8 @@ (let [unk #(-> % name keyword) req-keys (filterv keyword? (flatten req)) req-un-specs (filterv keyword? (flatten req-un)) - _ (assert (every? #(c/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un)) - "all keys must be namespace-qualified keywords") + _ (c/assert (every? #(c/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un)) + "all keys must be namespace-qualified keywords") req-specs (into req-keys req-un-specs) req-keys (into req-keys (map unk req-un-specs)) opt-keys (into (vec opt) (map unk opt-un)) @@ -424,7 +424,7 @@ keys (mapv first pairs) pred-forms (mapv second pairs) pf (mapv res pred-forms)] - (assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords") + (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords") `(or-spec-impl ~keys '~pf ~pred-forms nil))) (defmacro and @@ -547,7 +547,7 @@ keys (mapv first pairs) pred-forms (mapv second pairs) pf (mapv res pred-forms)] - (assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords") + (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords") `(alt-impl ~keys ~pred-forms '~pf))) (defmacro cat @@ -563,7 +563,7 @@ pred-forms (mapv second pairs) pf (mapv res pred-forms)] ;;(prn key-pred-forms) - (assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords") + (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords") `(cat-impl ~keys ~pred-forms '~pf))) (defmacro & @@ -607,7 +607,7 @@ where each element conforms to the corresponding pred. Each element will be referred to in paths using its ordinal." [& preds] - (assert (not (empty? preds))) + (c/assert (not (empty? preds))) `(tuple-impl '~(mapv res preds) ~(vec preds))) (defn- macroexpand-check @@ -869,7 +869,7 @@ (recur (if (identical? cv v) ret (assoc ret i cv)) (inc i)))))))) (unform* [_ x] - (assert (c/and (vector? x) + (c/assert (c/and (vector? x) (= (count x) (count preds)))) (loop [ret x, i 0] (if (= i (count x)) @@ -1535,7 +1535,7 @@ (gfn) (gen/return (fn [& args] - (assert (valid? argspec args) (with-out-str (explain argspec args))) + (c/assert (valid? argspec args) (with-out-str (explain argspec args))) (gen/generate (gen retspec overrides)))))) (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn)) (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform))))) @@ -1634,3 +1634,63 @@ ~@(when max `[#(<= % ~max)]) ~@(when min `[#(<= ~min %)])) :gen #(gen/double* ~m))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; assert ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defonce + ^{:dynamic true + :doc "If true, compiler will enable spec asserts, which are then +subject to runtime control via check-asserts? If false, compiler +will eliminate all spec assert overhead. See 'assert'. + +Initially set to boolean value of clojure.spec.compile-asserts +system property. Defaults to true."} + *compile-asserts* + (not= "false" (System/getProperty "clojure.spec.compile-asserts"))) + +(defn check-asserts? + "Returns the value set by check-asserts." + [] + clojure.lang.RT/checkSpecAsserts) + +(defn check-asserts + "Checktime enable/disable of spec asserts that have been compiled +with '*compile-asserts*' true. See 'assert'. + +Initially set to boolean value of clojure.spec.check-asserts +system property. Defaults to false." + [flag] + (set! (. clojure.lang.RT checkSpecAsserts) flag)) + +(defn assert* + "Do not call this directly, use 'assert'." + [spec x] + (if (valid? spec x) + x + (let [ed (c/merge (assoc (explain-data* spec [] [] [] x) + ::failure :assertion-failed))] + (throw (ex-info + (str "Spec assertion failed\n" (with-out-str (explain-out ed))) + ed))))) + +(defmacro assert + "spec-checking assert expression. Returns x if x is valid? according +to spec, else throws an ex-info with explain-data plus ::failure of +:assertion-failed. + +Can be disabled at either compile time or runtime: + +If *compile-asserts* is false at compile time, compiles to x. Defaults +to value of 'clojure.spec.compile-asserts' system property, or true if +not set. + +If (check-asserts?) is false at runtime, always returns x. Defaults to +value of 'clojure.spec.check-asserts' system property, or false if not +set. You can toggle check-asserts? with (check-asserts bool)." + [spec x] + (if *compile-asserts* + `(if clojure.lang.RT/checkSpecAsserts + (assert* ~spec ~x) + ~x) + x)) + + diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index 0682c805..f4c48077 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -169,6 +169,14 @@ public class RT{ // single instance of UTF-8 Charset, so as to avoid catching UnsupportedCharsetExceptions everywhere static public Charset UTF8 = Charset.forName("UTF-8"); +static boolean readTrueFalseDefault(String s, boolean def){ + if("true".equals(s)) + return Boolean.TRUE; + else if("false".equals(s)) + return Boolean.FALSE; + return def; +} + static Object readTrueFalseUnknown(String s){ if(s.equals("true")) return Boolean.TRUE; @@ -298,6 +306,9 @@ static public void addURL(Object url) throws MalformedURLException{ throw new IllegalAccessError("Context classloader is not a DynamicClassLoader"); } +public static boolean checkSpecAsserts = readTrueFalseDefault( + System.getProperty("clojure.spec.check-asserts"), false); + static{ Keyword arglistskw = Keyword.intern(null, "arglists"); Symbol namesym = Symbol.intern("name"); From 2ecf02d54a4e5fad94f833a36fa4656ce4671afe Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Mon, 4 Jul 2016 09:15:58 -0400 Subject: [PATCH 095/246] spec improvements: - defonce instrumented-vars - s/test/check - better keyword names for check results Signed-off-by: Rich Hickey --- src/clj/clojure/spec/test.clj | 110 +++++++++++++++++----------------- 1 file changed, 55 insertions(+), 55 deletions(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index e4312af3..5fc64cc6 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -125,7 +125,7 @@ failure in instrument." first) ed (merge (assoc (s/explain-data* spec [role] [] [] data) ::s/args args - ::s/failure :instrument-check-failed) + ::s/failure :instrument) (when caller {::caller (dissoc caller :class :method)}))] (throw (ex-info @@ -141,14 +141,12 @@ failure in instrument." (.applyTo ^clojure.lang.IFn f args))) (.applyTo ^clojure.lang.IFn f args))))) -(defn- no-fn-spec +(defn- no-fspec [v spec] (ex-info (str "Fn at " v " is not spec'ed.") - {:var v :spec spec ::s/failure :no-fn-spec})) + {:var v :spec spec ::s/failure :no-fspec})) -(def ^:private instrumented-vars - "Map for instrumented vars to :raw/:wrapped fns" - (atom {})) +(defonce ^:private instrumented-vars (atom {})) (defn- instrument-choose-fn "Helper for instrument." @@ -170,7 +168,7 @@ failure in instrument." current @v to-wrap (if (= wrapped current) raw current) ospec (or (instrument-choose-spec spec s opts) - (throw (no-fn-spec v spec))) + (throw (no-fspec v spec))) ofn (instrument-choose-fn to-wrap ospec s opts) checked (spec-checking-fn v ofn ospec)] (alter-var-root v (constantly checked)) @@ -272,15 +270,15 @@ Returns a collection of syms naming the vars unstrumented." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defn- explain-test +(defn- explain-check [args spec v role] (ex-info - "Specification-based test failed" + "Specification-based check failed" (when-not (s/valid? spec v nil) (assoc (s/explain-data* spec [role] [] [] v) ::args args ::val v - ::s/failure :test-failed)))) + ::s/failure :check-failed)))) (defn- check-call "Returns true if call passes specs, otherwise *returns* an exception @@ -288,18 +286,18 @@ with explain-data under ::check-call." [f specs args] (let [cargs (when (:args specs) (s/conform (:args specs) args))] (if (= cargs ::s/invalid) - (explain-test args (:args specs) args :args) + (explain-check args (:args specs) args :args) (let [ret (apply f args) cret (when (:ret specs) (s/conform (:ret specs) ret))] (if (= cret ::s/invalid) - (explain-test args (:ret specs) ret :ret) + (explain-check args (:ret specs) ret :ret) (if (and (:args specs) (:ret specs) (:fn specs)) (if (s/valid? (:fn specs) {:args cargs :ret cret}) true - (explain-test args (:fn specs) {:args cargs :ret cret} :fn)) + (explain-check args (:fn specs) {:args cargs :ret cret} :fn)) true)))))) -(defn- check-fn +(defn- quick-check [f specs {gen :gen opts ::stc/opts}] (let [{:keys [num-tests] :or {num-tests 1000}} opts g (try (s/gen (:args specs) gen) (catch Throwable t t))] @@ -312,19 +310,19 @@ with explain-data under ::check-call." [x] (::s/failure (ex-data x))) -(defn- make-test-result +(defn- make-check-result "Builds spec result map." - [test-sym spec test-check-ret] + [check-sym spec test-check-ret] (merge {:spec spec ::stc/ret test-check-ret} - (when test-sym - {:sym test-sym}) + (when check-sym + {:sym check-sym}) (when-let [result (-> test-check-ret :result)] {:result result}) (when-let [shrunk (-> test-check-ret :shrunk)] {:result (:result shrunk)}))) -(defn- test-1 +(defn- check-1 [{:keys [s f v spec]} {:keys [result-callback] :as opts}] (when v (unstrument s)) (try @@ -334,46 +332,46 @@ with explain-data under ::check-call." {::s/failure :no-fn :sym s :spec spec} (:args spec) - (let [tcret (check-fn f spec opts)] - (make-test-result s spec tcret)) + (let [tcret (quick-check f spec opts)] + (make-check-result s spec tcret)) :default {::s/failure :no-args-spec :sym s :spec spec})) (finally (when v (instrument s))))) -(defn- sym->test-map +(defn- sym->check-map [s] (let [v (resolve s)] {:s s :v v :spec (when v (s/get-spec v))})) -(defn- validate-test-opts +(defn- validate-check-opts [opts] - (assert (every? ident? (keys (:gen opts))) "test :gen expects ident keys")) + (assert (every? ident? (keys (:gen opts))) "check :gen expects ident keys")) -(defn test-fn +(defn check-fn "Runs generative tests for fn f using spec and opts. See -'test' for options and return." - ([f spec] (test-fn f spec nil)) +'check' for options and return." + ([f spec] (check-fn f spec nil)) ([f spec opts] - (validate-test-opts opts) - (test-1 {:f f :spec spec} opts))) + (validate-check-opts opts) + (check-1 {:f f :spec spec} opts))) (defn testable-syms - "Given an opts map as per test, returns the set of syms that + "Given an opts map as per check, returns the set of syms that can be tested." ([] (testable-syms nil)) ([opts] - (validate-test-opts opts) + (validate-check-opts opts) (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) (keys (:spec opts))]))) -(defn test +(defn check "Run generative tests for spec conformance on vars named by sym-or-syms, a symbol or collection of symbols. If sym-or-syms -is not specified, test all testable vars. +is not specified, check all testable vars. The opts map includes the following optional keys, where stc aliases clojure.spec.test.check: @@ -385,39 +383,41 @@ The ::stc/opts include :num-tests in addition to the keys documented by test.check. Generator overrides are passed to spec/gen when generating function args. -Returns a lazy sequence of test result maps with the following +Returns a lazy sequence of check result maps with the following keys :spec the spec tested -:type the type of the test result +:type the type of the check result :sym optional symbol naming the var tested -:result optional test result +:result optional check result ::stc/ret optional value returned by test.check/quick-check Values for the :result key can be one of -true passing test -exception code under test threw +true passing check +exception code under check threw map with explain-data under :clojure.spec/problems Values for the :type key can be one of -:pass test passed -:fail test failed -:error test threw -:no-argspec no :args in fn-spec -:no-gen unable to generate :args -:no-fn unable to resolve fn to test +:check-passed all checked fn returns conformed +:check-failed at least one checked return did not conform +:check-threw checked fn threw an exception +:no-args-spec no :args spec provided +:no-fn no fn provided +:no-fspec no fspec provided +:no-gen unable to generate :args +:instrument invalid args detected by instrument " - ([] (test (testable-syms))) - ([sym-or-syms] (test sym-or-syms nil)) + ([] (check (testable-syms))) + ([sym-or-syms] (check sym-or-syms nil)) ([sym-or-syms opts] (->> (collectionize sym-or-syms) (filter (testable-syms opts)) (pmap - #(test-1 (sym->test-map %) opts))))) + #(check-1 (sym->check-map %) opts))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; test reporting ;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting ;;;;;;;;;;;;;;;;;;;;;;;; (defn- unwrap-failure [x] @@ -429,12 +429,12 @@ Values for the :type key can be one of [ret] (let [result (:result ret)] (cond - (true? result) :test-passed + (true? result) :check-passed (failure-type result) (failure-type result) - :default :test-threw))) + :default :check-threw))) (defn abbrev-result - "Given a test result, returns an abbreviated version + "Given a check result, returns an abbreviated version suitable for summary use." [x] (if (true? (:result x)) @@ -444,13 +444,13 @@ suitable for summary use." (update :result unwrap-failure)))) (defn summarize-results - "Given a collection of test-results, e.g. from 'test', pretty + "Given a collection of check-results, e.g. from 'check', pretty prints the summary-result (default abbrev-result) of each. Returns a map with :total, the total number of results, plus a key with a count for each different :type of result." - ([test-results] (summarize-results test-results abbrev-result)) - ([test-results summary-result] + ([check-results] (summarize-results check-results abbrev-result)) + ([check-results summary-result] (reduce (fn [summary result] (pp/pprint (summary-result result)) @@ -458,7 +458,7 @@ key with a count for each different :type of result." (update :total inc) (update (result-type result) (fnil inc 0)))) {:total 0} - test-results))) + check-results))) From 12c35e20ba806851645df5c6f794ca19c587c2b8 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Mon, 4 Jul 2016 23:13:28 -0400 Subject: [PATCH 096/246] spec.test bugfixes: - test should only re-instrument what it unstrumented - docstring fixes - give all check-1 results same shape Signed-off-by: Rich Hickey --- src/clj/clojure/spec/test.clj | 79 +++++++++++++++++------------------ 1 file changed, 39 insertions(+), 40 deletions(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index 5fc64cc6..68141816 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -179,11 +179,11 @@ failure in instrument." [s] (when-let [v (resolve s)] (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] + (swap! instrumented-vars dissoc v) (let [current @v] (when (= wrapped current) - (alter-var-root v (constantly raw)))) - (swap! instrumented-vars dissoc v)) - (->sym v))) + (alter-var-root v (constantly raw)) + (->sym v)))))) (defn- opt-syms "Returns set of symbols referenced by 'instrument' opts map" @@ -282,7 +282,7 @@ Returns a collection of syms naming the vars unstrumented." (defn- check-call "Returns true if call passes specs, otherwise *returns* an exception -with explain-data under ::check-call." +with explain-data + ::s/failure." [f specs args] (let [cargs (when (:args specs) (s/conform (:args specs) args))] (if (= cargs ::s/invalid) @@ -306,10 +306,6 @@ with explain-data under ::check-call." (let [prop (gen/for-all* [g] #(check-call f specs %))] (apply gen/quick-check num-tests prop (mapcat identity opts)))))) -(defn- failure-type - [x] - (::s/failure (ex-data x))) - (defn- make-check-result "Builds spec result map." [check-sym spec test-check-ret] @@ -318,27 +314,29 @@ with explain-data under ::check-call." (when check-sym {:sym check-sym}) (when-let [result (-> test-check-ret :result)] - {:result result}) + (when-not (true? result) {:failure result})) (when-let [shrunk (-> test-check-ret :shrunk)] - {:result (:result shrunk)}))) + {:failure (:result shrunk)}))) (defn- check-1 - [{:keys [s f v spec]} {:keys [result-callback] :as opts}] - (when v (unstrument s)) - (try - (let [f (or f (when v @v))] + [{:keys [s f v spec] :as foo} {:keys [result-callback] :as opts}] + (let [f (or v (when v @v)) + re-inst? (and v (seq (unstrument s)) true)] + (try (cond (nil? f) - {::s/failure :no-fn :sym s :spec spec} + {:failure (ex-info "No fn to spec" {::s/failure :no-fn}) + :sym s :spec spec} (:args spec) (let [tcret (quick-check f spec opts)] (make-check-result s spec tcret)) :default - {::s/failure :no-args-spec :sym s :spec spec})) - (finally - (when v (instrument s))))) + {:failure (ex-info "No :args spec" {::s/failure :no-args-spec}) + :sym s :spec spec}) + (finally + (when re-inst? (instrument s)))))) (defn- sym->check-map [s] @@ -359,10 +357,10 @@ with explain-data under ::check-call." (validate-check-opts opts) (check-1 {:f f :spec spec} opts))) -(defn testable-syms +(defn checkable-syms "Given an opts map as per check, returns the set of syms that can be tested." - ([] (testable-syms nil)) + ([] (checkable-syms nil)) ([opts] (validate-check-opts opts) (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) @@ -371,7 +369,7 @@ can be tested." (defn check "Run generative tests for spec conformance on vars named by sym-or-syms, a symbol or collection of symbols. If sym-or-syms -is not specified, check all testable vars. +is not specified, check all checkable vars. The opts map includes the following optional keys, where stc aliases clojure.spec.test.check: @@ -387,38 +385,34 @@ Returns a lazy sequence of check result maps with the following keys :spec the spec tested -:type the type of the check result :sym optional symbol naming the var tested -:result optional check result +:failure optional test failure ::stc/ret optional value returned by test.check/quick-check -Values for the :result key can be one of - -true passing check -exception code under check threw -map with explain-data under :clojure.spec/problems +The value for :failure can be any exception. Exceptions thrown by +spec itself will have an ::s/failure value in ex-data: -Values for the :type key can be one of - -:check-passed all checked fn returns conformed :check-failed at least one checked return did not conform -:check-threw checked fn threw an exception :no-args-spec no :args spec provided :no-fn no fn provided :no-fspec no fspec provided :no-gen unable to generate :args :instrument invalid args detected by instrument " - ([] (check (testable-syms))) + ([] (check (checkable-syms))) ([sym-or-syms] (check sym-or-syms nil)) ([sym-or-syms opts] (->> (collectionize sym-or-syms) - (filter (testable-syms opts)) + (filter (checkable-syms opts)) (pmap #(check-1 (sym->check-map %) opts))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting ;;;;;;;;;;;;;;;;;;;;;;;; +(defn- failure-type + [x] + (::s/failure (ex-data x))) + (defn- unwrap-failure [x] (if (failure-type x) @@ -426,22 +420,27 @@ Values for the :type key can be one of x)) (defn- result-type + "Returns the type of the check result. This can be any of the +::s/failure keywords documented in 'check', or: + + :check-passed all checked fn returns conformed + :check-threw checked fn threw an exception" [ret] - (let [result (:result ret)] + (let [failure (:failure ret)] (cond - (true? result) :check-passed - (failure-type result) (failure-type result) + (nil? failure) :check-passed + (failure-type failure) (failure-type failure) :default :check-threw))) (defn abbrev-result "Given a check result, returns an abbreviated version suitable for summary use." [x] - (if (true? (:result x)) - (dissoc x :spec ::stc/ret :result) + (if (:failure x) (-> (dissoc x ::stc/ret) (update :spec s/describe) - (update :result unwrap-failure)))) + (update :failure unwrap-failure)) + (dissoc x :spec ::stc/ret))) (defn summarize-results "Given a collection of check-results, e.g. from 'check', pretty From 174347ae766b5a2089f8a9b5780d00c5fea62b16 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 5 Jul 2016 10:32:00 -0500 Subject: [PATCH 097/246] Fix typos and clean up Signed-off-by: Stuart Halloway Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 2 +- src/clj/clojure/spec/test.clj | 6 +++--- src/jvm/clojure/lang/RT.java | 11 +---------- 3 files changed, 5 insertions(+), 14 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 6139ee41..0a9f7077 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1653,7 +1653,7 @@ system property. Defaults to true."} clojure.lang.RT/checkSpecAsserts) (defn check-asserts - "Checktime enable/disable of spec asserts that have been compiled + "Enable or disable spec asserts that have been compiled with '*compile-asserts*' true. See 'assert'. Initially set to boolean value of clojure.spec.check-asserts diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index 68141816..ac080a6b 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -319,8 +319,8 @@ with explain-data + ::s/failure." {:failure (:result shrunk)}))) (defn- check-1 - [{:keys [s f v spec] :as foo} {:keys [result-callback] :as opts}] - (let [f (or v (when v @v)) + [{:keys [s f v spec]} opts] + (let [f (or f (when v @v)) re-inst? (and v (seq (unstrument s)) true)] (try (cond @@ -359,7 +359,7 @@ with explain-data + ::s/failure." (defn checkable-syms "Given an opts map as per check, returns the set of syms that -can be tested." +can be checked." ([] (checkable-syms nil)) ([opts] (validate-check-opts opts) diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index f4c48077..4a6d0a57 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -169,14 +169,6 @@ public class RT{ // single instance of UTF-8 Charset, so as to avoid catching UnsupportedCharsetExceptions everywhere static public Charset UTF8 = Charset.forName("UTF-8"); -static boolean readTrueFalseDefault(String s, boolean def){ - if("true".equals(s)) - return Boolean.TRUE; - else if("false".equals(s)) - return Boolean.FALSE; - return def; -} - static Object readTrueFalseUnknown(String s){ if(s.equals("true")) return Boolean.TRUE; @@ -306,8 +298,7 @@ static public void addURL(Object url) throws MalformedURLException{ throw new IllegalAccessError("Context classloader is not a DynamicClassLoader"); } -public static boolean checkSpecAsserts = readTrueFalseDefault( - System.getProperty("clojure.spec.check-asserts"), false); +public static boolean checkSpecAsserts = Boolean.getBoolean("clojure.spec.check-asserts"); static{ Keyword arglistskw = Keyword.intern(null, "arglists"); From d8aad06ba91827bf7373ac3f3d469817e6331322 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Tue, 5 Jul 2016 12:30:39 -0400 Subject: [PATCH 098/246] =?UTF-8?q?don=E2=80=99t=20instrument=20macros,=20?= =?UTF-8?q?use=20uninstrumented=20fn=20under=20test?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Rich Hickey --- src/clj/clojure/spec/test.clj | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index ac080a6b..f6cea539 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -163,17 +163,18 @@ failure in instrument." (defn- instrument-1 [s opts] (when-let [v (resolve s)] - (let [spec (s/get-spec v) - {:keys [raw wrapped]} (get @instrumented-vars v) - current @v - to-wrap (if (= wrapped current) raw current) - ospec (or (instrument-choose-spec spec s opts) + (when-not (-> v meta :macro) + (let [spec (s/get-spec v) + {:keys [raw wrapped]} (get @instrumented-vars v) + current @v + to-wrap (if (= wrapped current) raw current) + ospec (or (instrument-choose-spec spec s opts) (throw (no-fspec v spec))) - ofn (instrument-choose-fn to-wrap ospec s opts) - checked (spec-checking-fn v ofn ospec)] - (alter-var-root v (constantly checked)) - (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked})) - (->sym v))) + ofn (instrument-choose-fn to-wrap ospec s opts) + checked (spec-checking-fn v ofn ospec)] + (alter-var-root v (constantly checked)) + (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked}) + (->sym v))))) (defn- unstrument-1 [s] @@ -320,8 +321,8 @@ with explain-data + ::s/failure." (defn- check-1 [{:keys [s f v spec]} opts] - (let [f (or f (when v @v)) - re-inst? (and v (seq (unstrument s)) true)] + (let [re-inst? (and v (seq (unstrument s)) true) + f (or f (when v @v))] (try (cond (nil? f) From 74a3dce56c8ae76f3bb73dbd9398f6ccb25159da Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 5 Jul 2016 14:21:00 -0500 Subject: [PATCH 099/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha9 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..11047640 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha9 http://clojure.org/ Clojure core environment and runtime library. From 87b4023a9fabe7a169ea8c99c8ae2bd586b10b6d Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 5 Jul 2016 14:21:00 -0500 Subject: [PATCH 100/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 11047640..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha9 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From 0929d1d13d036973a03db78a5a03f29d19c9e4b2 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 8 Jul 2016 11:30:54 -0400 Subject: [PATCH 101/246] add any? to core, remove ::spec/any, gens for any? and some? --- src/clj/clojure/core.clj | 6 ++++++ src/clj/clojure/spec.clj | 3 +-- src/clj/clojure/spec/gen.clj | 4 +++- test/clojure/test_clojure/spec.clj | 6 +++--- 4 files changed, 13 insertions(+), 6 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index cd070d91..d454eb10 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -535,6 +535,12 @@ :static true} [x] (not (nil? x))) +(defn any? + "Returns true given any argument." + {:tag Boolean + :added "1.9"} + [x] true) + (defn str "With no args, returns the empty string. With one arg x, returns x.toString(). (str nil) returns the empty string. With more than diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 0a9f7077..cee3f8e8 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1541,7 +1541,6 @@ (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(clojure.spec/def ::any (spec (constantly true) :gen gen/any)) (clojure.spec/def ::kvs->map (conformer #(zipmap (map ::k %) (map ::v %)) #(map (fn [[k v]] {::k k ::v v}) %))) (defmacro keys* @@ -1559,7 +1558,7 @@ user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99]) {:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}" [& kspecs] - `(clojure.spec/& (* (cat ::k keyword? ::v ::any)) ::kvs->map (keys ~@kspecs))) + `(clojure.spec/& (* (cat ::k keyword? ::v any?)) ::kvs->map (keys ~@kspecs))) (defmacro nilable "returns a spec that accepts nil and values satisfiying pred" diff --git a/src/clj/clojure/spec/gen.clj b/src/clj/clojure/spec/gen.clj index 194721d9..8f1c4e38 100644 --- a/src/clj/clojure/spec/gen.clj +++ b/src/clj/clojure/spec/gen.clj @@ -129,7 +129,9 @@ gens, each of which should generate something sequential." gen-builtins (c/delay (let [simple (simple-type-printable)] - {number? (one-of [(large-integer) (double)]) + {any? (one-of [(return nil) (any-printable)]) + some? (such-that some? (any-printable)) + number? (one-of [(large-integer) (double)]) integer? (large-integer) int? (large-integer) pos-int? (large-integer* {:min 1}) diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 1ad805f1..c388693b 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -33,9 +33,9 @@ opt (s/? keyword?) andre (s/& (s/* keyword?) even-count?) m (s/map-of keyword? string?) - mkeys (s/map-of (s/and keyword? (s/conformer name)) ::s/any) - mkeys2 (s/map-of (s/and keyword? (s/conformer name)) ::s/any :conform-keys true) - s (s/coll-of (s/spec (s/cat :tag keyword? :val ::s/any)) :kind list?) + mkeys (s/map-of (s/and keyword? (s/conformer name)) any?) + mkeys2 (s/map-of (s/and keyword? (s/conformer name)) any? :conform-keys true) + s (s/coll-of (s/spec (s/cat :tag keyword? :val any?)) :kind list?) v (s/coll-of keyword? :kind vector?) coll (s/coll-of keyword?) lrange (s/int-in 7 42) From 357df34ef0c38cce4d0aa19cdf3fa6b2f9bb3c05 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 8 Jul 2016 12:04:47 -0400 Subject: [PATCH 102/246] gen overrides should be no-arg fns --- src/clj/clojure/spec.clj | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index cee3f8e8..a4f205b0 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -219,8 +219,9 @@ [spec overrides path rmap form] ;;(prn {:spec spec :over overrides :path path :form form}) (let [spec (specize spec)] - (if-let [g (c/or (get overrides (c/or (spec-name spec) spec)) - (get overrides path) + (if-let [g (c/or (when-let [gfn (c/or (get overrides (c/or (spec-name spec) spec)) + (get overrides path))] + (gfn)) (gen* spec overrides path rmap))] (gen/such-that #(valid? spec %) g 100) (let [abbr (abbrev form)] @@ -230,8 +231,8 @@ (defn gen "Given a spec, returns the generator for it, or throws if none can be constructed. Optionally an overrides map can be provided which - should map spec names or paths (vectors of keywords) to - generators. These will be used instead of the generators at those + should map spec names or paths (vectors of keywords) to no-arg + generator-creating fns. These will be used instead of the generators at those names/paths. Note that parent generator (in the spec or overrides map) will supersede those of any subtrees. A generator for a regex op must always return a sequential collection (i.e. a generator for From 1e236448104fc8a0fc51e26eae7cdb7e650b7ae9 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 8 Jul 2016 13:39:01 -0400 Subject: [PATCH 103/246] with-gen now works on regexes w/o lifting to specs, used by keys* so it can now gen --- src/clj/clojure/spec.clj | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index a4f205b0..50afde97 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -156,7 +156,10 @@ (defn with-gen "Takes a spec and a no-arg, generator-returning fn and returns a version of that spec that uses that generator" [spec gen-fn] - (with-gen* (specize spec) gen-fn)) + (let [spec (reg-resolve spec)] + (if (regex? spec) + (assoc spec ::gfn gen-fn) + (with-gen* (specize spec) gen-fn)))) (defn explain-data* [spec path via in x] (let [probs (explain* (specize spec) path via in x)] @@ -1384,7 +1387,7 @@ (defn- re-gen [p overrides path rmap f] ;;(prn {:op op :ks ks :forms forms}) - (let [{:keys [::op ps ks p1 p2 forms splice ret id] :as p} (reg-resolve! p) + (let [{:keys [::op ps ks p1 p2 forms splice ret id ::gfn] :as p} (reg-resolve! p) rmap (if id (inck rmap id) rmap) ggens (fn [ps ks forms] (let [gen (fn [p k f] @@ -1398,6 +1401,8 @@ (case op (:accept nil) (gen/fmap vector g) g)) + (when gfn + (gfn)) (when p (case op ::accept (if (= ret ::nil) @@ -1559,7 +1564,9 @@ user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99]) {:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}" [& kspecs] - `(clojure.spec/& (* (cat ::k keyword? ::v any?)) ::kvs->map (keys ~@kspecs))) + `(let [mspec# (keys ~@kspecs)] + (with-gen (clojure.spec/& (* (cat ::k keyword? ::v any?)) ::kvs->map mspec#) + (fn [] (gen/fmap (fn [m#] (apply concat m#)) (gen mspec#)))))) (defmacro nilable "returns a spec that accepts nil and values satisfiying pred" From 88fc01f43b5bb09068e01d967c15b4528614e058 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Wed, 6 Jul 2016 09:54:56 -0500 Subject: [PATCH 104/246] CLJ-1977 Fix Throwable->map conversion when stack has been omitted Signed-off-by: Rich Hickey --- src/clj/clojure/core_print.clj | 21 +++++++++++---------- test/clojure/test_clojure/errors.clj | 14 +++++++++++++- 2 files changed, 24 insertions(+), 11 deletions(-) diff --git a/src/clj/clojure/core_print.clj b/src/clj/clojure/core_print.clj index bcbc77cb..6dd99b51 100644 --- a/src/clj/clojure/core_print.clj +++ b/src/clj/clojure/core_print.clj @@ -451,13 +451,13 @@ {:added "1.7"} [^Throwable o] (let [base (fn [^Throwable t] - (let [m {:type (symbol (.getName (class t))) - :message (.getLocalizedMessage t) - :at (StackTraceElement->vec (get (.getStackTrace t) 0))} - data (ex-data t)] - (if data - (assoc m :data data) - m))) + (merge {:type (symbol (.getName (class t))) + :message (.getLocalizedMessage t)} + (when-let [ed (ex-data t)] + {:data ed}) + (let [st (.getStackTrace t)] + (when (pos? (alength st)) + {:at (StackTraceElement->vec (aget st 0))})))) via (loop [via [], ^Throwable t o] (if t (recur (conj via t) (.getCause t)) @@ -482,9 +482,10 @@ (when-let [data (:data %)] (.write w "\n :data ") (print-method data w)) - (.write w "\n :at ") - (print-method (:at %) w) - (.write w "}"))] + (when-let [at (:at %)] + (.write w "\n :at ") + (print-method (:at %) w)) + (.write w "}"))] (print-method cause w) (when data (.write w "\n :data ") diff --git a/test/clojure/test_clojure/errors.clj b/test/clojure/test_clojure/errors.clj index 9131f6a5..16b937a3 100644 --- a/test/clojure/test_clojure/errors.clj +++ b/test/clojure/test_clojure/errors.clj @@ -79,7 +79,19 @@ data-top-level :data} (Throwable->map (ex-info "ex-info" {:some "data"}))] - (is (= data data-top-level {:some "data"}))))) + (is (= data data-top-level {:some "data"})))) + (testing "nil stack handled" + (let [t (Throwable. "abc")] + ;; simulate what can happen when Java omits stack traces + (.setStackTrace t (into-array StackTraceElement [])) + (let [{:keys [cause via trace]} (Throwable->map t)] + (is (= cause "abc")) + (is (= trace [])) + + ;; fail if printing throws an exception + (try + (with-out-str (pr t)) + (catch Throwable t (is nil))))))) (deftest ex-info-disallows-nil-data (is (thrown? IllegalArgumentException (ex-info "message" nil))) From f374423053b75b7b484ffbc8b49b2ede9d92e406 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Mon, 11 Jul 2016 08:55:54 -0500 Subject: [PATCH 105/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha10 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..5c238025 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha10 http://clojure.org/ Clojure core environment and runtime library. From be9f054b61d8f99c5158f9823b31651835fc1d51 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Mon, 11 Jul 2016 08:55:54 -0500 Subject: [PATCH 106/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 5c238025..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha10 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From 8c6803ed0b645f23f213f8e57b749a4e8917cd3f Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 12 Jul 2016 17:43:01 -0400 Subject: [PATCH 107/246] fix regexes to use new gen overrides method --- src/clj/clojure/spec.clj | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 50afde97..b6b422a8 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1387,7 +1387,8 @@ (defn- re-gen [p overrides path rmap f] ;;(prn {:op op :ks ks :forms forms}) - (let [{:keys [::op ps ks p1 p2 forms splice ret id ::gfn] :as p} (reg-resolve! p) + (let [origp p + {:keys [::op ps ks p1 p2 forms splice ret id ::gfn] :as p} (reg-resolve! p) rmap (if id (inck rmap id) rmap) ggens (fn [ps ks forms] (let [gen (fn [p k f] @@ -1397,10 +1398,12 @@ (gen/delay (re-gen p overrides (if k (conj path k) path) rmap (c/or f p))) (re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))))] (map gen ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)))))] - (c/or (when-let [g (get overrides path)] + (c/or (when-let [gfn (c/or (get overrides (spec-name origp)) + (get overrides (spec-name p) ) + (get overrides path))] (case op - (:accept nil) (gen/fmap vector g) - g)) + (:accept nil) (gen/fmap vector (gfn)) + (gfn))) (when gfn (gfn)) (when p From d920ada9fab7e9b8342d28d8295a600a814c1d8a Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Thu, 14 Jul 2016 10:09:09 -0400 Subject: [PATCH 108/246] fix docstring - merge doesn't flow --- src/clj/clojure/spec.clj | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index b6b422a8..295e6941 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -444,8 +444,7 @@ (defmacro merge "Takes map-validating specs (e.g. 'keys' specs) and returns a spec that returns a conformed map satisfying all of the - specs. Successive conformed values propagate through rest of - predicates. Unlike 'and', merge can generate maps satisfying the + specs. Unlike 'and', merge can generate maps satisfying the union of the predicates." [& pred-forms] `(merge-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) From e8065abc374b574e830627ad90d5695b993537fd Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 15 Jul 2016 16:35:56 -0500 Subject: [PATCH 109/246] fix lost type hints in map destructuring Signed-off-by: Rich Hickey --- src/clj/clojure/core.clj | 2 +- test/clojure/test_clojure/special.clj | 9 ++++++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index d454eb10..5cbb0260 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -4410,7 +4410,7 @@ (if (seq bes) (let [bb (key (first bes)) bk (val (first bes)) - local (if (instance? clojure.lang.Named bb) (symbol nil (name bb)) bb) + local (if (instance? clojure.lang.Named bb) (with-meta (symbol nil (name bb)) (meta bb)) bb) bv (if (contains? defaults local) (list `get gmap bk (defaults local)) (list `get gmap bk))] diff --git a/test/clojure/test_clojure/special.clj b/test/clojure/test_clojure/special.clj index 87f0e3ff..cae206b7 100644 --- a/test/clojure/test_clojure/special.clj +++ b/test/clojure/test_clojure/special.clj @@ -13,7 +13,8 @@ ;; (ns clojure.test-clojure.special - (:use clojure.test)) + (:use clojure.test) + (:require [clojure.test-helper :refer [should-not-reflect]])) ; http://clojure.org/special_forms @@ -98,3 +99,9 @@ (.getCause) (ex-data) (:form)))))) + +(deftest typehints-retained-destructuring + (should-not-reflect + (defn foo + [{:keys [^String s]}] + (.indexOf s "boo")))) \ No newline at end of file From df2749ce31728da6e1ca75953a8a3f9757fcec1d Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Wed, 27 Jul 2016 12:52:45 -0400 Subject: [PATCH 110/246] fix guard in check-1 Signed-off-by: Rich Hickey --- src/clj/clojure/spec/test.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index f6cea539..a7d32a6f 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -325,7 +325,7 @@ with explain-data + ::s/failure." f (or f (when v @v))] (try (cond - (nil? f) + (or (nil? f) (some-> v meta :macro)) {:failure (ex-info "No fn to spec" {::s/failure :no-fn}) :sym s :spec spec} From dcc29d897718ab80bc993553ecf1b8e5a78bbe26 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 18 Jul 2016 09:13:54 -0500 Subject: [PATCH 111/246] specs for let, if-let, when-let Signed-off-by: Rich Hickey --- src/clj/clojure/core/specs.clj | 61 ++++++++++++++++++++++++++- test/clojure/test_clojure/errors.clj | 9 +--- test/clojure/test_clojure/special.clj | 12 +++--- 3 files changed, 68 insertions(+), 14 deletions(-) diff --git a/src/clj/clojure/core/specs.clj b/src/clj/clojure/core/specs.clj index 08503861..1c588b4e 100644 --- a/src/clj/clojure/core/specs.clj +++ b/src/clj/clojure/core/specs.clj @@ -1,4 +1,63 @@ (ns ^{:skip-wiki true} clojure.core.specs (:require [clojure.spec :as s])) -(alias 'cc 'clojure.core) \ No newline at end of file +;;;; destructure + +(s/def ::local-name (s/and simple-symbol? #(not= '& %))) + +(s/def ::binding-form + (s/or :sym ::local-name + :seq ::seq-binding-form + :map ::map-binding-form)) + +;; sequential destructuring + +(s/def ::seq-binding-form + (s/cat :elems (s/* ::binding-form) + :rest (s/? (s/cat :amp #{'&} :form ::binding-form)) + :as (s/? (s/cat :as #{:as} :sym ::local-name)))) + +;; map destructuring + +(s/def ::keys (s/coll-of ident? :kind vector?)) +(s/def ::syms (s/coll-of symbol? :kind vector?)) +(s/def ::strs (s/coll-of simple-symbol? :kind vector?)) +(s/def ::or (s/map-of simple-symbol? any?)) +(s/def ::as ::local-name) + +(s/def ::map-special-binding + (s/keys :opt-un [::as ::or ::keys ::syms ::strs])) + +(s/def ::map-binding (s/tuple ::binding-form any?)) + +(s/def ::ns-keys + (s/tuple + (s/and qualified-keyword? #(-> % name #{"keys" "syms"})) + (s/coll-of simple-symbol? :kind vector?))) + +(s/def ::map-bindings + (s/every (s/or :mb ::map-binding + :nsk ::ns-keys + :msb (s/tuple #{:as :or :keys :syms :strs} any?)) :into {})) + +(s/def ::map-binding-form (s/merge ::map-bindings ::map-special-binding)) + +;; bindings + +(s/def ::binding (s/cat :binding ::binding-form :init-expr any?)) +(s/def ::bindings (s/and vector? (s/* ::binding))) + +;; let, if-let, when-let + +(s/fdef clojure.core/let + :args (s/cat :bindings ::bindings + :body (s/* any?))) + +(s/fdef clojure.core/if-let + :args (s/cat :bindings (s/and vector? ::binding) + :then any? + :else (s/? any?))) + +(s/fdef clojure.core/when-let + :args (s/cat :bindings (s/and vector? ::binding) + :body (s/* any?))) diff --git a/test/clojure/test_clojure/errors.clj b/test/clojure/test_clojure/errors.clj index 16b937a3..a1c82771 100644 --- a/test/clojure/test_clojure/errors.clj +++ b/test/clojure/test_clojure/errors.clj @@ -42,15 +42,10 @@ (refer 'clojure.core :rename '{with-open renamed-with-open}) ; would have used `are` here, but :line meta on &form doesn't survive successive macroexpansions - (doseq [[msg-regex-str form] [["if-let .* in %s:\\d+" '(if-let [a 5 - b 6] - true nil)] - ["let .* in %s:\\d+" '(let [a])] - ["let .* in %s:\\d+" '(let (a))] - ["renamed-with-open .* in %s:\\d+" '(renamed-with-open [a])]]] + (doseq [[msg-regex-str form] [["renamed-with-open" "(renamed-with-open [a])"]]] (is (thrown-with-msg? IllegalArgumentException (re-pattern (format msg-regex-str *ns*)) - (macroexpand form))))) + (macroexpand (read-string form)))))) (deftest extract-ex-data (try diff --git a/test/clojure/test_clojure/special.clj b/test/clojure/test_clojure/special.clj index cae206b7..abfe1bfb 100644 --- a/test/clojure/test_clojure/special.clj +++ b/test/clojure/test_clojure/special.clj @@ -67,19 +67,19 @@ (is (= [1 2 3] [b c d])))) (deftest keywords-not-allowed-in-let-bindings - (is (thrown-with-msg? Exception #"Unsupported binding form: :a" + (is (thrown-with-msg? Exception #"did not conform to spec" (eval '(let [:a 1] a)))) - (is (thrown-with-msg? Exception #"Unsupported binding form: :a/b" + (is (thrown-with-msg? Exception #"did not conform to spec" (eval '(let [:a/b 1] b)))) - (is (thrown-with-msg? Exception #"Unsupported binding form: :a" + (is (thrown-with-msg? Exception #"did not conform to spec" (eval '(let [[:a] [1]] a)))) - (is (thrown-with-msg? Exception #"Unsupported binding form: :a/b" + (is (thrown-with-msg? Exception #"did not conform to spec" (eval '(let [[:a/b] [1]] b))))) (deftest namespaced-syms-only-allowed-in-map-destructuring - (is (thrown-with-msg? Exception #"Can't let qualified name: a/x" + (is (thrown-with-msg? Exception #"did not conform to spec" (eval '(let [a/x 1, [y] [1]] x)))) - (is (thrown-with-msg? Exception #"Can't let qualified name: a/x" + (is (thrown-with-msg? Exception #"did not conform to spec" (eval '(let [[a/x] [1]] x))))) (deftest or-doesnt-create-bindings From 4322f3b36c4ea7763b9451618c38ab5bc2840dd9 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Thu, 21 Jul 2016 15:38:54 -0500 Subject: [PATCH 112/246] specs for defn, defn-, fn Signed-off-by: Rich Hickey --- src/clj/clojure/core/specs.clj | 35 +++++++++++++++++++++++++++++++ test/clojure/test_clojure/def.clj | 12 +++++------ test/clojure/test_clojure/fn.clj | 16 +++++++------- 3 files changed, 49 insertions(+), 14 deletions(-) diff --git a/src/clj/clojure/core/specs.clj b/src/clj/clojure/core/specs.clj index 1c588b4e..fe212547 100644 --- a/src/clj/clojure/core/specs.clj +++ b/src/clj/clojure/core/specs.clj @@ -61,3 +61,38 @@ (s/fdef clojure.core/when-let :args (s/cat :bindings (s/and vector? ::binding) :body (s/* any?))) + +;; defn, defn-, fn + +(s/def ::arg-list + (s/and + vector? + (s/cat :args (s/* ::binding-form) + :varargs (s/? (s/cat :amp #{'&} :form ::binding-form))))) + +(s/def ::args+body + (s/cat :args ::arg-list + :prepost (s/? map?) + :body (s/* any?))) + +(def defn-args + (s/cat :name simple-symbol? + :docstring (s/? string?) + :meta (s/? map?) + :bs (s/alt :arity-1 ::args+body + :arity-n (s/cat :bodies (s/+ (s/spec ::args+body)) + :attr (s/? map?))))) + +(s/fdef clojure.core/defn + :args defn-args + :ret any?) + +(s/fdef clojure.core/defn- + :args defn-args + :ret any?) + +(s/fdef clojure.core/fn + :args (s/cat :name (s/? simple-symbol?) + :bs (s/alt :arity-1 ::args+body + :arity-n (s/+ (s/spec ::args+body)))) + :ret any?) diff --git a/test/clojure/test_clojure/def.clj b/test/clojure/test_clojure/def.clj index a01489aa..2b73ea3c 100644 --- a/test/clojure/test_clojure/def.clj +++ b/test/clojure/test_clojure/def.clj @@ -14,13 +14,13 @@ (testing "multiarity syntax invalid parameter declaration" (is (fails-with-cause? IllegalArgumentException - #"Parameter declaration \"arg1\" should be a vector" + #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn foo (arg1 arg2)))))) (testing "multiarity syntax invalid signature" (is (fails-with-cause? IllegalArgumentException - #"Invalid signature \"\[a b\]\" should be a list" + #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn foo ([a] 1) [a b]))))) @@ -28,19 +28,19 @@ (testing "assume single arity syntax" (is (fails-with-cause? IllegalArgumentException - #"Parameter declaration \"a\" should be a vector" + #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn foo a))))) (testing "bad name" (is (fails-with-cause? IllegalArgumentException - #"First argument to defn must be a symbol" + #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn "bad docstring" testname [arg1 arg2]))))) (testing "missing parameter/signature" (is (fails-with-cause? IllegalArgumentException - #"Parameter declaration missing" + #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn testname))))) (testing "allow trailing map" @@ -49,7 +49,7 @@ (testing "don't allow interleaved map" (is (fails-with-cause? IllegalArgumentException - #"Invalid signature \"\{:a :b\}\" should be a list" + #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn a "asdf" ([a] 1) {:a :b} ([] 1))))))) (deftest non-dynamic-warnings diff --git a/test/clojure/test_clojure/fn.clj b/test/clojure/test_clojure/fn.clj index c85b155d..3c131480 100644 --- a/test/clojure/test_clojure/fn.clj +++ b/test/clojure/test_clojure/fn.clj @@ -14,42 +14,42 @@ (deftest fn-error-checking (testing "bad arglist" (is (fails-with-cause? java.lang.IllegalArgumentException - #"Parameter declaration a should be a vector" + #"Call to clojure.core/fn did not conform to spec" (eval '(fn "a" a))))) (testing "treat first param as args" (is (fails-with-cause? java.lang.IllegalArgumentException - #"Parameter declaration a should be a vector" + #"Call to clojure.core/fn did not conform to spec" (eval '(fn "a" []))))) (testing "looks like listy signature, but malformed declaration" (is (fails-with-cause? java.lang.IllegalArgumentException - #"Parameter declaration 1 should be a vector" + #"Call to clojure.core/fn did not conform to spec" (eval '(fn (1)))))) (testing "checks each signature" (is (fails-with-cause? java.lang.IllegalArgumentException - #"Parameter declaration a should be a vector" + #"Call to clojure.core/fn did not conform to spec" (eval '(fn ([a] 1) ("a" 2)))))) (testing "correct name but invalid args" (is (fails-with-cause? java.lang.IllegalArgumentException - #"Parameter declaration a should be a vector" + #"Call to clojure.core/fn did not conform to spec" (eval '(fn a "a"))))) (testing "first sig looks multiarity, rest of sigs should be lists" (is (fails-with-cause? java.lang.IllegalArgumentException - #"Invalid signature \[a b\] should be a list" + #"Call to clojure.core/fn did not conform to spec" (eval '(fn a ([a] 1) [a b]))))) (testing "missing parameter declaration" (is (fails-with-cause? java.lang.IllegalArgumentException - #"Parameter declaration missing" + #"Call to clojure.core/fn did not conform to spec" (eval '(fn a)))) (is (fails-with-cause? java.lang.IllegalArgumentException - #"Parameter declaration missing" + #"Call to clojure.core/fn did not conform to spec" (eval '(fn)))))) From 1c8a13a9a9dbcafda3168ab191ba6e5ce61c8f96 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 26 Jul 2016 13:43:24 -0500 Subject: [PATCH 113/246] specs for ns Signed-off-by: Rich Hickey --- src/clj/clojure/core/specs.clj | 103 +++++++++++++++++++++++++++++ test/clojure/test_clojure/data.clj | 2 +- 2 files changed, 104 insertions(+), 1 deletion(-) diff --git a/src/clj/clojure/core/specs.clj b/src/clj/clojure/core/specs.clj index fe212547..761749e9 100644 --- a/src/clj/clojure/core/specs.clj +++ b/src/clj/clojure/core/specs.clj @@ -96,3 +96,106 @@ :bs (s/alt :arity-1 ::args+body :arity-n (s/+ (s/spec ::args+body)))) :ret any?) + +;;;; ns + +(s/def ::exclude (s/coll-of simple-symbol?)) +(s/def ::only (s/coll-of simple-symbol?)) +(s/def ::rename (s/map-of simple-symbol? simple-symbol?)) + +(s/def ::ns-refer-clojure + (s/spec (s/cat :clause #{:refer-clojure} + :filters (s/keys* :opt-un [::exclude ::only ::rename])))) + +(s/def ::refer (s/or :all #{:all} + :syms (s/coll-of simple-symbol?))) + +(s/def ::prefix-list + (s/spec + (s/cat :prefix simple-symbol? + :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::prefix-list)) + :refer (s/keys* :opt-un [::as ::refer])))) + +(s/def ::ns-require + (s/spec (s/cat :clause #{:require} + :libs (s/* (s/alt :lib simple-symbol? + :prefix-list ::prefix-list + :flag #{:reload :reload-all :verbose}))))) + +(s/def ::package-list + (s/spec + (s/cat :package simple-symbol? + :classes (s/* simple-symbol?)))) + +(s/def ::ns-import + (s/spec + (s/cat :clause #{:import} + :classes (s/* (s/alt :class simple-symbol? + :package-list ::package-list))))) + +(s/def ::ns-refer + (s/spec (s/cat :clause #{:refer} + :lib simple-symbol? + :filters (s/keys* :opt-un [::exclude ::only ::rename])))) + +(s/def ::use-prefix-list + (s/spec + (s/cat :prefix simple-symbol? + :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::use-prefix-list)) + :filters (s/keys* :opt-un [::exclude ::only ::rename])))) + +(s/def ::ns-use + (s/spec (s/cat :clause #{:use} + :libs (s/* (s/alt :lib simple-symbol? + :prefix-list ::use-prefix-list + :flag #{:reload :reload-all :verbose}))))) + +(s/def ::ns-load + (s/spec (s/cat :clause #{:load} + :libs (s/* string?)))) + +(s/def ::name simple-symbol?) +(s/def ::extends simple-symbol?) +(s/def ::implements (s/coll-of simple-symbol? :kind vector?)) +(s/def ::init symbol?) +(s/def ::signature (s/coll-of simple-symbol? :kind vector?)) +(s/def ::constructors (s/map-of ::signature ::signature)) +(s/def ::post-init symbol?) +(s/def ::method (s/and vector? + (s/cat :name simple-symbol? + :param-types ::signature + :return-type simple-symbol?))) +(s/def ::methods (s/coll-of ::method :kind vector?)) +(s/def ::main boolean?) +(s/def ::factory simple-symbol?) +(s/def ::state simple-symbol?) +(s/def ::get simple-symbol?) +(s/def ::set simple-symbol?) +(s/def ::expose (s/keys :opt-un [::get ::set])) +(s/def ::exposes (s/map-of simple-symbol? ::expose)) +(s/def ::prefix string?) +(s/def ::impl-ns simple-symbol?) +(s/def ::load-impl-ns boolean?) + +(s/def ::ns-gen-class + (s/spec (s/cat :clause #{:gen-class} + :options (s/keys* :opt-un [::name ::extends ::implements + ::init ::constructors ::post-init + ::methods ::main ::factory ::state + ::exposes ::prefix ::impl-ns ::load-impl-ns])))) + +(s/def ::ns-clauses + (s/* (s/alt :refer-clojure ::ns-refer-clojure + :require ::ns-require + :import ::ns-import + :use ::ns-use + :refer ::ns-refer + :load ::ns-load + :gen-class ::ns-gen-class))) + +(s/fdef clojure.core/ns + :args (s/cat :name simple-symbol? + :docstring (s/? string?) + :attr-map (s/? map?) + :clauses ::ns-clauses) + :ret any?) \ No newline at end of file diff --git a/test/clojure/test_clojure/data.clj b/test/clojure/test_clojure/data.clj index 5a241e07..0b6e5d54 100644 --- a/test/clojure/test_clojure/data.clj +++ b/test/clojure/test_clojure/data.clj @@ -8,7 +8,7 @@ (ns clojure.test-clojure.data (:use clojure.data clojure.test) - (import java.util.HashSet)) + (:import java.util.HashSet)) (deftest diff-test (are [d x y] (= d (diff x y)) From d287874f016db26c198840cd8cb1a2c43559e870 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 15 Aug 2016 15:18:10 -0500 Subject: [PATCH 114/246] register defn-args spec Signed-off-by: Rich Hickey --- src/clj/clojure/core/specs.clj | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/clj/clojure/core/specs.clj b/src/clj/clojure/core/specs.clj index 761749e9..c66c6066 100644 --- a/src/clj/clojure/core/specs.clj +++ b/src/clj/clojure/core/specs.clj @@ -75,7 +75,7 @@ :prepost (s/? map?) :body (s/* any?))) -(def defn-args +(s/def ::defn-args (s/cat :name simple-symbol? :docstring (s/? string?) :meta (s/? map?) @@ -84,11 +84,11 @@ :attr (s/? map?))))) (s/fdef clojure.core/defn - :args defn-args + :args ::defn-args :ret any?) (s/fdef clojure.core/defn- - :args defn-args + :args ::defn-args :ret any?) (s/fdef clojure.core/fn @@ -198,4 +198,4 @@ :docstring (s/? string?) :attr-map (s/? map?) :clauses ::ns-clauses) - :ret any?) \ No newline at end of file + :ret any?) From de899203203b2e38bf20e1babc19fbdd9f791c9c Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Wed, 20 Jul 2016 08:34:51 -0500 Subject: [PATCH 115/246] pass unconform along on conformer with-gen Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 295e6941..78425255 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -802,7 +802,7 @@ (gen* [_ _ _ _] (if gfn (gfn) (gen/gen-for-pred pred))) - (with-gen* [_ gfn] (spec-impl form pred gfn cpred?)) + (with-gen* [_ gfn] (spec-impl form pred gfn cpred? unc)) (describe* [_] form))))) (defn ^:skip-wiki multi-spec-impl From b49c1984a1527d17951fbb23ddf9406805a1343f Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 16 Aug 2016 10:07:32 -0500 Subject: [PATCH 116/246] add *print-namespace-maps* flag to control namespace map printing - false by default, but true by default in the repl Signed-off-by: Rich Hickey --- src/clj/clojure/core_print.clj | 16 ++++++++++++---- src/clj/clojure/main.clj | 1 + test/clojure/test_clojure/printer.clj | 4 +++- 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/src/clj/clojure/core_print.clj b/src/clj/clojure/core_print.clj index 6dd99b51..99da2342 100644 --- a/src/clj/clojure/core_print.clj +++ b/src/clj/clojure/core_print.clj @@ -38,6 +38,12 @@ (def ^:dynamic *verbose-defrecords* false) +(def ^:dynamic + ^{:doc "*print-namespace-maps* controls whether the printer will print + namespace map literal syntax. It defaults to true." + :added "1.9"} + *print-namespace-maps* false) + (defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w] (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))] (if (and *print-level* (neg? *print-level*)) @@ -240,10 +246,12 @@ (defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w] (print-meta m w) - (let [[ns lift-map] (lift-ns m)] - (if ns - (print-prefix-map (str "#:" ns) lift-map pr-on w) - (print-map m pr-on w)))) + (if *print-namespace-maps* + (let [[ns lift-map] (lift-ns m)] + (if ns + (print-prefix-map (str "#:" ns) lift-map pr-on w) + (print-map m pr-on w))) + (print-map m pr-on w))) (defmethod print-dup java.util.Map [m, ^Writer w] (print-ctor m #(print-map (seq %1) print-dup %2) w)) diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj index 14af9c7e..97ec7d36 100644 --- a/src/clj/clojure/main.clj +++ b/src/clj/clojure/main.clj @@ -74,6 +74,7 @@ *print-meta* *print-meta* *print-length* *print-length* *print-level* *print-level* + *print-namespace-maps* true *data-readers* *data-readers* *default-data-reader-fn* *default-data-reader-fn* *compile-path* (System/getProperty "clojure.compile.path" "classes") diff --git a/test/clojure/test_clojure/printer.clj b/test/clojure/test_clojure/printer.clj index aa75d105..61efcf44 100644 --- a/test/clojure/test_clojure/printer.clj +++ b/test/clojure/test_clojure/printer.clj @@ -134,4 +134,6 @@ (ex-info "the root" {:with "even" :more 'data}))))))) - +(deftest print-ns-maps + (is (= "#:user{:a 1}" (binding [*print-namespace-maps* true] (pr-str {:user/a 1})))) + (is (= "{:user/a 1}" (binding [*print-namespace-maps* false] (pr-str {:user/a 1}))))) From d57b5559829be8e8b3dcb28a20876b32615af0cb Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 16 Aug 2016 15:07:08 -0500 Subject: [PATCH 117/246] fix *print-namespace-map* docstring Signed-off-by: Rich Hickey --- src/clj/clojure/core_print.clj | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/clj/clojure/core_print.clj b/src/clj/clojure/core_print.clj index 99da2342..da023302 100644 --- a/src/clj/clojure/core_print.clj +++ b/src/clj/clojure/core_print.clj @@ -40,7 +40,8 @@ (def ^:dynamic ^{:doc "*print-namespace-maps* controls whether the printer will print - namespace map literal syntax. It defaults to true." + namespace map literal syntax. It defaults to false, but the REPL binds + to true." :added "1.9"} *print-namespace-maps* false) From 9e6020c30ea229e80227877bd51254ecafc9e4a4 Mon Sep 17 00:00:00 2001 From: Alan Malloy Date: Mon, 18 Jan 2016 17:28:38 -0600 Subject: [PATCH 118/246] CLJ-1423 Allow vars to be invoked with infinite arglists Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Var.java | 2 +- test/clojure/test_clojure/vars.clj | 11 ++++++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/src/jvm/clojure/lang/Var.java b/src/jvm/clojure/lang/Var.java index 9e79aac8..3dc9580c 100644 --- a/src/jvm/clojure/lang/Var.java +++ b/src/jvm/clojure/lang/Var.java @@ -697,7 +697,7 @@ public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object } public Object applyTo(ISeq arglist) { - return AFn.applyToHelper(this, arglist); + return fn().applyTo(arglist); } static IFn assoc = new AFn(){ diff --git a/test/clojure/test_clojure/vars.clj b/test/clojure/test_clojure/vars.clj index b1d9e2da..6b454d2b 100644 --- a/test/clojure/test_clojure/vars.clj +++ b/test/clojure/test_clojure/vars.clj @@ -97,4 +97,13 @@ (is (= 2 dynamic-var)) (with-redefs [dynamic-var 3] (is (= 2 dynamic-var)))) - (is (= 1 dynamic-var))) \ No newline at end of file + (is (= 1 dynamic-var))) + +(defn sample [& args] + 0) + +(deftest test-vars-apply-lazily + (is (= 0 (deref (future (apply sample (range))) + 1000 :timeout))) + (is (= 0 (deref (future (apply #'sample (range))) + 1000 :timeout)))) From 1f4318021e61e8dfa68960cf44018ed4d4f79a44 Mon Sep 17 00:00:00 2001 From: Nicola Mometto Date: Wed, 3 Jun 2015 16:37:58 +0200 Subject: [PATCH 119/246] CLJ-1744: clear unused locals Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Compiler.java | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index c455d32c..8bc97c77 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -5858,6 +5858,7 @@ public static class LocalBinding{ public final PathNode clearPathRoot; public boolean canBeCleared = !RT.booleanCast(getCompilerOption(disableLocalsClearingKey)); public boolean recurMistmatch = false; + public boolean used = false; public LocalBinding(int num, Symbol sym, Symbol tag, Expr init, boolean isArg,PathNode clearPathRoot) { @@ -5910,6 +5911,7 @@ public LocalBindingExpr(LocalBinding b, Symbol tag) this.clearPath = (PathNode)CLEAR_PATH.get(); this.clearRoot = (PathNode)CLEAR_ROOT.get(); IPersistentCollection sites = (IPersistentCollection) RT.get(CLEAR_SITES.get(),b); + b.used = true; if(b.idx > 0) { @@ -6371,7 +6373,10 @@ public void doEmit(C context, ObjExpr objx, GeneratorAdapter gen, boolean emitUn else { bi.init.emit(C.EXPRESSION, objx, gen); - gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx); + if (!bi.binding.used && bi.binding.canBeCleared) + gen.pop(); + else + gen.visitVarInsn(OBJECT_TYPE.getOpcode(Opcodes.ISTORE), bi.binding.idx); } bindingLabels.put(bi, gen.mark()); } From 134c29990e046d19b209c92a1e8033e9841489ac Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Thu, 14 Apr 2016 21:34:45 -0700 Subject: [PATCH 120/246] CLJ-1914 Avoid race in concurrent range realization Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/LongRange.java | 2 +- test/clojure/test_clojure/sequences.clj | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/src/jvm/clojure/lang/LongRange.java b/src/jvm/clojure/lang/LongRange.java index 90629d90..348e3620 100644 --- a/src/jvm/clojure/lang/LongRange.java +++ b/src/jvm/clojure/lang/LongRange.java @@ -128,8 +128,8 @@ public void forceChunk() { if (count > CHUNK_SIZE) { // not last chunk long nextStart = start + (step * CHUNK_SIZE); // cannot overflow, must be < end - _chunk = new LongChunk(start, step, CHUNK_SIZE); _chunkNext = new LongRange(nextStart, end, step, boundsCheck); + _chunk = new LongChunk(start, step, CHUNK_SIZE); } else { // last chunk _chunk = new LongChunk(start, step, (int) count); // count must be <= CHUNK_SIZE } diff --git a/test/clojure/test_clojure/sequences.clj b/test/clojure/test_clojure/sequences.clj index e3adb277..146869be 100644 --- a/test/clojure/test_clojure/sequences.clj +++ b/test/clojure/test_clojure/sequences.clj @@ -1058,6 +1058,24 @@ (reduce + (iterator-seq (.iterator (range 100)))) 4950 (reduce + (iterator-seq (.iterator (range 0.0 100.0 1.0)))) 4950.0 )) +(deftest range-test + (let [threads 10 + n 1000 + r (atom (range (inc n))) + m (atom 0)] + ; Iterate through the range concurrently, + ; updating m to the highest seen value in the range + (->> (range threads) + (map (fn [id] + (future + (loop [] + (when-let [r (swap! r next)] + (swap! m max (first r)) + (recur)))))) + (map deref) + dorun) + (is (= n @m)))) + (defn unlimited-range-create [& args] (let [[arg1 arg2 arg3] args] (case (count args) From b26a8d0efc0675d0040dfbb28e8b489b866f7507 Mon Sep 17 00:00:00 2001 From: Nicola Mometto Date: Tue, 22 Dec 2015 23:58:28 +0000 Subject: [PATCH 121/246] CLJ-1870: don't destroy defmulti metadata on reload Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 5cbb0260..6b8a1b5e 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -1757,7 +1757,8 @@ m) m (if (meta mm-name) (conj (meta mm-name) m) - m)] + m) + mm-name (with-meta mm-name m)] (when (= (count options) 1) (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))) (let [options (apply hash-map options) @@ -1766,7 +1767,7 @@ (check-valid-options options :default :hierarchy) `(let [v# (def ~mm-name)] (when-not (and (.hasRoot v#) (instance? clojure.lang.MultiFn (deref v#))) - (def ~(with-meta mm-name m) + (def ~mm-name (new clojure.lang.MultiFn ~(name mm-name) ~dispatch-fn ~default ~hierarchy))))))) (defmacro defmethod From 21256078bc0304ab5b6af521f64e986eedbe5ee2 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Fri, 19 Aug 2016 12:59:01 -0500 Subject: [PATCH 122/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha11 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..61a3b7f4 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha11 http://clojure.org/ Clojure core environment and runtime library. From 313da5553bc52ba257e42e53c8f612eb1ae9fcca Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Fri, 19 Aug 2016 12:59:01 -0500 Subject: [PATCH 123/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 61a3b7f4..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha11 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From 05a8e8b323042fa043355b716facaed6003af324 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 22 Aug 2016 16:56:41 -0500 Subject: [PATCH 124/246] pprint maps with namespace map literal syntax when *print-namespace-maps* Signed-off-by: Rich Hickey --- src/clj/clojure/core_print.clj | 33 ++++++++++++++--------------- src/clj/clojure/pprint/dispatch.clj | 30 ++++++++++++++------------ 2 files changed, 33 insertions(+), 30 deletions(-) diff --git a/src/clj/clojure/core_print.clj b/src/clj/clojure/core_print.clj index da023302..6c75e879 100644 --- a/src/clj/clojure/core_print.clj +++ b/src/clj/clojure/core_print.clj @@ -233,26 +233,25 @@ (defn- lift-ns "Returns [lifted-ns lifted-map] or nil if m can't be lifted." [m] - (loop [ns nil - [[k v :as entry] & entries] (seq m) - lm (empty m)] - (if entry - (when (or (keyword? k) (symbol? k)) - (if ns - (when (= ns (namespace k)) - (recur ns entries (assoc lm (strip-ns k) v))) - (when-let [new-ns (namespace k)] - (recur new-ns entries (assoc lm (strip-ns k) v))))) - [ns lm]))) + (when *print-namespace-maps* + (loop [ns nil + [[k v :as entry] & entries] (seq m) + lm (empty m)] + (if entry + (when (or (keyword? k) (symbol? k)) + (if ns + (when (= ns (namespace k)) + (recur ns entries (assoc lm (strip-ns k) v))) + (when-let [new-ns (namespace k)] + (recur new-ns entries (assoc lm (strip-ns k) v))))) + [ns lm])))) (defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w] (print-meta m w) - (if *print-namespace-maps* - (let [[ns lift-map] (lift-ns m)] - (if ns - (print-prefix-map (str "#:" ns) lift-map pr-on w) - (print-map m pr-on w))) - (print-map m pr-on w))) + (let [[ns lift-map] (lift-ns m)] + (if ns + (print-prefix-map (str "#:" ns) lift-map pr-on w) + (print-map m pr-on w)))) (defmethod print-dup java.util.Map [m, ^Writer w] (print-ctor m #(print-map (seq %1) print-dup %2) w)) diff --git a/src/clj/clojure/pprint/dispatch.clj b/src/clj/clojure/pprint/dispatch.clj index 323348eb..1ef9a578 100644 --- a/src/clj/clojure/pprint/dispatch.clj +++ b/src/clj/clojure/pprint/dispatch.clj @@ -92,19 +92,23 @@ ;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>")) (defn- pprint-map [amap] - (pprint-logical-block :prefix "{" :suffix "}" - (print-length-loop [aseq (seq amap)] - (when aseq - (pprint-logical-block - (write-out (ffirst aseq)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (set! *current-length* 0) ; always print both parts of the [k v] pair - (write-out (fnext (first aseq)))) - (when (next aseq) - (.write ^java.io.Writer *out* ", ") - (pprint-newline :linear) - (recur (next aseq))))))) + (let [[ns lift-map] (when (not (record? amap)) + (#'clojure.core/lift-ns amap)) + amap (or lift-map amap) + prefix (if ns (str "#:" ns "{") "{")] + (pprint-logical-block :prefix prefix :suffix "}" + (print-length-loop [aseq (seq amap)] + (when aseq + (pprint-logical-block + (write-out (ffirst aseq)) + (.write ^java.io.Writer *out* " ") + (pprint-newline :linear) + (set! *current-length* 0) ; always print both parts of the [k v] pair + (write-out (fnext (first aseq)))) + (when (next aseq) + (.write ^java.io.Writer *out* ", ") + (pprint-newline :linear) + (recur (next aseq)))))))) (def ^{:private true} pprint-set (formatter-out "~<#{~;~@{~w~^ ~:_~}~;}~:>")) From b3d3a5d6ff0a2f435bb6a5326da2b960038adad4 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Thu, 25 Aug 2016 16:51:34 -0500 Subject: [PATCH 125/246] throw ex-info on macroexpand spec error with ex-data Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 5 +++-- test/clojure/test_clojure/def.clj | 12 ++++++------ test/clojure/test_clojure/fn.clj | 16 ++++++++-------- 3 files changed, 17 insertions(+), 16 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 78425255..cc8e130e 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -621,10 +621,11 @@ (let [ed (assoc (explain-data* arg-spec [:args] (if-let [name (spec-name arg-spec)] [name] []) [] args) ::args args)] - (throw (IllegalArgumentException. + (throw (ex-info (str "Call to " (->sym v) " did not conform to spec:\n" - (with-out-str (explain-out ed)))))))))) + (with-out-str (explain-out ed))) + ed))))))) (defmacro fdef "Takes a symbol naming a function, and one or more of the following: diff --git a/test/clojure/test_clojure/def.clj b/test/clojure/test_clojure/def.clj index 2b73ea3c..7ea442ef 100644 --- a/test/clojure/test_clojure/def.clj +++ b/test/clojure/test_clojure/def.clj @@ -13,13 +13,13 @@ (deftest defn-error-messages (testing "multiarity syntax invalid parameter declaration" (is (fails-with-cause? - IllegalArgumentException + clojure.lang.ExceptionInfo #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn foo (arg1 arg2)))))) (testing "multiarity syntax invalid signature" (is (fails-with-cause? - IllegalArgumentException + clojure.lang.ExceptionInfo #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn foo ([a] 1) @@ -27,19 +27,19 @@ (testing "assume single arity syntax" (is (fails-with-cause? - IllegalArgumentException + clojure.lang.ExceptionInfo #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn foo a))))) (testing "bad name" (is (fails-with-cause? - IllegalArgumentException + clojure.lang.ExceptionInfo #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn "bad docstring" testname [arg1 arg2]))))) (testing "missing parameter/signature" (is (fails-with-cause? - IllegalArgumentException + clojure.lang.ExceptionInfo #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn testname))))) @@ -48,7 +48,7 @@ (testing "don't allow interleaved map" (is (fails-with-cause? - IllegalArgumentException + clojure.lang.ExceptionInfo #"Call to clojure.core/defn did not conform to spec" (eval-in-temp-ns (defn a "asdf" ([a] 1) {:a :b} ([] 1))))))) diff --git a/test/clojure/test_clojure/fn.clj b/test/clojure/test_clojure/fn.clj index 3c131480..dfd1eaf2 100644 --- a/test/clojure/test_clojure/fn.clj +++ b/test/clojure/test_clojure/fn.clj @@ -13,43 +13,43 @@ (deftest fn-error-checking (testing "bad arglist" - (is (fails-with-cause? java.lang.IllegalArgumentException + (is (fails-with-cause? clojure.lang.ExceptionInfo #"Call to clojure.core/fn did not conform to spec" (eval '(fn "a" a))))) (testing "treat first param as args" - (is (fails-with-cause? java.lang.IllegalArgumentException + (is (fails-with-cause? clojure.lang.ExceptionInfo #"Call to clojure.core/fn did not conform to spec" (eval '(fn "a" []))))) (testing "looks like listy signature, but malformed declaration" - (is (fails-with-cause? java.lang.IllegalArgumentException + (is (fails-with-cause? clojure.lang.ExceptionInfo #"Call to clojure.core/fn did not conform to spec" (eval '(fn (1)))))) (testing "checks each signature" - (is (fails-with-cause? java.lang.IllegalArgumentException + (is (fails-with-cause? clojure.lang.ExceptionInfo #"Call to clojure.core/fn did not conform to spec" (eval '(fn ([a] 1) ("a" 2)))))) (testing "correct name but invalid args" - (is (fails-with-cause? java.lang.IllegalArgumentException + (is (fails-with-cause? clojure.lang.ExceptionInfo #"Call to clojure.core/fn did not conform to spec" (eval '(fn a "a"))))) (testing "first sig looks multiarity, rest of sigs should be lists" - (is (fails-with-cause? java.lang.IllegalArgumentException + (is (fails-with-cause? clojure.lang.ExceptionInfo #"Call to clojure.core/fn did not conform to spec" (eval '(fn a ([a] 1) [a b]))))) (testing "missing parameter declaration" - (is (fails-with-cause? java.lang.IllegalArgumentException + (is (fails-with-cause? clojure.lang.ExceptionInfo #"Call to clojure.core/fn did not conform to spec" (eval '(fn a)))) - (is (fails-with-cause? java.lang.IllegalArgumentException + (is (fails-with-cause? clojure.lang.ExceptionInfo #"Call to clojure.core/fn did not conform to spec" (eval '(fn)))))) From 99ab306f82620e6db6a978a5565d2ccd668c0798 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Thu, 25 Aug 2016 11:12:50 -0500 Subject: [PATCH 126/246] Make clojure spec explain printer pluggable. Moved old printer to clojure.spec/explain-printer. Added dynamic variable clojure.spec/*explain-out*. Set default *explain-out* to explain-printer. Changed explain-out to invoke *explain-out*. Changed repl to bind *explain-out* so it can be set!'ed. Signed-off-by: Rich Hickey --- src/clj/clojure/main.clj | 1 + src/clj/clojure/spec.clj | 12 ++++++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj index 97ec7d36..c023f1f8 100644 --- a/src/clj/clojure/main.clj +++ b/src/clj/clojure/main.clj @@ -81,6 +81,7 @@ *command-line-args* *command-line-args* *unchecked-math* *unchecked-math* *assert* *assert* + clojure.spec/*explain-out* clojure.spec/*explain-out* *1 nil *2 nil *3 nil diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index cc8e130e..80206973 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -175,8 +175,8 @@ [spec x] (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) [] x)) -(defn explain-out - "prints explanation data (per 'explain-data') to *out*." +(defn explain-printer + "Default printer for explain-data. nil indicates a successful validation." [ed] (if ed (do @@ -206,6 +206,14 @@ (newline)))) (println "Success!"))) +(def ^:dynamic *explain-out* explain-printer) + +(defn explain-out + "Prints explanation data (per 'explain-data') to *out* using the printer in *explain-out*, + by default explain-printer." + [ed] + (*explain-out* ed)) + (defn explain "Given a spec and a value that fails to conform, prints an explanation to *out*." [spec x] From de6a2b528a18bcb4768e82d0d707d2cab26268a6 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 30 Aug 2016 14:59:48 -0400 Subject: [PATCH 127/246] perf tweaks (resolve, or et al) --- src/clj/clojure/spec.clj | 102 +++++++++++++++++++++++++-------------- 1 file changed, 66 insertions(+), 36 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 80206973..2fc8b8d5 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -44,28 +44,21 @@ (defonce ^:private registry-ref (atom {})) -(defn- named? [x] (instance? clojure.lang.Named x)) - -(defn- with-name [spec name] - (with-meta spec (assoc (meta spec) ::name name))) - -(defn- spec-name [spec] - (cond - (keyword? spec) spec - - (instance? clojure.lang.IObj spec) - (-> (meta spec) ::name))) +(defn- deep-resolve [reg k] + (loop [spec k] + (if (ident? spec) + (recur (get reg spec)) + spec))) (defn- reg-resolve - "returns the spec/regex at end of alias chain starting with k, nil if not found, k if k not Named" + "returns the spec/regex at end of alias chain starting with k, nil if not found, k if k not ident" [k] - (if (named? k) - (let [reg @registry-ref] - (loop [spec k] - (if (named? spec) - (recur (get reg spec)) - (when spec - (with-name spec k))))) + (if (ident? k) + (let [reg @registry-ref + spec (get reg k)] + (if-not (ident? spec) + spec + (deep-resolve reg spec))) k)) (defn- reg-resolve! @@ -86,15 +79,32 @@ [x] (c/and (::op x) x)) +(defn- with-name [spec name] + (cond + (ident? spec) spec + (regex? spec) (assoc spec ::name name) + + (instance? clojure.lang.IObj spec) + (with-meta spec (assoc (meta spec) ::name name)))) + +(defn- spec-name [spec] + (cond + (ident? spec) spec + + (regex? spec) (::name spec) + + (instance? clojure.lang.IObj spec) + (-> (meta spec) ::name))) + (declare spec-impl) (declare regex-spec-impl) (defn- maybe-spec "spec-or-k must be a spec, regex or resolvable kw/sym, else returns nil." [spec-or-k] - (let [s (c/or (spec? spec-or-k) + (let [s (c/or (c/and (ident? spec-or-k) (reg-resolve spec-or-k)) + (spec? spec-or-k) (regex? spec-or-k) - (c/and (named? spec-or-k) (reg-resolve spec-or-k)) nil)] (if (regex? s) (with-name (regex-spec-impl s nil) (spec-name s)) @@ -104,11 +114,27 @@ "spec-or-k must be a spec, regex or kw/sym, else returns nil. Throws if unresolvable kw/sym" [spec-or-k] (c/or (maybe-spec spec-or-k) - (when (named? spec-or-k) + (when (ident? spec-or-k) (throw (Exception. (str "Unable to resolve spec: " spec-or-k)))))) +(defprotocol Specize + (specize* [_])) + +(extend-protocol Specize + clojure.lang.Keyword + (specize* [k] (specize* (reg-resolve! k))) + + clojure.lang.Symbol + (specize* [s] (specize* (reg-resolve! s))) + + clojure.spec.Spec + (specize* [s] s) + + Object + (specize* [o] (spec-impl ::unknown o nil nil))) + (defn- specize [s] - (c/or (the-spec s) (spec-impl ::unknown s nil nil))) + (specize* s)) (defn conform "Given a spec and a value, returns :clojure.spec/invalid if value does not match spec, @@ -279,11 +305,11 @@ (defn ^:skip-wiki def-impl "Do not call this directly, use 'def'" [k form spec] - (c/assert (c/and (named? k) (namespace k)) "k must be namespaced keyword or resolvable symbol") + (c/assert (c/and (ident? k) (namespace k)) "k must be namespaced keyword or resolvable symbol") (let [spec (if (c/or (spec? spec) (regex? spec) (get @registry-ref spec)) spec (spec-impl form spec nil nil))] - (swap! registry-ref assoc k spec) + (swap! registry-ref assoc k (with-name spec k)) k)) (defn- ns-qualify @@ -795,11 +821,13 @@ (cond (spec? pred) (cond-> pred gfn (with-gen gfn)) (regex? pred) (regex-spec-impl pred gfn) - (named? pred) (cond-> (the-spec pred) gfn (with-gen gfn)) + (ident? pred) (cond-> (the-spec pred) gfn (with-gen gfn)) :else (reify Spec - (conform* [_ x] (dt pred x form cpred?)) + (conform* [_ x] (if cpred? + (pred x) + (if (pred x) x ::invalid))) (unform* [_ x] (if cpred? (if unc (unc x) @@ -924,15 +952,17 @@ [keys forms preds gfn] (let [id (java.util.UUID/randomUUID) kps (zipmap keys preds) - cform (fn [x] - (loop [i 0] - (if (< i (count preds)) - (let [pred (preds i)] - (let [ret (dt pred x (nth forms i))] - (if (= ::invalid ret) - (recur (inc i)) - (tagged-ret (keys i) ret)))) - ::invalid)))] + cform (let [specs (delay (mapv specize preds))] + (fn [x] + (let [specs @specs] + (loop [i 0] + (if (< i (count specs)) + (let [spec (specs i)] + (let [ret (conform* spec x)] + (if (= ::invalid ret) + (recur (inc i)) + (tagged-ret (keys i) ret)))) + ::invalid)))))] (reify Spec (conform* [_ x] (cform x)) From defa7b8ef268ea2b8772658ade2010ca5ad00dc4 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 30 Aug 2016 17:31:42 -0400 Subject: [PATCH 128/246] perf tweaks (and, unrolling, nonconforming in nilable) --- src/clj/clojure/spec.clj | 109 +++++++++++++++++++++++++++++++-------- 1 file changed, 88 insertions(+), 21 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 2fc8b8d5..f925f0fc 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -952,17 +952,39 @@ [keys forms preds gfn] (let [id (java.util.UUID/randomUUID) kps (zipmap keys preds) - cform (let [specs (delay (mapv specize preds))] - (fn [x] - (let [specs @specs] - (loop [i 0] - (if (< i (count specs)) - (let [spec (specs i)] - (let [ret (conform* spec x)] - (if (= ::invalid ret) - (recur (inc i)) - (tagged-ret (keys i) ret)))) - ::invalid)))))] + specs (delay (mapv specize preds)) + cform (case (count preds) + 2 (fn [x] + (let [specs @specs + ret (conform* (specs 0) x)] + (if (= ::invalid ret) + (let [ret (conform* (specs 1) x)] + (if (= ::invalid ret) + ::invalid + (tagged-ret (keys 1) ret))) + (tagged-ret (keys 0) ret)))) + 3 (fn [x] + (let [specs @specs + ret (conform* (specs 0) x)] + (if (= ::invalid ret) + (let [ret (conform* (specs 1) x)] + (if (= ::invalid ret) + (let [ret (conform* (specs 2) x)] + (if (= ::invalid ret) + ::invalid + (tagged-ret (keys 2) ret))) + (tagged-ret (keys 1) ret))) + (tagged-ret (keys 0) ret)))) + (fn [x] + (let [specs @specs] + (loop [i 0] + (if (< i (count specs)) + (let [spec (specs i)] + (let [ret (conform* spec x)] + (if (= ::invalid ret) + (recur (inc i)) + (tagged-ret (keys i) ret)))) + ::invalid)))))] (reify Spec (conform* [_ x] (cform x)) @@ -1014,14 +1036,42 @@ (defn ^:skip-wiki and-spec-impl "Do not call this directly, use 'and'" [forms preds gfn] - (reify - Spec - (conform* [_ x] (and-preds x preds forms)) - (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) - (explain* [_ path via in x] (explain-pred-list forms preds path via in x)) - (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms)))) - (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) - (describe* [_] `(and ~@forms)))) + (let [specs (delay (mapv specize preds)) + cform + (case (count preds) + 2 (fn [x] + (let [specs @specs + ret (conform* (specs 0) x)] + (if (= ::invalid ret) + ::invalid + (conform* (specs 1) ret)))) + 3 (fn [x] + (let [specs @specs + ret (conform* (specs 0) x)] + (if (= ::invalid ret) + ::invalid + (let [ret (conform* (specs 1) ret)] + (if (= ::invalid ret) + ::invalid + (conform* (specs 2) ret)))))) + (fn [x] + (let [specs @specs] + (loop [ret x i 0] + (if (< i (count specs)) + (let [nret (conform* (specs i) ret)] + (if (= ::invalid nret) + ::invalid + ;;propagate conformed values + (recur nret (inc i)))) + ret)))))] + (reify + Spec + (conform* [_ x] (cform x)) + (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) + (explain* [_ path via in x] (explain-pred-list forms preds path via in x)) + (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms)))) + (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) + (describe* [_] `(and ~@forms))))) (defn ^:skip-wiki merge-spec-impl "Do not call this directly, use 'merge'" @@ -1609,10 +1659,27 @@ (with-gen (clojure.spec/& (* (cat ::k keyword? ::v any?)) ::kvs->map mspec#) (fn [] (gen/fmap (fn [m#] (apply concat m#)) (gen mspec#)))))) +(defn nonconforming + "takes a spec and returns a spec that has the same properties except + 'conform' returns the original (not the conformed) value. Note, will specize regex ops." + [spec] + (let [spec (specize spec)] + (reify + Spec + (conform* [_ x] (let [ret (conform* spec x)] + (if (= ::invalid ret) + ::invalid + x))) + (unform* [_ x] (unform* spec x)) + (explain* [_ path via in x] (explain* spec path via in x)) + (gen* [_ overrides path rmap] (gen* spec overrides path rmap)) + (with-gen* [_ gfn] (nonconforming (with-gen* spec gfn))) + (describe* [_] `(nonconforming ~(describe* spec)))))) + (defmacro nilable - "returns a spec that accepts nil and values satisfiying pred" + "returns a spec that accepts nil and values satisfying pred" [pred] - `(and (or ::nil nil? ::pred ~pred) (conformer second #(if (nil? %) [::nil nil] [::pred %])))) + `(nonconforming (or ::nil nil? ::pred ~pred))) (defn exercise "generates a number (default 10) of values compatible with spec and maps conform over them, From 021a3adf131d3f4158acd9e5d08ca91eb36ab56d Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Thu, 1 Sep 2016 20:42:01 -0400 Subject: [PATCH 129/246] perf tweaks --- src/clj/clojure/spec.clj | 268 +++++++++++++++++++++------------------ 1 file changed, 146 insertions(+), 122 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index f925f0fc..53b7063b 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -118,23 +118,33 @@ (throw (Exception. (str "Unable to resolve spec: " spec-or-k)))))) (defprotocol Specize - (specize* [_])) + (specize* [_] [_ form])) (extend-protocol Specize clojure.lang.Keyword - (specize* [k] (specize* (reg-resolve! k))) + (specize* ([k] (specize* (reg-resolve! k))) + ([k _] (specize* (reg-resolve! k)))) clojure.lang.Symbol - (specize* [s] (specize* (reg-resolve! s))) + (specize* ([s] (specize* (reg-resolve! s))) + ([s _] (specize* (reg-resolve! s)))) clojure.spec.Spec - (specize* [s] s) + (specize* ([s] s) + ([s _] s)) Object - (specize* [o] (spec-impl ::unknown o nil nil))) + (specize* ([o] (spec-impl ::unknown o nil nil)) + ([o form] (spec-impl form o nil nil)))) -(defn- specize [s] - (specize* s)) +(defn- specize + ([s] (specize* s)) + ([s form] (specize* s form))) + +(defn invalid? + "tests the validity of a conform return value" + [ret] + (identical? ::invalid ret)) (defn conform "Given a spec and a value, returns :clojure.spec/invalid if value does not match spec, @@ -426,26 +436,28 @@ req-keys (into req-keys (map unk req-un-specs)) opt-keys (into (vec opt) (map unk opt-un)) opt-specs (into (vec opt) opt-un) + gx (gensym) parse-req (fn [rk f] (map (fn [x] (if (keyword? x) - `#(contains? % ~(f x)) - (let [gx (gensym)] - `(fn* [~gx] - ~(walk/postwalk - (fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y)) - x))))) + `(contains? ~gx ~(f x)) + (walk/postwalk + (fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y)) + x))) rk)) - pred-exprs [`map?] + pred-exprs [`(map? ~gx)] pred-exprs (into pred-exprs (parse-req req identity)) pred-exprs (into pred-exprs (parse-req req-un unk)) + keys-pred `(fn* [~gx] (c/and ~@pred-exprs)) + pred-exprs (mapv (fn [e] `(fn* [~gx] ~e)) pred-exprs) pred-forms (walk/postwalk res pred-exprs)] - ;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen) + ;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen) `(map-spec-impl {:req '~req :opt '~opt :req-un '~req-un :opt-un '~opt-un :req-keys '~req-keys :req-specs '~req-specs :opt-keys '~opt-keys :opt-specs '~opt-specs :pred-forms '~pred-forms :pred-exprs ~pred-exprs + :keys-pred ~keys-pred :gfn ~gen}))) (defmacro or @@ -651,7 +663,7 @@ [v args] (let [fn-spec (get-spec v)] (when-let [arg-spec (:args fn-spec)] - (when (= ::invalid (conform arg-spec args)) + (when (invalid? (conform arg-spec args)) (let [ed (assoc (explain-data* arg-spec [:args] (if-let [name (spec-name arg-spec)] [name] []) [] args) ::args args)] @@ -720,9 +732,18 @@ (defn valid? "Helper function that returns true when x is valid for spec." ([spec x] - (not= ::invalid (dt spec x ::unknown))) + (let [spec (specize spec)] + (not (invalid? (conform* spec x))))) ([spec x form] - (not= ::invalid (dt spec x form)))) + (let [spec (specize spec form)] + (not (invalid? (conform* spec x)))))) + +(defn- pvalid? + "internal helper function that returns true when x is valid for spec." + ([pred x] + (not (invalid? (dt pred x ::unknown)))) + ([pred x form] + (not (invalid? (dt pred x form))))) (defn- explain-1 [form pred path via in v] ;;(prn {:form form :pred pred :path path :in in :v v}) @@ -733,36 +754,35 @@ (defn ^:skip-wiki map-spec-impl "Do not call this directly, use 'spec' with a map argument" - [{:keys [req-un opt-un pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn] + [{:keys [req-un opt-un keys-pred pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn] :as argm}] - (let [keys-pred (apply every-pred pred-exprs) - k->s (zipmap (concat req-keys opt-keys) (concat req-specs opt-specs)) - keys->specs #(c/or (k->s %) %) + (let [k->s (zipmap (concat req-keys opt-keys) (concat req-specs opt-specs)) + keys->specnames #(c/or (k->s %) %) id (java.util.UUID/randomUUID)] (reify Spec (conform* [_ m] (if (keys-pred m) (let [reg (registry)] - (loop [ret m, [k & ks :as keys] (c/keys m)] + (loop [ret m, [[k v] & ks :as keys] m] (if keys - (if (contains? reg (keys->specs k)) - (let [v (get m k) - cv (conform (keys->specs k) v)] - (if (= cv ::invalid) - ::invalid - (recur (if (identical? cv v) ret (assoc ret k cv)) - ks))) - (recur ret ks)) + (let [sname (keys->specnames k)] + (if-let [s (get reg sname)] + (let [cv (conform s v)] + (if (invalid? cv) + ::invalid + (recur (if (identical? cv v) ret (assoc ret k cv)) + ks))) + (recur ret ks))) ret))) ::invalid)) (unform* [_ m] (let [reg (registry)] (loop [ret m, [k & ks :as keys] (c/keys m)] (if keys - (if (contains? reg (keys->specs k)) + (if (contains? reg (keys->specnames k)) (let [cv (get m k) - v (unform (keys->specs k) cv)] + v (unform (keys->specnames k) cv)] (recur (if (identical? cv v) ret (assoc ret k v)) ks)) (recur ret ks)) @@ -780,9 +800,9 @@ #(identity {:path path :pred % :val x :via via :in in}) probs)) (map (fn [[k v]] - (when-not (c/or (not (contains? reg (keys->specs k))) - (valid? (keys->specs k) v k)) - (explain-1 (keys->specs k) (keys->specs k) (conj path k) via (conj in k) v))) + (when-not (c/or (not (contains? reg (keys->specnames k))) + (pvalid? (keys->specnames k) v k)) + (explain-1 (keys->specnames k) (keys->specnames k) (conj path k) via (conj in k) v))) (seq x)))))) (gen* [_ overrides path rmap] (if gfn @@ -825,16 +845,17 @@ :else (reify Spec - (conform* [_ x] (if cpred? - (pred x) - (if (pred x) x ::invalid))) + (conform* [_ x] (let [ret (pred x)] + (if cpred? + ret + (if ret x ::invalid)))) (unform* [_ x] (if cpred? (if unc (unc x) (throw (IllegalStateException. "no unform fn for conformer"))) x)) (explain* [_ path via in x] - (when (= ::invalid (dt pred x form cpred?)) + (when (invalid? (dt pred x form cpred?)) [{:path path :pred (abbrev form) :val x :via via :in in}])) (gen* [_ _ _ _] (if gfn (gfn) @@ -881,7 +902,7 @@ #(tag % k) (gensub p overrides (conj path k) rmap (list 'method form k)))))))) gs (->> (methods @mmvar) - (remove (fn [[k]] (= k ::invalid))) + (remove (fn [[k]] (invalid? k))) (map gen) (remove nil?))] (when (every? identity gs) @@ -893,56 +914,59 @@ "Do not call this directly, use 'tuple'" ([forms preds] (tuple-impl forms preds nil)) ([forms preds gfn] - (reify - Spec - (conform* [_ x] - (if-not (c/and (vector? x) - (= (count x) (count preds))) - ::invalid - (loop [ret x, i 0] - (if (= i (count x)) - ret - (let [v (x i) - cv (dt (preds i) v (forms i))] - (if (= ::invalid cv) - ::invalid - (recur (if (identical? cv v) ret (assoc ret i cv)) - (inc i)))))))) - (unform* [_ x] - (c/assert (c/and (vector? x) - (= (count x) (count preds)))) - (loop [ret x, i 0] - (if (= i (count x)) - ret - (let [cv (x i) - v (unform (preds i) cv)] - (recur (if (identical? cv v) ret (assoc ret i v)) - (inc i)))))) - (explain* [_ path via in x] - (cond - (not (vector? x)) - [{:path path :pred 'vector? :val x :via via :in in}] - - (not= (count x) (count preds)) - [{:path path :pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}] - - :else - (apply concat - (map (fn [i form pred] - (let [v (x i)] - (when-not (valid? pred v) - (explain-1 form pred (conj path i) via (conj in i) v)))) - (range (count preds)) forms preds)))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [gen (fn [i p f] - (gensub p overrides (conj path i) rmap f)) - gs (map gen (range (count preds)) preds forms)] - (when (every? identity gs) - (apply gen/tuple gs))))) - (with-gen* [_ gfn] (tuple-impl forms preds gfn)) - (describe* [_] `(tuple ~@forms))))) + (let [specs (delay (mapv specize* preds forms)) + cnt (count preds)] + (reify + Spec + (conform* [_ x] + (let [specs @specs] + (if-not (c/and (vector? x) + (= (count x) cnt)) + ::invalid + (loop [ret x, i 0] + (if (= i cnt) + ret + (let [v (x i) + cv (conform* (specs i) v)] + (if (invalid? cv) + ::invalid + (recur (if (identical? cv v) ret (assoc ret i cv)) + (inc i))))))))) + (unform* [_ x] + (c/assert (c/and (vector? x) + (= (count x) (count preds)))) + (loop [ret x, i 0] + (if (= i (count x)) + ret + (let [cv (x i) + v (unform (preds i) cv)] + (recur (if (identical? cv v) ret (assoc ret i v)) + (inc i)))))) + (explain* [_ path via in x] + (cond + (not (vector? x)) + [{:path path :pred 'vector? :val x :via via :in in}] + + (not= (count x) (count preds)) + [{:path path :pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}] + + :else + (apply concat + (map (fn [i form pred] + (let [v (x i)] + (when-not (pvalid? pred v) + (explain-1 form pred (conj path i) via (conj in i) v)))) + (range (count preds)) forms preds)))) + (gen* [_ overrides path rmap] + (if gfn + (gfn) + (let [gen (fn [i p f] + (gensub p overrides (conj path i) rmap f)) + gs (map gen (range (count preds)) preds forms)] + (when (every? identity gs) + (apply gen/tuple gs))))) + (with-gen* [_ gfn] (tuple-impl forms preds gfn)) + (describe* [_] `(tuple ~@forms)))))) (defn- tagged-ret [tag ret] (clojure.lang.MapEntry. tag ret)) @@ -952,25 +976,25 @@ [keys forms preds gfn] (let [id (java.util.UUID/randomUUID) kps (zipmap keys preds) - specs (delay (mapv specize preds)) + specs (delay (mapv specize preds forms)) cform (case (count preds) 2 (fn [x] (let [specs @specs ret (conform* (specs 0) x)] - (if (= ::invalid ret) + (if (invalid? ret) (let [ret (conform* (specs 1) x)] - (if (= ::invalid ret) + (if (invalid? ret) ::invalid (tagged-ret (keys 1) ret))) (tagged-ret (keys 0) ret)))) 3 (fn [x] (let [specs @specs ret (conform* (specs 0) x)] - (if (= ::invalid ret) + (if (invalid? ret) (let [ret (conform* (specs 1) x)] - (if (= ::invalid ret) + (if (invalid? ret) (let [ret (conform* (specs 2) x)] - (if (= ::invalid ret) + (if (invalid? ret) ::invalid (tagged-ret (keys 2) ret))) (tagged-ret (keys 1) ret))) @@ -981,7 +1005,7 @@ (if (< i (count specs)) (let [spec (specs i)] (let [ret (conform* spec x)] - (if (= ::invalid ret) + (if (invalid? ret) (recur (inc i)) (tagged-ret (keys i) ret)))) ::invalid)))))] @@ -990,10 +1014,10 @@ (conform* [_ x] (cform x)) (unform* [_ [k x]] (unform (kps k) x)) (explain* [this path via in x] - (when-not (valid? this x) + (when-not (pvalid? this x) (apply concat (map (fn [k form pred] - (when-not (valid? pred x) + (when-not (pvalid? pred x) (explain-1 form pred (conj path k) via in x))) keys forms preds)))) (gen* [_ overrides path rmap] @@ -1016,7 +1040,7 @@ [form & forms] forms] (if pred (let [nret (dt pred ret form)] - (if (= ::invalid nret) + (if (invalid? nret) ::invalid ;;propagate conformed values (recur nret preds forms))) @@ -1029,29 +1053,29 @@ [pred & preds] preds] (when pred (let [nret (dt pred ret form)] - (if (not= ::invalid nret) - (recur nret forms preds) - (explain-1 form pred path via in ret)))))) + (if (invalid? nret) + (explain-1 form pred path via in ret) + (recur nret forms preds)))))) (defn ^:skip-wiki and-spec-impl "Do not call this directly, use 'and'" [forms preds gfn] - (let [specs (delay (mapv specize preds)) + (let [specs (delay (mapv specize preds forms)) cform (case (count preds) 2 (fn [x] (let [specs @specs ret (conform* (specs 0) x)] - (if (= ::invalid ret) + (if (invalid? ret) ::invalid (conform* (specs 1) ret)))) 3 (fn [x] (let [specs @specs ret (conform* (specs 0) x)] - (if (= ::invalid ret) + (if (invalid? ret) ::invalid (let [ret (conform* (specs 1) ret)] - (if (= ::invalid ret) + (if (invalid? ret) ::invalid (conform* (specs 2) ret)))))) (fn [x] @@ -1059,7 +1083,7 @@ (loop [ret x i 0] (if (< i (count specs)) (let [nret (conform* (specs i) ret)] - (if (= ::invalid nret) + (if (invalid? nret) ::invalid ;;propagate conformed values (recur nret (inc i)))) @@ -1079,7 +1103,7 @@ (reify Spec (conform* [_ x] (let [ms (map #(dt %1 x %2) preds forms)] - (if (some #{::invalid} ms) + (if (some invalid? ms) ::invalid (apply c/merge ms)))) (unform* [_ x] (apply c/merge (map #(unform % x) (reverse preds)))) @@ -1102,7 +1126,7 @@ (let [pred (c/or kfn coll?) kform (c/or kform `coll?)] (cond - (not (valid? pred x)) + (not (pvalid? pred x)) (explain-1 kform pred path via in x) (c/and distinct (not (empty? x)) (not (apply distinct? x))) @@ -1127,7 +1151,7 @@ :as opts} gfn] (let [conform-into gen-into - check? #(valid? pred %) + check? #(pvalid? pred %) kfn (c/or kfn (fn [i v] i)) addcv (fn [ret i v cv] (conj ret cv)) cfns (fn [x] @@ -1166,7 +1190,7 @@ (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)] (if vseq (let [cv (dt pred v nil)] - (if (= ::invalid cv) + (if (invalid? cv) ::invalid (recur (add ret i v cv) (inc i) vs))) (complete ret)))) @@ -1326,7 +1350,7 @@ ::amp (c/and (accept-nil? p1) (c/or (noret? p1 (preturn p1)) (let [ret (-> (preturn p1) (and-preds ps (next forms)))] - (not= ret ::invalid)))) + (not (invalid? ret))))) ::rep (c/or (identical? p1 p2) (accept-nil? p1)) ::pcat (every? accept-nil? ps) ::alt (c/some accept-nil? ps)))) @@ -1389,11 +1413,11 @@ (case op ::accept nil nil (let [ret (dt p x p)] - (when-not (= ::invalid ret) (accept ret))) + (when-not (invalid? ret) (accept ret))) ::amp (when-let [p1 (deriv p1 x)] (if (= ::accept (::op p1)) (let [ret (-> (preturn p1) (and-preds ps (next forms)))] - (when-not (= ret ::invalid) + (when-not (invalid? ret) (accept ret))) (amp-impl p1 ps forms))) ::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret}) @@ -1579,12 +1603,12 @@ (defn- call-valid? [f specs args] (let [cargs (conform (:args specs) args)] - (when-not (= cargs ::invalid) + (when-not (invalid? cargs) (let [ret (apply f args) cret (conform (:ret specs) ret)] - (c/and (not= cret ::invalid) + (c/and (not (invalid? cret)) (if (:fn specs) - (valid? (:fn specs) {:args cargs :ret cret}) + (pvalid? (:fn specs) {:args cargs :ret cret}) true)))))) (defn- validate-fn @@ -1622,7 +1646,7 @@ [{:path path :pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via :in in}] (let [cret (dt retspec ret rform)] - (if (= ::invalid cret) + (if (invalid? cret) (explain-1 rform retspec (conj path :ret) via in ret) (when fnspec (let [cargs (conform argspec args)] @@ -1632,7 +1656,7 @@ (gfn) (gen/return (fn [& args] - (c/assert (valid? argspec args) (with-out-str (explain argspec args))) + (c/assert (pvalid? argspec args) (with-out-str (explain argspec args))) (gen/generate (gen retspec overrides)))))) (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn)) (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform))))) @@ -1667,7 +1691,7 @@ (reify Spec (conform* [_ x] (let [ret (conform* spec x)] - (if (= ::invalid ret) + (if (invalid? ret) ::invalid x))) (unform* [_ x] (unform* spec x)) From 9fa85c6a908c9a3e89b4c0c449c49887a4c35248 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 7 Sep 2016 15:19:19 -0400 Subject: [PATCH 130/246] perf tweaks --- src/clj/clojure/spec.clj | 142 +++++++++++++++++++++++++++------------ 1 file changed, 99 insertions(+), 43 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 53b7063b..b6ff66a4 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -72,7 +72,8 @@ (defn spec? "returns x if x is a spec object, else logical false" [x] - (c/and (extends? Spec (class x)) x)) + (when (instance? clojure.spec.Spec x) + x)) (defn regex? "returns x if x is a (clojure.spec) regex op, else logical false" @@ -129,17 +130,13 @@ (specize* ([s] (specize* (reg-resolve! s))) ([s _] (specize* (reg-resolve! s)))) - clojure.spec.Spec - (specize* ([s] s) - ([s _] s)) - Object (specize* ([o] (spec-impl ::unknown o nil nil)) ([o form] (spec-impl form o nil nil)))) (defn- specize - ([s] (specize* s)) - ([s form] (specize* s form))) + ([s] (c/or (spec? s) (specize* s))) + ([s form] (c/or (spec? s) (specize* s form)))) (defn invalid? "tests the validity of a conform return value" @@ -525,8 +522,19 @@ See also - coll-of, every-kv " [pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}] - (let [nopts (-> opts (dissoc :gen) (assoc ::kind-form `'~(res (:kind opts))))] - `(every-impl '~pred ~pred ~nopts ~gen))) + (let [nopts (-> opts (dissoc :gen) (assoc ::kind-form `'~(res (:kind opts)))) + gx (gensym) + cpreds (cond-> [(list (c/or kind `coll?) gx)] + count (conj `(= ~count (bounded-count ~count ~gx))) + + (c/or min-count max-count) + (conj `(<= (c/or ~min-count 0) + (bounded-count (if ~max-count (inc ~max-count) ~min-count) ~gx) + (c/or ~max-count Integer/MAX_VALUE))) + + distinct + (conj `(c/or (empty? ~gx) (apply distinct? ~gx))))] + `(every-impl '~pred ~pred ~(assoc nopts ::cpred `(fn* [~gx] (c/and ~@cpreds))) ~gen))) (defmacro every-kv "like 'every' but takes separate key and val preds and works on associative collections. @@ -760,6 +768,10 @@ keys->specnames #(c/or (k->s %) %) id (java.util.UUID/randomUUID)] (reify + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ m] (if (keys-pred m) @@ -844,6 +856,10 @@ (ident? pred) (cond-> (the-spec pred) gfn (with-gen gfn)) :else (reify + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ x] (let [ret (pred x)] (if cpred? @@ -877,6 +893,10 @@ #(assoc %1 retag %2) retag)] (reify + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ x] (if-let [pred (predx x)] (dt pred x form) @@ -914,9 +934,13 @@ "Do not call this directly, use 'tuple'" ([forms preds] (tuple-impl forms preds nil)) ([forms preds gfn] - (let [specs (delay (mapv specize* preds forms)) + (let [specs (delay (mapv specize preds forms)) cnt (count preds)] (reify + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ x] (let [specs @specs] @@ -1010,6 +1034,10 @@ (tagged-ret (keys i) ret)))) ::invalid)))))] (reify + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ x] (cform x)) (unform* [_ [k x]] (unform (kps k) x)) @@ -1089,6 +1117,10 @@ (recur nret (inc i)))) ret)))))] (reify + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ x] (cform x)) (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) @@ -1101,6 +1133,10 @@ "Do not call this directly, use 'merge'" [forms preds gfn] (reify + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ x] (let [ms (map #(dt %1 x %2) preds forms)] (if (some invalid? ms) @@ -1129,9 +1165,6 @@ (not (pvalid? pred x)) (explain-1 kform pred path via in x) - (c/and distinct (not (empty? x)) (not (apply distinct? x))) - [{:path path :pred 'distinct? :val x :via via :in in}] - (c/and count (not= count (bounded-count count x))) [{:path path :pred `(= ~count (c/count ~'%)) :val x :via via :in in}] @@ -1139,19 +1172,23 @@ (not (<= (c/or min-count 0) (bounded-count (if max-count (inc max-count) min-count) x) (c/or max-count Integer/MAX_VALUE)))) - [{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}]))) + [{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}] + + (c/and distinct (not (empty? x)) (not (apply distinct? x))) + [{:path path :pred 'distinct? :val x :via via :in in}]))) (defn ^:skip-wiki every-impl "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'" ([form pred opts] (every-impl form pred opts nil)) ([form pred {gen-into :into - :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn + :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn ::cpred conform-keys ::conform-all] :or {gen-max 20} :as opts} gfn] (let [conform-into gen-into - check? #(pvalid? pred %) + spec (delay (specize pred)) + check? #(valid? @spec %) kfn (c/or kfn (fn [i v] i)) addcv (fn [ret i v cv] (conj ret cv)) cfns (fn [x] @@ -1178,35 +1215,42 @@ :else [#(empty (c/or conform-into %)) addcv identity]))] (reify + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ x] - (cond - (coll-prob x kind kind-form distinct count min-count max-count - nil nil nil) - ::invalid - - conform-all - (let [[init add complete] (cfns x)] - (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)] - (if vseq - (let [cv (dt pred v nil)] - (if (invalid? cv) - ::invalid - (recur (add ret i v cv) (inc i) vs))) - (complete ret)))) - - - :else - (if (indexed? x) - (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))] - (loop [i 0] - (if (>= i (c/count x)) - x - (if (check? (nth x i)) - (recur (c/+ i step)) - ::invalid)))) - (c/or (c/and (every? check? (take *coll-check-limit* x)) x) - ::invalid)))) + (let [spec @spec] + (cond + (not (cpred x)) ::invalid + + conform-all + (let [[init add complete] (cfns x)] + (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)] + (if vseq + (let [cv (conform* spec v)] + (if (invalid? cv) + ::invalid + (recur (add ret i v cv) (inc i) vs))) + (complete ret)))) + + + :else + (if (indexed? x) + (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))] + (loop [i 0] + (if (>= i (c/count x)) + x + (if (valid? spec (nth x i)) + (recur (c/+ i step)) + ::invalid)))) + (let [limit *coll-check-limit*] + (loop [i 0 [v & vs :as vseq] (seq x)] + (cond + (c/or (nil? vseq) (= i limit)) x + (valid? spec v) (recur (inc i) vs) + :else ::invalid))))))) (unform* [_ x] x) (explain* [_ path via in x] (c/or (coll-prob x kind kind-form distinct count min-count max-count @@ -1581,6 +1625,10 @@ "Do not call this directly, use 'spec' with a regex op argument" [re gfn] (reify + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ x] (if (c/or (nil? x) (coll? x)) @@ -1630,6 +1678,10 @@ (valAt [this k] (get specs k)) (valAt [_ k not-found] (get specs k not-found)) + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ f] (if (ifn? f) (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) @@ -1689,6 +1741,10 @@ [spec] (let [spec (specize spec)] (reify + Specize + (specize* [s] s) + (specize* [s _] s) + Spec (conform* [_ x] (let [ret (conform* spec x)] (if (invalid? ret) From aaa982a89acfbb48bf052149d76f966f71617620 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 26 Aug 2016 12:41:40 -0500 Subject: [PATCH 131/246] CLJ-2012 Fix bad spec on gen-class signatures to allow class names as strings Signed-off-by: Stuart Halloway --- src/clj/clojure/core/specs.clj | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/clj/clojure/core/specs.clj b/src/clj/clojure/core/specs.clj index c66c6066..d8adc464 100644 --- a/src/clj/clojure/core/specs.clj +++ b/src/clj/clojure/core/specs.clj @@ -158,7 +158,8 @@ (s/def ::extends simple-symbol?) (s/def ::implements (s/coll-of simple-symbol? :kind vector?)) (s/def ::init symbol?) -(s/def ::signature (s/coll-of simple-symbol? :kind vector?)) +(s/def ::class-ident (s/or :class simple-symbol? :class-name string?)) +(s/def ::signature (s/coll-of ::class-ident :kind vector?)) (s/def ::constructors (s/map-of ::signature ::signature)) (s/def ::post-init symbol?) (s/def ::method (s/and vector? From 6d928d0ba6f839211a5e3178aba9664cd4fab05e Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 23 Aug 2016 12:33:43 -0500 Subject: [PATCH 132/246] CLJ-2008 omit macros from checkable-syms Signed-off-by: Stuart Halloway --- src/clj/clojure/spec/test.clj | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index a7d32a6f..73d34a30 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -193,7 +193,8 @@ failure in instrument." (defn- fn-spec-name? [s] - (symbol? s)) + (and (symbol? s) + (not (some-> (resolve s) meta :macro)))) (defn instrumentable-syms "Given an opts map as per instrument, returns the set of syms From 7cc165f5370aa3fb71fa5834e1886ba9552a3dbe Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 23 Aug 2016 12:39:11 -0500 Subject: [PATCH 133/246] CLJ-2006 Fix old function name in docstring Signed-off-by: Stuart Halloway --- src/clj/clojure/spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index b6ff66a4..957385a5 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -697,7 +697,7 @@ by calling get-spec with the var or fully-qualified symbol. Once registered, function specs are included in doc, checked by - instrument, tested by the runner clojure.spec.test/run-tests, and (if + instrument, tested by the runner clojure.spec.test/check, and (if a macro) used to explain errors during macroexpansion. Note that :fn specs require the presence of :args and :ret specs to From 5e83c2ab898fefe655ee45495d56d69a6bd10304 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 30 Aug 2016 10:36:57 -0500 Subject: [PATCH 134/246] CLJ-2004 include retag in multi-spec form Signed-off-by: Stuart Halloway --- src/clj/clojure/spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 957385a5..def7d3f0 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -928,7 +928,7 @@ (when (every? identity gs) (gen/one-of gs))))) (with-gen* [_ gfn] (multi-spec-impl form mmvar retag gfn)) - (describe* [_] `(multi-spec ~form)))))) + (describe* [_] `(multi-spec ~form ~retag)))))) (defn ^:skip-wiki tuple-impl "Do not call this directly, use 'tuple'" From edf869a0fa56df3aa2503980af65931d76e2e00b Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 23 Aug 2016 16:43:34 -0500 Subject: [PATCH 135/246] CLJ-1988 Extend coll-of to handle sequences Signed-off-by: Stuart Halloway --- src/clj/clojure/spec.clj | 4 ++-- test/clojure/test_clojure/spec.clj | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index def7d3f0..23e7e6e1 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1209,8 +1209,8 @@ ret (assoc ret (nth (if conform-keys cv v) 0) (nth cv 1)))) identity] - - (c/or (list? conform-into) (c/and (not conform-into) (list? x))) + + (c/or (list? conform-into) (seq? conform-into) (c/and (not conform-into) (c/or (list? x) (seq? x)))) [(constantly ()) addcv reverse] :else [#(empty (c/or conform-into %)) addcv identity]))] diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index c388693b..481e940e 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -143,6 +143,7 @@ coll [] [] nil coll [:a] [:a] nil coll [:a :b] [:a :b] nil + coll (map identity [:a :b]) '(:a :b) nil ;;coll [:a "b"] ::s/invalid '[{:pred (coll-checker keyword?), :val [:a b]}] ))) From 131865556fe0350ad7103efc142779b3fca43319 Mon Sep 17 00:00:00 2001 From: Jason Whitlark Date: Tue, 13 Oct 2015 10:54:44 -0700 Subject: [PATCH 136/246] CLJ-1673 Improve clojure.repl/dir-fn. dir-fn will now work on namespace aliases in addition to canonical namespaces. Add test for same, compatible with direct linking, introduced in Clojure 1.8.0-alpha3. Signed-off-by: Stuart Halloway --- src/clj/clojure/repl.clj | 4 ++-- test/clojure/test_clojure/repl.clj | 2 ++ 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/repl.clj b/src/clj/clojure/repl.clj index e77b7884..2dec1f3f 100644 --- a/src/clj/clojure/repl.clj +++ b/src/clj/clojure/repl.clj @@ -195,9 +195,9 @@ str-or-pattern." (defn dir-fn "Returns a sorted seq of symbols naming public vars in - a namespace" + a namespace or namespace alias. Looks for aliases in *ns*" [ns] - (sort (map first (ns-publics (the-ns ns))))) + (sort (map first (ns-publics (the-ns (get (ns-aliases *ns*) ns ns)))))) (defmacro dir "Prints a sorted directory of public vars in a namespace" diff --git a/test/clojure/test_clojure/repl.clj b/test/clojure/test_clojure/repl.clj index 609056b5..17bd0842 100644 --- a/test/clojure/test_clojure/repl.clj +++ b/test/clojure/test_clojure/repl.clj @@ -24,6 +24,8 @@ (deftest test-dir (is (thrown? Exception (dir-fn 'non-existent-ns))) (is (= '[bar foo] (dir-fn 'clojure.test-clojure.repl.example))) + (binding [*ns* (the-ns 'clojure.test-clojure.repl)] + (is (= (dir-fn 'clojure.string) (dir-fn 'str)))) (is (= (platform-newlines "bar\nfoo\n") (with-out-str (dir clojure.test-clojure.repl.example))))) (deftest test-apropos From a1c3dafec01ab02fb10d91f98b9ffd3241e860c0 Mon Sep 17 00:00:00 2001 From: Nicola Mometto Date: Tue, 6 Sep 2016 14:08:40 -0500 Subject: [PATCH 137/246] CLJ-1224: cache hasheq and hashCode for records Signed-off-by: Stuart Halloway --- src/clj/clojure/core_deftype.clj | 43 +++++++---- src/jvm/clojure/lang/Compiler.java | 73 +++++++++++++++++-- test/clojure/test_clojure/data_structures.clj | 15 +++- 3 files changed, 109 insertions(+), 22 deletions(-) diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj index 723ed24c..8795ee5d 100644 --- a/src/clj/clojure/core_deftype.clj +++ b/src/clj/clojure/core_deftype.clj @@ -156,7 +156,9 @@ hinted-fields fields fields (vec (map #(with-meta % nil) fields)) base-fields fields - fields (conj fields '__meta '__extmap) + fields (conj fields '__meta '__extmap + '^:unsynchronized-mutable __hash + '^:unsynchronized-mutable __hasheq) type-hash (hash classname)] (when (some #{:volatile-mutable :unsynchronized-mutable} (mapcat (comp keys meta) hinted-fields)) (throw (IllegalArgumentException. ":volatile-mutable or :unsynchronized-mutable not supported for record fields"))) @@ -168,8 +170,18 @@ (eqhash [[i m]] [(conj i 'clojure.lang.IHashEq) (conj m - `(hasheq [this#] (bit-xor ~type-hash (clojure.lang.APersistentMap/mapHasheq this#))) - `(hashCode [this#] (clojure.lang.APersistentMap/mapHash this#)) + `(hasheq [this#] (let [hq# ~'__hasheq] + (if (zero? hq#) + (let [h# (int (bit-xor ~type-hash (clojure.lang.APersistentMap/mapHasheq this#)))] + (set! ~'__hasheq h#) + h#) + hq#))) + `(hashCode [this#] (let [hash# ~'__hash] + (if (zero? hash#) + (let [h# (clojure.lang.APersistentMap/mapHash this#)] + (set! ~'__hash h#) + h#) + hash#))) `(equals [this# ~gs] (clojure.lang.APersistentMap/mapEquals this# ~gs)))]) (iobj [[i m]] [(conj i 'clojure.lang.IObj) @@ -220,12 +232,12 @@ `(assoc [this# k# ~gs] (condp identical? k# ~@(mapcat (fn [fld] - [(keyword fld) (list* `new tagname (replace {fld gs} fields))]) + [(keyword fld) (list* `new tagname (replace {fld gs} (remove '#{__hash __hasheq} fields)))]) base-fields) - (new ~tagname ~@(remove #{'__extmap} fields) (assoc ~'__extmap k# ~gs)))) + (new ~tagname ~@(remove '#{__extmap __hash __hasheq} fields) (assoc ~'__extmap k# ~gs)))) `(without [this# k#] (if (contains? #{~@(map keyword base-fields)} k#) (dissoc (with-meta (into {} this#) ~'__meta) k#) - (new ~tagname ~@(remove #{'__extmap} fields) + (new ~tagname ~@(remove '#{__extmap __hash __hasheq} fields) (not-empty (dissoc ~'__extmap k#))))))]) (ijavamap [[i m]] [(conj i 'java.util.Map 'java.io.Serializable) @@ -243,8 +255,11 @@ `(entrySet [this#] (set this#)))]) ] (let [[i m] (-> [interfaces methods] irecord eqhash iobj ilookup imap ijavamap)] - `(deftype* ~(symbol (name (ns-name *ns*)) (name tagname)) ~classname ~(conj hinted-fields '__meta '__extmap) - :implements ~(vec i) + `(deftype* ~(symbol (name (ns-name *ns*)) (name tagname)) ~classname + ~(conj hinted-fields '__meta '__extmap + '^int ^:unsynchronized-mutable __hash + '^int ^:unsynchronized-mutable __hasheq) + :implements ~(vec i) ~@(mapcat identity opts) ~@m)))))) @@ -280,7 +295,7 @@ [fields name] (when-not (vector? fields) (throw (AssertionError. "No fields vector given."))) - (let [specials #{'__meta '__extmap}] + (let [specials '#{__meta __hash __hasheq __extmap}] (when (some specials fields) (throw (AssertionError. (str "The names in " specials " cannot be used as field names for types or records."))))) (let [non-syms (remove symbol? fields)] @@ -357,9 +372,9 @@ Two constructors will be defined, one taking the designated fields followed by a metadata map (nil for none) and an extension field map (nil for none), and one taking only the fields (using nil for - meta and extension fields). Note that the field names __meta - and __extmap are currently reserved and should not be used when - defining your own records. + meta and extension fields). Note that the field names __meta, + __extmap, __hash and __hasheq are currently reserved and should not + be used when defining your own records. Given (defrecord TypeName ...), two factory functions will be defined: ->TypeName, taking positional parameters for the fields, @@ -465,8 +480,8 @@ writes the .class file to the *compile-path* directory. One constructor will be defined, taking the designated fields. Note - that the field names __meta and __extmap are currently reserved and - should not be used when defining your own types. + that the field names __meta, __extmap, __hash and __hasheq are currently + reserved and should not be used when defining your own types. Given (deftype TypeName ...), a factory function called ->TypeName will be defined, taking positional parameters for the fields" diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index 8bc97c77..7a17d090 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -4414,8 +4414,34 @@ void compile(String superName, String[] interfaceNames, boolean oneTimeUse) thro ctorgen.visitCode(); ctorgen.loadThis(); ctorgen.loadArgs(); - for(int i=0;i", Type.VOID_TYPE, ctorTypes)); + + ctorgen.returnValue(); + ctorgen.endMethod(); + + // alt ctor no __hash, __hasheq + altCtorTypes = new Type[ctorTypes.length-2]; + for(int i=0;i", Type.VOID_TYPE, altCtorTypes); + ctorgen = new GeneratorAdapter(ACC_PUBLIC, + alt, + null, + null, + cv); + ctorgen.visitCode(); + ctorgen.loadThis(); + ctorgen.loadArgs(); + + ctorgen.visitInsn(Opcodes.ICONST_0); //__hash + ctorgen.visitInsn(Opcodes.ICONST_0); //__hasheq ctorgen.invokeConstructor(objtype, new Method("", Type.VOID_TYPE, ctorTypes)); @@ -7766,7 +7792,11 @@ static ObjExpr build(IPersistentVector interfaceSyms, IPersistentVector fieldSym //use array map to preserve ctor order ret.closes = new PersistentArrayMap(closesvec); ret.fields = fmap; - for(int i=fieldSyms.count()-1;i >= 0 && (((Symbol)fieldSyms.nth(i)).name.equals("__meta") || ((Symbol)fieldSyms.nth(i)).name.equals("__extmap"));--i) + for(int i=fieldSyms.count()-1;i >= 0 && (((Symbol)fieldSyms.nth(i)).name.equals("__meta") + || ((Symbol)fieldSyms.nth(i)).name.equals("__extmap") + || ((Symbol)fieldSyms.nth(i)).name.equals("__hash") + || ((Symbol)fieldSyms.nth(i)).name.equals("__hasheq") + );--i) ret.altCtorDrops++; } //todo - set up volatiles @@ -7910,8 +7940,35 @@ static Class compileStub(String superName, NewInstanceExpr ret, String[] interfa ctorgen.visitCode(); ctorgen.loadThis(); ctorgen.loadArgs(); - for(int i=0;i", Type.VOID_TYPE, ctorTypes)); + + ctorgen.returnValue(); + ctorgen.endMethod(); + + // alt ctor no __hash, __hasheq + altCtorTypes = new Type[ctorTypes.length-2]; + for(int i=0;i", Type.VOID_TYPE, altCtorTypes); + ctorgen = new GeneratorAdapter(ACC_PUBLIC, + alt, + null, + null, + cv); + ctorgen.visitCode(); + ctorgen.loadThis(); + ctorgen.loadArgs(); + + ctorgen.visitInsn(Opcodes.ICONST_0); //__hash + ctorgen.visitInsn(Opcodes.ICONST_0); //__hasheq ctorgen.invokeConstructor(Type.getObjectType(COMPILE_STUB_PREFIX + "/" + ret.internalName), new Method("", Type.VOID_TYPE, ctorTypes)); @@ -8006,9 +8063,11 @@ protected void emitStatics(ClassVisitor cv) { } } - mv.visitInsn(ACONST_NULL); - mv.visitVarInsn(ALOAD, 0); + mv.visitInsn(ACONST_NULL); //__meta + mv.visitVarInsn(ALOAD, 0); //__extmap mv.visitMethodInsn(INVOKESTATIC, "clojure/lang/RT", "seqOrElse", "(Ljava/lang/Object;)Ljava/lang/Object;"); + mv.visitInsn(ICONST_0); //__hash + mv.visitInsn(ICONST_0); //__hasheq mv.visitMethodInsn(INVOKESPECIAL, className, "", ctor.getDescriptor()); mv.visitInsn(ARETURN); mv.visitMaxs(4+fieldCount, 1+fieldCount); diff --git a/test/clojure/test_clojure/data_structures.clj b/test/clojure/test_clojure/data_structures.clj index 9151ceb9..35cf501f 100644 --- a/test/clojure/test_clojure/data_structures.clj +++ b/test/clojure/test_clojure/data_structures.clj @@ -1287,4 +1287,17 @@ (defspec seq-and-iter-match-for-structs identity [^{:tag clojure.test-clojure.data-structures/gen-struct} s] - (seq-iter-match s s)) \ No newline at end of file + (seq-iter-match s s)) + +(deftest record-hashing + (let [r (->Rec 1 1) + _ (hash r) + r2 (assoc r :c 2)] + (is (= (hash (->Rec 1 1)) (hash r))) + (is (= (hash r) (hash (with-meta r {:foo 2})))) + (is (not= (hash (->Rec 1 1)) (hash (assoc (->Rec 1 1) :a 2)))) + (is (not= (hash (->Rec 1 1)) (hash r2))) + (is (not= (hash (->Rec 1 1)) (hash (assoc r :a 2)))) + (is (= (hash (->Rec 1 1)) (hash (assoc r :a 1)))) + (is (= (hash (->Rec 1 1)) (hash (dissoc r2 :c)))) + (is (= (hash (->Rec 1 1)) (hash (dissoc (assoc r :c 1) :c)))))) From 522ba8b82ba6eb6c50284a211e7533db51363b8f Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 30 Aug 2016 09:29:49 -0500 Subject: [PATCH 138/246] CLJ-1935 Use multimethod dispatch value method lookup to take hierarchies into account in multi-spec Signed-off-by: Stuart Halloway --- src/clj/clojure/spec.clj | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 23e7e6e1..c1f36168 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -885,8 +885,7 @@ ([form mmvar retag gfn] (let [id (java.util.UUID/randomUUID) predx #(let [^clojure.lang.MultiFn mm @mmvar] - (c/and (contains? (methods mm) - ((.dispatchFn mm) %)) + (c/and (.getMethod mm ((.dispatchFn mm) %)) (mm %))) dval #((.dispatchFn ^clojure.lang.MultiFn @mmvar) %) tag (if (keyword? retag) From e6c3b3f7e2f5d6be627720c6d2e3cac0368f0e9b Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Wed, 7 Sep 2016 15:48:34 -0500 Subject: [PATCH 139/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha12 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..4f7f151e 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha12 http://clojure.org/ Clojure core environment and runtime library. From f572a60262852af68cdb561784a517143a5847cf Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Wed, 7 Sep 2016 15:48:34 -0500 Subject: [PATCH 140/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 4f7f151e..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha12 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From 7ff4c70b13d29cf0a1fc7f19ba53413a38bb03d5 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Thu, 22 Sep 2016 13:18:35 -0500 Subject: [PATCH 141/246] Fix nilable conformance Signed-off-by: Rich Hickey --- src/clj/clojure/spec.clj | 45 ++++++++++++++++++++++++------ src/clj/clojure/spec/gen.clj | 2 +- test/clojure/test_clojure/spec.clj | 22 +++++++++++++++ 3 files changed, 59 insertions(+), 10 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index c1f36168..f571e3da 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1734,31 +1734,58 @@ (with-gen (clojure.spec/& (* (cat ::k keyword? ::v any?)) ::kvs->map mspec#) (fn [] (gen/fmap (fn [m#] (apply concat m#)) (gen mspec#)))))) -(defn nonconforming +(defn ^:skip-wiki nonconforming "takes a spec and returns a spec that has the same properties except 'conform' returns the original (not the conformed) value. Note, will specize regex ops." [spec] - (let [spec (specize spec)] + (let [spec (delay (specize spec))] (reify Specize (specize* [s] s) (specize* [s _] s) Spec - (conform* [_ x] (let [ret (conform* spec x)] + (conform* [_ x] (let [ret (conform* @spec x)] (if (invalid? ret) ::invalid x))) - (unform* [_ x] (unform* spec x)) - (explain* [_ path via in x] (explain* spec path via in x)) - (gen* [_ overrides path rmap] (gen* spec overrides path rmap)) - (with-gen* [_ gfn] (nonconforming (with-gen* spec gfn))) - (describe* [_] `(nonconforming ~(describe* spec)))))) + (unform* [_ x] x) + (explain* [_ path via in x] (explain* @spec path via in x)) + (gen* [_ overrides path rmap] (gen* @spec overrides path rmap)) + (with-gen* [_ gfn] (nonconforming (with-gen* @spec gfn))) + (describe* [_] `(nonconforming ~(describe* @spec)))))) + +(defn ^:skip-wiki nilable-impl + "Do not call this directly, use 'nilable'" + [form pred gfn] + (let [spec (delay (specize pred form))] + (reify + Specize + (specize* [s] s) + (specize* [s _] s) + + Spec + (conform* [_ x] (if (nil? x) nil (conform* @spec x))) + (unform* [_ x] (if (nil? x) nil (unform* @spec x))) + (explain* [_ path via in x] + (when-not (c/or (pvalid? @spec x) (nil? x)) + (conj + (explain-1 form pred (conj path ::pred) via in x) + {:path (conj path ::nil) :pred 'nil? :val x :via via :in in}))) + (gen* [_ overrides path rmap] + (if gfn + (gfn) + (gen/frequency + [[1 (gen/delay (gen/return nil))] + [9 (gen/delay (gensub pred overrides (conj path ::pred) rmap form))]]))) + (with-gen* [_ gfn] (nilable-impl form pred gfn)) + (describe* [_] `(nilable ~(describe* @spec)))))) (defmacro nilable "returns a spec that accepts nil and values satisfying pred" [pred] - `(nonconforming (or ::nil nil? ::pred ~pred))) + (let [pf (res pred)] + `(nilable-impl '~pf ~pred nil))) (defn exercise "generates a number (default 10) of values compatible with spec and maps conform over them, diff --git a/src/clj/clojure/spec/gen.clj b/src/clj/clojure/spec/gen.clj index 8f1c4e38..6d8e2388 100644 --- a/src/clj/clojure/spec/gen.clj +++ b/src/clj/clojure/spec/gen.clj @@ -91,7 +91,7 @@ (lazy-combinators hash-map list map not-empty set vector vector-distinct fmap elements bind choose fmap one-of such-that tuple sample return - large-integer* double*) + large-integer* double* frequency) (defmacro ^:skip-wiki lazy-prim "Implementation macro, do not call directly." diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 481e940e..4f08ecdd 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -147,6 +147,28 @@ ;;coll [:a "b"] ::s/invalid '[{:pred (coll-checker keyword?), :val [:a b]}] ))) +(defn check-conform-unform [spec vals expected-conforms] + (let [actual-conforms (map #(s/conform spec %) vals) + unforms (map #(s/unform spec %) actual-conforms)] + (is (= actual-conforms expected-conforms)) + (is (= vals unforms)))) + +(deftest nilable-conform-unform + (check-conform-unform + (s/nilable int?) + [5 nil] + [5 nil]) + (check-conform-unform + (s/nilable (s/or :i int? :s string?)) + [5 "x" nil] + [[:i 5] [:s "x"] nil])) + +(deftest nonconforming-conform-unform + (check-conform-unform + (s/nonconforming (s/or :i int? :s string?)) + [5 "x"] + [5 "x"])) + (comment (require '[clojure.test :refer (run-tests)]) (in-ns 'clojure.test-clojure.spec) From cfa0e126bad63e8f5eb6774c35fa78d19672b244 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Mon, 26 Sep 2016 13:23:36 -0500 Subject: [PATCH 142/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha13 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..7d1e3ac0 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha13 http://clojure.org/ Clojure core environment and runtime library. From 7ce2f66c6bf109783be282886a6031cf0afdbb7b Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Mon, 26 Sep 2016 13:23:36 -0500 Subject: [PATCH 143/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 7d1e3ac0..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha13 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From e547d35bb796051bb2cbf07bbca6ee67c5bc022f Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Tue, 4 Oct 2016 16:31:45 -0400 Subject: [PATCH 144/246] add arity 0/1 to into --- src/clj/clojure/core.clj | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 6b8a1b5e..9cc6ce21 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -6765,6 +6765,8 @@ from-coll conjoined. A transducer may be supplied." {:added "1.0" :static true} + ([] []) + ([to] to) ([to from] (if (instance? clojure.lang.IEditableCollection to) (with-meta (persistent! (reduce conj! (transient to) from)) (meta to)) From 7aad2f7dbb3a66019e5cef3726d52d721e9c60df Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 12 Oct 2016 15:37:51 -0400 Subject: [PATCH 145/246] added halt-when transducer --- src/clj/clojure/core.clj | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 9cc6ce21..72383d6b 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -7503,6 +7503,30 @@ ([result input] (reduce rrf result input))))) +(defn halt-when + "Returns a transducer that ends transduction when pred returns true + for an input. When retf is supplied it must be a fn of 2 arguments - + it will be passed the (completed) result so far and the input that + triggered the predicate, and its return value (if it does not throw + an exception) will be the return value of the transducer. If retf + is not supplied, the input that triggered the predicate will be + returned. If the predicate never returns true the transduction is + unaffected." + {:added "1.9"} + ([pred] (halt-when pred nil)) + ([pred retf] + (fn [rf] + (fn + ([] (rf)) + ([result] + (if (and (map? result) (contains? result ::halt)) + (::halt result) + (rf result))) + ([result input] + (if (pred input) + (reduced {::halt (if retf (retf (rf result) input) input)}) + (rf result input))))))) + (defn dedupe "Returns a lazy sequence removing consecutive duplicates in coll. Returns a transducer when no collection is provided." From ee9a3bd15c48057a6fa941671c2e341784d5cd6e Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 14 Oct 2016 13:21:16 -0500 Subject: [PATCH 146/246] CLJ-2042 s/form of s/? does not resolve pred Signed-off-by: Stuart Halloway --- src/clj/clojure/spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index f571e3da..e9e48fbf 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1481,7 +1481,7 @@ (list `+ rep+) (cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) forms))) ::alt (if maybe - (list `? maybe) + (list `? (res maybe)) (cons `alt (mapcat vector ks forms))) ::rep (list (if splice `+ `*) forms))))) From 48966ee6ed154ebb299be9d541906f84167d5933 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 3 Oct 2016 12:21:32 -0500 Subject: [PATCH 147/246] CLJ-2032 Add check that :args spec exists before conforming fspec Signed-off-by: Stuart Halloway --- src/clj/clojure/spec.clj | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index e9e48fbf..ae8ce8e0 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1682,9 +1682,11 @@ (specize* [s _] s) Spec - (conform* [_ f] (if (ifn? f) - (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) - ::invalid)) + (conform* [this f] (if argspec + (if (ifn? f) + (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) + ::invalid) + (throw (Exception. (str "Can't conform fspec without args spec: " (pr-str (describe this))))))) (unform* [_ f] f) (explain* [_ path via in f] (if (ifn? f) From 0b930f1e7e2bb2beef4ed1a12c51e4e17782666d Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 26 Sep 2016 12:42:03 -0500 Subject: [PATCH 148/246] CLJ-2027 Defer calling empty until later in namespace map printing Signed-off-by: Stuart Halloway --- src/clj/clojure/core_print.clj | 4 ++-- test/clojure/test_clojure/printer.clj | 5 ++++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/core_print.clj b/src/clj/clojure/core_print.clj index 6c75e879..f17e2f7a 100644 --- a/src/clj/clojure/core_print.clj +++ b/src/clj/clojure/core_print.clj @@ -236,7 +236,7 @@ (when *print-namespace-maps* (loop [ns nil [[k v :as entry] & entries] (seq m) - lm (empty m)] + lm {}] (if entry (when (or (keyword? k) (symbol? k)) (if ns @@ -244,7 +244,7 @@ (recur ns entries (assoc lm (strip-ns k) v))) (when-let [new-ns (namespace k)] (recur new-ns entries (assoc lm (strip-ns k) v))))) - [ns lm])))) + [ns (apply conj (empty m) lm)])))) (defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w] (print-meta m w) diff --git a/test/clojure/test_clojure/printer.clj b/test/clojure/test_clojure/printer.clj index 61efcf44..dc156187 100644 --- a/test/clojure/test_clojure/printer.clj +++ b/test/clojure/test_clojure/printer.clj @@ -136,4 +136,7 @@ (deftest print-ns-maps (is (= "#:user{:a 1}" (binding [*print-namespace-maps* true] (pr-str {:user/a 1})))) - (is (= "{:user/a 1}" (binding [*print-namespace-maps* false] (pr-str {:user/a 1}))))) + (is (= "{:user/a 1}" (binding [*print-namespace-maps* false] (pr-str {:user/a 1})))) + (let [date-map (bean (java.util.Date. 0))] + (is (= (binding [*print-namespace-maps* true] (pr-str date-map)) + (binding [*print-namespace-maps* false] (pr-str date-map)))))) From c6b76fadb4750c8f73d842cfdf882b4a05683cae Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 28 Oct 2016 08:42:26 -0500 Subject: [PATCH 149/246] CLJ-2024 stest/check should resolve function spec Signed-off-by: Stuart Halloway --- src/clj/clojure/spec/test.clj | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj index 73d34a30..587f441e 100644 --- a/src/clj/clojure/spec/test.clj +++ b/src/clj/clojure/spec/test.clj @@ -323,15 +323,16 @@ with explain-data + ::s/failure." (defn- check-1 [{:keys [s f v spec]} opts] (let [re-inst? (and v (seq (unstrument s)) true) - f (or f (when v @v))] + f (or f (when v @v)) + specd (s/spec spec)] (try (cond (or (nil? f) (some-> v meta :macro)) {:failure (ex-info "No fn to spec" {::s/failure :no-fn}) :sym s :spec spec} - (:args spec) - (let [tcret (quick-check f spec opts)] + (:args specd) + (let [tcret (quick-check f specd opts)] (make-check-result s spec tcret)) :default From 2ff700ede3866f97d7b1f53342e201df94384aee Mon Sep 17 00:00:00 2001 From: Nicola Mometto Date: Sat, 7 Nov 2015 02:58:40 +0100 Subject: [PATCH 150/246] CLJ-1790: emit a cast to the interface during procol callsite emission or the jvm verifier will complain Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Compiler.java | 1 + 1 file changed, 1 insertion(+) diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index 7a17d090..7211e6c4 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -3712,6 +3712,7 @@ public void emitProto(C context, ObjExpr objx, GeneratorAdapter gen){ gen.mark(onLabel); //target if(protocolOn != null) { + gen.checkCast(Type.getType(protocolOn)); MethodExpr.emitTypedArgs(objx, gen, onMethod.getParameterTypes(), RT.subvec(args,1,args.count())); if(context == C.RETURN) { From b80e1fe4b14654d943e2f8b060b0bc56e18b4757 Mon Sep 17 00:00:00 2001 From: Nicola Mometto Date: Fri, 7 Oct 2016 21:23:39 +0100 Subject: [PATCH 151/246] CLJ-1242: equals doesn't throw on sorted collections Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/PersistentTreeMap.java | 16 ++++++++++++++++ src/jvm/clojure/lang/PersistentTreeSet.java | 16 ++++++++++++++++ test/clojure/test_clojure/data_structures.clj | 2 ++ 3 files changed, 34 insertions(+) diff --git a/src/jvm/clojure/lang/PersistentTreeMap.java b/src/jvm/clojure/lang/PersistentTreeMap.java index adbbb973..7c792bb4 100644 --- a/src/jvm/clojure/lang/PersistentTreeMap.java +++ b/src/jvm/clojure/lang/PersistentTreeMap.java @@ -94,6 +94,22 @@ public boolean containsKey(Object key){ return entryAt(key) != null; } +public boolean equals(Object obj){ + try { + return super.equals(obj); + } catch (ClassCastException e) { + return false; + } +} + +public boolean equiv(Object obj){ + try { + return super.equiv(obj); + } catch (ClassCastException e) { + return false; + } +} + public PersistentTreeMap assocEx(Object key, Object val) { Box found = new Box(null); Node t = add(tree, key, val, found); diff --git a/src/jvm/clojure/lang/PersistentTreeSet.java b/src/jvm/clojure/lang/PersistentTreeSet.java index a5dc8ec6..4a112692 100644 --- a/src/jvm/clojure/lang/PersistentTreeSet.java +++ b/src/jvm/clojure/lang/PersistentTreeSet.java @@ -42,6 +42,22 @@ static public PersistentTreeSet create(Comparator comp, ISeq items){ this._meta = meta; } +public boolean equals(Object obj){ + try { + return super.equals(obj); + } catch (ClassCastException e) { + return false; + } +} + +public boolean equiv(Object obj){ + try { + return super.equiv(obj); + } catch (ClassCastException e) { + return false; + } +} + public IPersistentSet disjoin(Object key) { if(contains(key)) return new PersistentTreeSet(meta(),impl.without(key)); diff --git a/test/clojure/test_clojure/data_structures.clj b/test/clojure/test_clojure/data_structures.clj index 35cf501f..7e32fe5c 100644 --- a/test/clojure/test_clojure/data_structures.clj +++ b/test/clojure/test_clojure/data_structures.clj @@ -202,6 +202,8 @@ (hash-map :a 1 :b 2) (array-map :a 1 :b 2)) + (is (not= (sorted-set :a) (sorted-set 1))) + ; sorted-set vs. hash-set (is (not= (class (sorted-set 1)) (class (hash-set 1)))) (are [x y] (= x y) From e3c4d2e8c7538cfda40accd5c410a584495cb357 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Fri, 28 Oct 2016 14:24:47 -0500 Subject: [PATCH 152/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha14 --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index e0635caa..adccc5af 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha14 http://clojure.org/ Clojure core environment and runtime library. From c0326d2386dd1227f35f46f1c75a8f87e2e93076 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Fri, 28 Oct 2016 14:24:47 -0500 Subject: [PATCH 153/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index adccc5af..e0635caa 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha14 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. From ea994282e844de6e7db4d0a38595042117187c89 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 14 Oct 2016 11:04:23 -0500 Subject: [PATCH 154/246] CLJ-2035 Fix bad s/form for collection specs Signed-off-by: Stuart Halloway --- src/clj/clojure/spec.clj | 27 ++++++++++++++++++++++----- test/clojure/test_clojure/spec.clj | 24 ++++++++++++++++++++++++ 2 files changed, 46 insertions(+), 5 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index ae8ce8e0..6fe02bb9 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -492,6 +492,15 @@ [& pred-forms] `(merge-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) +(defn- res-kind + [opts] + (let [{kind :kind :as mopts} opts] + (->> + (if kind + (assoc mopts :kind `~(res kind)) + mopts) + (mapcat identity)))) + (defmacro every "takes a pred and validates collection elements against that pred. @@ -522,7 +531,11 @@ See also - coll-of, every-kv " [pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}] - (let [nopts (-> opts (dissoc :gen) (assoc ::kind-form `'~(res (:kind opts)))) + (let [desc (::describe opts) + nopts (-> opts + (dissoc :gen ::describe) + (assoc ::kind-form `'~(res (:kind opts)) + ::describe (c/or desc `'(every ~(res pred) ~@(res-kind opts))))) gx (gensym) cpreds (cond-> [(list (c/or kind `coll?) gx)] count (conj `(= ~count (bounded-count ~count ~gx))) @@ -544,7 +557,8 @@ See also - map-of" [kpred vpred & opts] - `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :into {} ~@opts)) + (let [desc `(every-kv ~(res kpred) ~(res vpred) ~@(res-kind opts))] + `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :into {} ::describe '~desc ~@opts))) (defmacro coll-of "Returns a spec for a collection of items satisfying pred. Unlike @@ -556,7 +570,8 @@ See also - every, map-of" [pred & opts] - `(every ~pred ::conform-all true ~@opts)) + (let [desc `(coll-of ~(res pred) ~@(res-kind opts))] + `(every ~pred ::conform-all true ::describe '~desc ~@opts))) (defmacro map-of "Returns a spec for a map whose keys satisfy kpred and vals satisfy @@ -569,7 +584,8 @@ See also - every-kv" [kpred vpred & opts] - `(every-kv ~kpred ~vpred ::conform-all true :kind map? ~@opts)) + (let [desc `(map-of ~(res kpred) ~(res vpred) ~@(res-kind opts))] + `(every-kv ~kpred ~vpred ::conform-all true :kind map? ::describe '~desc ~@opts))) (defmacro * @@ -1180,6 +1196,7 @@ "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'" ([form pred opts] (every-impl form pred opts nil)) ([form pred {gen-into :into + describe-form ::describe :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn ::cpred conform-keys ::conform-all] :or {gen-max 20} @@ -1294,7 +1311,7 @@ (gen/vector pgen 0 gen-max)))))))) (with-gen* [_ gfn] (every-impl form pred opts gfn)) - (describe* [_] `(every ~form ~@(mapcat identity opts))))))) + (describe* [_] (c/or describe-form `(every ~(res form) ~@(mapcat identity opts)))))))) ;;;;;;;;;;;;;;;;;;;;;;; regex ;;;;;;;;;;;;;;;;;;; ;;See: diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj index 4f08ecdd..658017e9 100644 --- a/test/clojure/test_clojure/spec.clj +++ b/test/clojure/test_clojure/spec.clj @@ -169,6 +169,30 @@ [5 "x"] [5 "x"])) +(deftest coll-form + (are [spec form] + (= (s/form spec) form) + (s/map-of int? any?) + '(clojure.spec/map-of clojure.core/int? clojure.core/any?) + + (s/coll-of int?) + '(clojure.spec/coll-of clojure.core/int?) + + (s/every-kv int? int?) + '(clojure.spec/every-kv clojure.core/int? clojure.core/int?) + + (s/every int?) + '(clojure.spec/every clojure.core/int?) + + (s/coll-of (s/tuple (s/tuple int?))) + '(clojure.spec/coll-of (clojure.spec/tuple (clojure.spec/tuple clojure.core/int?))) + + (s/coll-of int? :kind vector?) + '(clojure.spec/coll-of clojure.core/int? :kind clojure.core/vector?) + + (s/coll-of int? :gen #(gen/return [1 2])) + '(clojure.spec/coll-of clojure.core/int? :gen (fn* [] (gen/return [1 2]))))) + (comment (require '[clojure.test :refer (run-tests)]) (in-ns 'clojure.test-clojure.spec) From 8708ffec6d39d16f2595cf9d5101c8e31f08efef Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 14 Oct 2016 14:23:48 -0500 Subject: [PATCH 155/246] CLJ-2043 fix s/form of s/conformer Signed-off-by: Stuart Halloway --- src/clj/clojure/spec.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index 6fe02bb9..ee2497cf 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -652,8 +652,8 @@ (possibly converted) value or :clojure.spec/invalid, and returns a spec that uses it as a predicate/conformer. Optionally takes a second fn that does unform of result of first" - ([f] `(spec-impl '~f ~f nil true)) - ([f unf] `(spec-impl '~f ~f nil true ~unf))) + ([f] `(spec-impl '(conformer ~(res f)) ~f nil true)) + ([f unf] `(spec-impl '(conformer ~(res f) ~(res unf)) ~f nil true ~unf))) (defmacro fspec "takes :args :ret and (optional) :fn kwargs whose values are preds From 7f3749d6456e858c95801b81146954d10ffc52b1 Mon Sep 17 00:00:00 2001 From: Brandon Bloom Date: Tue, 8 Nov 2016 15:19:51 -0800 Subject: [PATCH 156/246] CLJ-2055: Fix spec for map binding forms. Signed-off-by: Stuart Halloway --- src/clj/clojure/core/specs.clj | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/core/specs.clj b/src/clj/clojure/core/specs.clj index d8adc464..7b53c882 100644 --- a/src/clj/clojure/core/specs.clj +++ b/src/clj/clojure/core/specs.clj @@ -13,9 +13,10 @@ ;; sequential destructuring (s/def ::seq-binding-form - (s/cat :elems (s/* ::binding-form) - :rest (s/? (s/cat :amp #{'&} :form ::binding-form)) - :as (s/? (s/cat :as #{:as} :sym ::local-name)))) + (s/and vector? + (s/cat :elems (s/* ::binding-form) + :rest (s/? (s/cat :amp #{'&} :form ::binding-form)) + :as (s/? (s/cat :as #{:as} :sym ::local-name))))) ;; map destructuring From b2f5a3b37244b9e2bd9b0b26f88d4d7c16b29d24 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 29 Aug 2016 13:33:44 -0500 Subject: [PATCH 157/246] specs for import and refer-clojure Signed-off-by: Stuart Halloway --- src/clj/clojure/core/specs.clj | 87 +++++++++++++++++++++------------- 1 file changed, 54 insertions(+), 33 deletions(-) diff --git a/src/clj/clojure/core/specs.clj b/src/clj/clojure/core/specs.clj index 7b53c882..2be75caa 100644 --- a/src/clj/clojure/core/specs.clj +++ b/src/clj/clojure/core/specs.clj @@ -103,57 +103,61 @@ (s/def ::exclude (s/coll-of simple-symbol?)) (s/def ::only (s/coll-of simple-symbol?)) (s/def ::rename (s/map-of simple-symbol? simple-symbol?)) +(s/def ::filters (s/keys* :opt-un [::exclude ::only ::rename])) (s/def ::ns-refer-clojure (s/spec (s/cat :clause #{:refer-clojure} - :filters (s/keys* :opt-un [::exclude ::only ::rename])))) + :filters ::filters))) (s/def ::refer (s/or :all #{:all} - :syms (s/coll-of simple-symbol?))) + :syms (s/coll-of simple-symbol?))) (s/def ::prefix-list (s/spec (s/cat :prefix simple-symbol? - :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::prefix-list)) - :refer (s/keys* :opt-un [::as ::refer])))) + :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::prefix-list)) + :refer (s/keys* :opt-un [::as ::refer])))) (s/def ::ns-require (s/spec (s/cat :clause #{:require} - :libs (s/* (s/alt :lib simple-symbol? - :prefix-list ::prefix-list - :flag #{:reload :reload-all :verbose}))))) + :libs (s/* (s/alt :lib simple-symbol? + :prefix-list ::prefix-list + :flag #{:reload :reload-all :verbose}))))) (s/def ::package-list (s/spec (s/cat :package simple-symbol? - :classes (s/* simple-symbol?)))) + :classes (s/* simple-symbol?)))) + +(s/def ::import-list + (s/* (s/alt :class simple-symbol? + :package-list ::package-list))) (s/def ::ns-import (s/spec (s/cat :clause #{:import} - :classes (s/* (s/alt :class simple-symbol? - :package-list ::package-list))))) + :classes ::import-list))) (s/def ::ns-refer (s/spec (s/cat :clause #{:refer} - :lib simple-symbol? - :filters (s/keys* :opt-un [::exclude ::only ::rename])))) + :lib simple-symbol? + :filters ::filters))) (s/def ::use-prefix-list (s/spec (s/cat :prefix simple-symbol? - :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::use-prefix-list)) - :filters (s/keys* :opt-un [::exclude ::only ::rename])))) + :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::use-prefix-list)) + :filters ::filters))) (s/def ::ns-use (s/spec (s/cat :clause #{:use} :libs (s/* (s/alt :lib simple-symbol? - :prefix-list ::use-prefix-list - :flag #{:reload :reload-all :verbose}))))) + :prefix-list ::use-prefix-list + :flag #{:reload :reload-all :verbose}))))) (s/def ::ns-load (s/spec (s/cat :clause #{:load} - :libs (s/* string?)))) + :libs (s/* string?)))) (s/def ::name simple-symbol?) (s/def ::extends simple-symbol?) @@ -165,8 +169,8 @@ (s/def ::post-init symbol?) (s/def ::method (s/and vector? (s/cat :name simple-symbol? - :param-types ::signature - :return-type simple-symbol?))) + :param-types ::signature + :return-type simple-symbol?))) (s/def ::methods (s/coll-of ::method :kind vector?)) (s/def ::main boolean?) (s/def ::factory simple-symbol?) @@ -181,23 +185,40 @@ (s/def ::ns-gen-class (s/spec (s/cat :clause #{:gen-class} - :options (s/keys* :opt-un [::name ::extends ::implements - ::init ::constructors ::post-init - ::methods ::main ::factory ::state - ::exposes ::prefix ::impl-ns ::load-impl-ns])))) + :options (s/keys* :opt-un [::name ::extends ::implements + ::init ::constructors ::post-init + ::methods ::main ::factory ::state + ::exposes ::prefix ::impl-ns ::load-impl-ns])))) (s/def ::ns-clauses (s/* (s/alt :refer-clojure ::ns-refer-clojure - :require ::ns-require - :import ::ns-import - :use ::ns-use - :refer ::ns-refer - :load ::ns-load - :gen-class ::ns-gen-class))) + :require ::ns-require + :import ::ns-import + :use ::ns-use + :refer ::ns-refer + :load ::ns-load + :gen-class ::ns-gen-class))) (s/fdef clojure.core/ns :args (s/cat :name simple-symbol? - :docstring (s/? string?) - :attr-map (s/? map?) - :clauses ::ns-clauses) - :ret any?) + :docstring (s/? string?) + :attr-map (s/? map?) + :clauses ::ns-clauses)) + +(defmacro ^:private quotable + "Returns a spec that accepts both the spec and a (quote ...) form of the spec" + [spec] + `(s/or :spec ~spec :quoted-spec (s/cat :quote #{'quote} :spec ~spec))) + +(s/def ::quotable-import-list + (s/* (s/alt :class (quotable simple-symbol?) + :package-list (quotable ::package-list)))) + +(s/fdef clojure.core/import + :args ::quotable-import-list) + +(s/fdef clojure.core/refer-clojure + :args (s/* (s/alt + :exclude (s/cat :op (quotable #{:exclude}) :arg (quotable ::exclude)) + :only (s/cat :op (quotable #{:only}) :arg (quotable ::only)) + :rename (s/cat :op (quotable #{:rename}) :arg (quotable ::rename))))) \ No newline at end of file From 62a10c977380e33df91cf25a47aeb2881edf111e Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Thu, 19 Jan 2017 11:43:32 -0600 Subject: [PATCH 158/246] CLJ-2100 s/nilable form should retain original spec form Signed-off-by: Stuart Halloway --- src/clj/clojure/spec.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj index ee2497cf..2d12e19c 100644 --- a/src/clj/clojure/spec.clj +++ b/src/clj/clojure/spec.clj @@ -1798,7 +1798,7 @@ [[1 (gen/delay (gen/return nil))] [9 (gen/delay (gensub pred overrides (conj path ::pred) rmap form))]]))) (with-gen* [_ gfn] (nilable-impl form pred gfn)) - (describe* [_] `(nilable ~(describe* @spec)))))) + (describe* [_] `(nilable ~(res form)))))) (defmacro nilable "returns a spec that accepts nil and values satisfying pred" From 70d48164a02d6d6043b571491d886315f7c1fdd0 Mon Sep 17 00:00:00 2001 From: Nicola Mometto Date: Thu, 16 Feb 2017 23:35:08 +0000 Subject: [PATCH 159/246] CLJ-2144: conform map fn bodies as :body rather than as :prepost Signed-off-by: Stuart Halloway --- src/clj/clojure/core/specs.clj | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core/specs.clj b/src/clj/clojure/core/specs.clj index 2be75caa..8cea00e2 100644 --- a/src/clj/clojure/core/specs.clj +++ b/src/clj/clojure/core/specs.clj @@ -73,8 +73,9 @@ (s/def ::args+body (s/cat :args ::arg-list - :prepost (s/? map?) - :body (s/* any?))) + :body (s/alt :prepost+body (s/cat :prepost map? + :body (s/+ any?)) + :body (s/* any?)))) (s/def ::defn-args (s/cat :name simple-symbol? From e631f158711adc538a16ec1d09f2afe9b7238e5e Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Wed, 14 Dec 2016 10:25:36 -0600 Subject: [PATCH 160/246] deployment updates Signed-off-by: Stuart Halloway --- pom.xml | 88 +++++++++++++++++++++++++++------------------------------ 1 file changed, 41 insertions(+), 47 deletions(-) diff --git a/pom.xml b/pom.xml index e0635caa..475e1ac1 100644 --- a/pom.xml +++ b/pom.xml @@ -26,12 +26,6 @@ - - org.sonatype.oss - oss-parent - 7 - - scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git @@ -75,6 +69,14 @@ + + + + sonatype-nexus-staging + https://oss.sonatype.org/content/repositories/snapshots + + + @@ -90,11 +92,11 @@ org.apache.maven.plugins maven-compiler-plugin - 2.3.2 + 3.1 1.6 1.6 - ${project.build.sourceEncoding} + UTF-8 @@ -206,7 +208,7 @@ instead, push SCM changes in Hudson configuration --> org.apache.maven.plugins maven-release-plugin - 2.1 + 2.4.1 false true @@ -221,6 +223,36 @@ true + + + + org.sonatype.plugins + nexus-staging-maven-plugin + 1.6.7 + true + + + sonatype-nexus-staging + https://oss.sonatype.org/ + true + + + + + + org.apache.maven.plugins + maven-gpg-plugin + 1.5 + + + sign-artifacts + verify + + sign + + + + @@ -265,43 +297,5 @@ - - sonatype-oss-release - - - - - org.apache.maven.plugins - maven-deploy-plugin - 2.7 - - true - - - - org.sonatype.plugins - nexus-staging-maven-plugin - 1.4.4 - - - default-deploy - deploy - - - deploy - - - - - - https://oss.sonatype.org/ - - sonatype-nexus-staging - - - - - From 4622e8cc7540fa755b348a93c6a941a47e96ab78 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 14 Mar 2017 10:52:23 -0500 Subject: [PATCH 161/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha15 --- pom.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 475e1ac1..59742916 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha15 http://clojure.org/ Clojure core environment and runtime library. @@ -30,6 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git + clojure-1.9.0-alpha15 From 303496aa196f75f9fd7c899b2e1fd3b430a96521 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 14 Mar 2017 10:52:23 -0500 Subject: [PATCH 162/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 59742916..3ae4fc23 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha15 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-alpha15 + HEAD From 4cc97e3e40616a7c0dd637d2401529799b440133 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Thu, 23 Mar 2017 09:46:49 -0500 Subject: [PATCH 163/246] Move artifact signing to a profile Signed-off-by: Rich Hickey --- pom.xml | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/pom.xml b/pom.xml index 3ae4fc23..dafc0295 100644 --- a/pom.xml +++ b/pom.xml @@ -239,21 +239,6 @@ - - - org.apache.maven.plugins - maven-gpg-plugin - 1.5 - - - sign-artifacts - verify - - sign - - - - @@ -298,5 +283,27 @@ + + + sign + + + + org.apache.maven.plugins + maven-gpg-plugin + 1.5 + + + sign-artifacts + verify + + sign + + + + + + + From a26dfc1390c53ca10dba750b8d5e6b93e846c067 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Thu, 20 Apr 2017 10:52:32 -0400 Subject: [PATCH 164/246] added Var serialization - serializes identity, not value --- src/jvm/clojure/lang/Var.java | 28 ++++++++++++++++++++- test/clojure/test_clojure/serialization.clj | 2 +- 2 files changed, 28 insertions(+), 2 deletions(-) diff --git a/src/jvm/clojure/lang/Var.java b/src/jvm/clojure/lang/Var.java index 3dc9580c..07f8a8e5 100644 --- a/src/jvm/clojure/lang/Var.java +++ b/src/jvm/clojure/lang/Var.java @@ -12,10 +12,12 @@ package clojure.lang; +import java.io.ObjectStreamException; +import java.io.Serializable; import java.util.concurrent.atomic.AtomicBoolean; -public final class Var extends ARef implements IFn, IRef, Settable{ +public final class Var extends ARef implements IFn, IRef, Settable, Serializable{ static class TBox{ @@ -712,4 +714,28 @@ public Object invoke(Object c, Object k) { return RT.dissoc(c, k); } }; + + +/*** + Note - serialization only supports reconnecting the Var identity on the deserializing end + Neither the value in the var nor any of its properties are serialized +***/ + +private static class Serialized implements Serializable{ + public Serialized(Symbol nsName, Symbol sym){ + this.nsName = nsName; + this.sym = sym; + } + + private Symbol nsName; + private Symbol sym; + + private Object readResolve() throws ObjectStreamException{ + return intern(nsName, sym); + } +} + +private Object writeReplace() throws ObjectStreamException{ + return new Serialized(ns.getName(), sym); +} } diff --git a/test/clojure/test_clojure/serialization.clj b/test/clojure/test_clojure/serialization.clj index 60cd65c9..316fbd62 100644 --- a/test/clojure/test_clojure/serialization.clj +++ b/test/clojure/test_clojure/serialization.clj @@ -169,7 +169,7 @@ (atom nil) (ref nil) (agent nil) - #'+ + ;;#'+ ;; stateful seqs (enumeration-seq (java.util.Collections/enumeration (range 50))) From 42a7fd42cfae973d2af16d4bed40c7594574b58b Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Wed, 26 Apr 2017 19:56:24 -0500 Subject: [PATCH 165/246] Remove clojure.spec and rename spec namespace usage Signed-off-by: Stuart Halloway --- build.xml | 11 +- pom.xml | 26 + src/clj/clojure/core/specs.clj | 225 ---- src/clj/clojure/main.clj | 2 +- src/clj/clojure/repl.clj | 2 +- src/clj/clojure/spec.clj | 1936 ---------------------------- src/clj/clojure/spec/gen.clj | 224 ---- src/clj/clojure/spec/test.clj | 466 ------- src/jvm/clojure/lang/Compiler.java | 9 +- src/jvm/clojure/lang/RT.java | 4 +- test/clojure/test_clojure/spec.clj | 201 --- 11 files changed, 36 insertions(+), 3070 deletions(-) delete mode 100644 src/clj/clojure/core/specs.clj delete mode 100644 src/clj/clojure/spec.clj delete mode 100644 src/clj/clojure/spec/gen.clj delete mode 100644 src/clj/clojure/spec/test.clj delete mode 100644 test/clojure/test_clojure/spec.clj diff --git a/build.xml b/build.xml index 535ac017..41790f50 100644 --- a/build.xml +++ b/build.xml @@ -59,7 +59,6 @@ - @@ -82,13 +81,6 @@ - - - - - @@ -99,8 +91,9 @@ Direct linking = ${directlinking} + ${test-classes}:${test}:${build}:${cljsrc}:${maven.compile.classpath} diff --git a/pom.xml b/pom.xml index dafc0295..566b8df6 100644 --- a/pom.xml +++ b/pom.xml @@ -38,6 +38,32 @@ + + org.clojure + spec.alpha + 0.1.94 + + + org.clojure + clojure + + + + + org.clojure + core.specs.alpha + 0.1.10 + + + org.clojure + clojure + + + org.clojure + spec.alpha + + + org.codehaus.jsr166-mirror jsr166y diff --git a/src/clj/clojure/core/specs.clj b/src/clj/clojure/core/specs.clj deleted file mode 100644 index 8cea00e2..00000000 --- a/src/clj/clojure/core/specs.clj +++ /dev/null @@ -1,225 +0,0 @@ -(ns ^{:skip-wiki true} clojure.core.specs - (:require [clojure.spec :as s])) - -;;;; destructure - -(s/def ::local-name (s/and simple-symbol? #(not= '& %))) - -(s/def ::binding-form - (s/or :sym ::local-name - :seq ::seq-binding-form - :map ::map-binding-form)) - -;; sequential destructuring - -(s/def ::seq-binding-form - (s/and vector? - (s/cat :elems (s/* ::binding-form) - :rest (s/? (s/cat :amp #{'&} :form ::binding-form)) - :as (s/? (s/cat :as #{:as} :sym ::local-name))))) - -;; map destructuring - -(s/def ::keys (s/coll-of ident? :kind vector?)) -(s/def ::syms (s/coll-of symbol? :kind vector?)) -(s/def ::strs (s/coll-of simple-symbol? :kind vector?)) -(s/def ::or (s/map-of simple-symbol? any?)) -(s/def ::as ::local-name) - -(s/def ::map-special-binding - (s/keys :opt-un [::as ::or ::keys ::syms ::strs])) - -(s/def ::map-binding (s/tuple ::binding-form any?)) - -(s/def ::ns-keys - (s/tuple - (s/and qualified-keyword? #(-> % name #{"keys" "syms"})) - (s/coll-of simple-symbol? :kind vector?))) - -(s/def ::map-bindings - (s/every (s/or :mb ::map-binding - :nsk ::ns-keys - :msb (s/tuple #{:as :or :keys :syms :strs} any?)) :into {})) - -(s/def ::map-binding-form (s/merge ::map-bindings ::map-special-binding)) - -;; bindings - -(s/def ::binding (s/cat :binding ::binding-form :init-expr any?)) -(s/def ::bindings (s/and vector? (s/* ::binding))) - -;; let, if-let, when-let - -(s/fdef clojure.core/let - :args (s/cat :bindings ::bindings - :body (s/* any?))) - -(s/fdef clojure.core/if-let - :args (s/cat :bindings (s/and vector? ::binding) - :then any? - :else (s/? any?))) - -(s/fdef clojure.core/when-let - :args (s/cat :bindings (s/and vector? ::binding) - :body (s/* any?))) - -;; defn, defn-, fn - -(s/def ::arg-list - (s/and - vector? - (s/cat :args (s/* ::binding-form) - :varargs (s/? (s/cat :amp #{'&} :form ::binding-form))))) - -(s/def ::args+body - (s/cat :args ::arg-list - :body (s/alt :prepost+body (s/cat :prepost map? - :body (s/+ any?)) - :body (s/* any?)))) - -(s/def ::defn-args - (s/cat :name simple-symbol? - :docstring (s/? string?) - :meta (s/? map?) - :bs (s/alt :arity-1 ::args+body - :arity-n (s/cat :bodies (s/+ (s/spec ::args+body)) - :attr (s/? map?))))) - -(s/fdef clojure.core/defn - :args ::defn-args - :ret any?) - -(s/fdef clojure.core/defn- - :args ::defn-args - :ret any?) - -(s/fdef clojure.core/fn - :args (s/cat :name (s/? simple-symbol?) - :bs (s/alt :arity-1 ::args+body - :arity-n (s/+ (s/spec ::args+body)))) - :ret any?) - -;;;; ns - -(s/def ::exclude (s/coll-of simple-symbol?)) -(s/def ::only (s/coll-of simple-symbol?)) -(s/def ::rename (s/map-of simple-symbol? simple-symbol?)) -(s/def ::filters (s/keys* :opt-un [::exclude ::only ::rename])) - -(s/def ::ns-refer-clojure - (s/spec (s/cat :clause #{:refer-clojure} - :filters ::filters))) - -(s/def ::refer (s/or :all #{:all} - :syms (s/coll-of simple-symbol?))) - -(s/def ::prefix-list - (s/spec - (s/cat :prefix simple-symbol? - :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::prefix-list)) - :refer (s/keys* :opt-un [::as ::refer])))) - -(s/def ::ns-require - (s/spec (s/cat :clause #{:require} - :libs (s/* (s/alt :lib simple-symbol? - :prefix-list ::prefix-list - :flag #{:reload :reload-all :verbose}))))) - -(s/def ::package-list - (s/spec - (s/cat :package simple-symbol? - :classes (s/* simple-symbol?)))) - -(s/def ::import-list - (s/* (s/alt :class simple-symbol? - :package-list ::package-list))) - -(s/def ::ns-import - (s/spec - (s/cat :clause #{:import} - :classes ::import-list))) - -(s/def ::ns-refer - (s/spec (s/cat :clause #{:refer} - :lib simple-symbol? - :filters ::filters))) - -(s/def ::use-prefix-list - (s/spec - (s/cat :prefix simple-symbol? - :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::use-prefix-list)) - :filters ::filters))) - -(s/def ::ns-use - (s/spec (s/cat :clause #{:use} - :libs (s/* (s/alt :lib simple-symbol? - :prefix-list ::use-prefix-list - :flag #{:reload :reload-all :verbose}))))) - -(s/def ::ns-load - (s/spec (s/cat :clause #{:load} - :libs (s/* string?)))) - -(s/def ::name simple-symbol?) -(s/def ::extends simple-symbol?) -(s/def ::implements (s/coll-of simple-symbol? :kind vector?)) -(s/def ::init symbol?) -(s/def ::class-ident (s/or :class simple-symbol? :class-name string?)) -(s/def ::signature (s/coll-of ::class-ident :kind vector?)) -(s/def ::constructors (s/map-of ::signature ::signature)) -(s/def ::post-init symbol?) -(s/def ::method (s/and vector? - (s/cat :name simple-symbol? - :param-types ::signature - :return-type simple-symbol?))) -(s/def ::methods (s/coll-of ::method :kind vector?)) -(s/def ::main boolean?) -(s/def ::factory simple-symbol?) -(s/def ::state simple-symbol?) -(s/def ::get simple-symbol?) -(s/def ::set simple-symbol?) -(s/def ::expose (s/keys :opt-un [::get ::set])) -(s/def ::exposes (s/map-of simple-symbol? ::expose)) -(s/def ::prefix string?) -(s/def ::impl-ns simple-symbol?) -(s/def ::load-impl-ns boolean?) - -(s/def ::ns-gen-class - (s/spec (s/cat :clause #{:gen-class} - :options (s/keys* :opt-un [::name ::extends ::implements - ::init ::constructors ::post-init - ::methods ::main ::factory ::state - ::exposes ::prefix ::impl-ns ::load-impl-ns])))) - -(s/def ::ns-clauses - (s/* (s/alt :refer-clojure ::ns-refer-clojure - :require ::ns-require - :import ::ns-import - :use ::ns-use - :refer ::ns-refer - :load ::ns-load - :gen-class ::ns-gen-class))) - -(s/fdef clojure.core/ns - :args (s/cat :name simple-symbol? - :docstring (s/? string?) - :attr-map (s/? map?) - :clauses ::ns-clauses)) - -(defmacro ^:private quotable - "Returns a spec that accepts both the spec and a (quote ...) form of the spec" - [spec] - `(s/or :spec ~spec :quoted-spec (s/cat :quote #{'quote} :spec ~spec))) - -(s/def ::quotable-import-list - (s/* (s/alt :class (quotable simple-symbol?) - :package-list (quotable ::package-list)))) - -(s/fdef clojure.core/import - :args ::quotable-import-list) - -(s/fdef clojure.core/refer-clojure - :args (s/* (s/alt - :exclude (s/cat :op (quotable #{:exclude}) :arg (quotable ::exclude)) - :only (s/cat :op (quotable #{:only}) :arg (quotable ::only)) - :rename (s/cat :op (quotable #{:rename}) :arg (quotable ::rename))))) \ No newline at end of file diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj index c023f1f8..3394f6be 100644 --- a/src/clj/clojure/main.clj +++ b/src/clj/clojure/main.clj @@ -81,7 +81,7 @@ *command-line-args* *command-line-args* *unchecked-math* *unchecked-math* *assert* *assert* - clojure.spec/*explain-out* clojure.spec/*explain-out* + clojure.spec.alpha/*explain-out* clojure.spec.alpha/*explain-out* *1 nil *2 nil *3 nil diff --git a/src/clj/clojure/repl.clj b/src/clj/clojure/repl.clj index 2dec1f3f..08523822 100644 --- a/src/clj/clojure/repl.clj +++ b/src/clj/clojure/repl.clj @@ -12,7 +12,7 @@ ^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim" :doc "Utilities meant to be used interactively at the REPL"} clojure.repl - (:require [clojure.spec :as spec]) + (:require [clojure.spec.alpha :as spec]) (:import (java.io LineNumberReader InputStreamReader PushbackReader) (clojure.lang RT Reflector))) diff --git a/src/clj/clojure/spec.clj b/src/clj/clojure/spec.clj deleted file mode 100644 index 2d12e19c..00000000 --- a/src/clj/clojure/spec.clj +++ /dev/null @@ -1,1936 +0,0 @@ -; Copyright (c) Rich Hickey. 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.spec - (:refer-clojure :exclude [+ * and assert or cat def keys merge]) - (:require [clojure.walk :as walk] - [clojure.spec.gen :as gen] - [clojure.string :as str])) - -(alias 'c 'clojure.core) - -(set! *warn-on-reflection* true) - -(def ^:dynamic *recursion-limit* - "A soft limit on how many times a branching spec (or/alt/*/opt-keys/multi-spec) - can be recursed through during generation. After this a - non-recursive branch will be chosen." - 4) - -(def ^:dynamic *fspec-iterations* - "The number of times an anonymous fn specified by fspec will be (generatively) tested during conform" - 21) - -(def ^:dynamic *coll-check-limit* - "The number of elements validated in a collection spec'ed with 'every'" - 101) - -(def ^:dynamic *coll-error-limit* - "The number of errors reported by explain in a collection spec'ed with 'every'" - 20) - -(defprotocol Spec - (conform* [spec x]) - (unform* [spec y]) - (explain* [spec path via in x]) - (gen* [spec overrides path rmap]) - (with-gen* [spec gfn]) - (describe* [spec])) - -(defonce ^:private registry-ref (atom {})) - -(defn- deep-resolve [reg k] - (loop [spec k] - (if (ident? spec) - (recur (get reg spec)) - spec))) - -(defn- reg-resolve - "returns the spec/regex at end of alias chain starting with k, nil if not found, k if k not ident" - [k] - (if (ident? k) - (let [reg @registry-ref - spec (get reg k)] - (if-not (ident? spec) - spec - (deep-resolve reg spec))) - k)) - -(defn- reg-resolve! - "returns the spec/regex at end of alias chain starting with k, throws if not found, k if k not ident" - [k] - (if (ident? k) - (c/or (reg-resolve k) - (throw (Exception. (str "Unable to resolve spec: " k)))) - k)) - -(defn spec? - "returns x if x is a spec object, else logical false" - [x] - (when (instance? clojure.spec.Spec x) - x)) - -(defn regex? - "returns x if x is a (clojure.spec) regex op, else logical false" - [x] - (c/and (::op x) x)) - -(defn- with-name [spec name] - (cond - (ident? spec) spec - (regex? spec) (assoc spec ::name name) - - (instance? clojure.lang.IObj spec) - (with-meta spec (assoc (meta spec) ::name name)))) - -(defn- spec-name [spec] - (cond - (ident? spec) spec - - (regex? spec) (::name spec) - - (instance? clojure.lang.IObj spec) - (-> (meta spec) ::name))) - -(declare spec-impl) -(declare regex-spec-impl) - -(defn- maybe-spec - "spec-or-k must be a spec, regex or resolvable kw/sym, else returns nil." - [spec-or-k] - (let [s (c/or (c/and (ident? spec-or-k) (reg-resolve spec-or-k)) - (spec? spec-or-k) - (regex? spec-or-k) - nil)] - (if (regex? s) - (with-name (regex-spec-impl s nil) (spec-name s)) - s))) - -(defn- the-spec - "spec-or-k must be a spec, regex or kw/sym, else returns nil. Throws if unresolvable kw/sym" - [spec-or-k] - (c/or (maybe-spec spec-or-k) - (when (ident? spec-or-k) - (throw (Exception. (str "Unable to resolve spec: " spec-or-k)))))) - -(defprotocol Specize - (specize* [_] [_ form])) - -(extend-protocol Specize - clojure.lang.Keyword - (specize* ([k] (specize* (reg-resolve! k))) - ([k _] (specize* (reg-resolve! k)))) - - clojure.lang.Symbol - (specize* ([s] (specize* (reg-resolve! s))) - ([s _] (specize* (reg-resolve! s)))) - - Object - (specize* ([o] (spec-impl ::unknown o nil nil)) - ([o form] (spec-impl form o nil nil)))) - -(defn- specize - ([s] (c/or (spec? s) (specize* s))) - ([s form] (c/or (spec? s) (specize* s form)))) - -(defn invalid? - "tests the validity of a conform return value" - [ret] - (identical? ::invalid ret)) - -(defn conform - "Given a spec and a value, returns :clojure.spec/invalid if value does not match spec, - else the (possibly destructured) value." - [spec x] - (conform* (specize spec) x)) - -(defn unform - "Given a spec and a value created by or compliant with a call to - 'conform' with the same spec, returns a value with all conform - destructuring undone." - [spec x] - (unform* (specize spec) x)) - -(defn form - "returns the spec as data" - [spec] - ;;TODO - incorporate gens - (describe* (specize spec))) - -(defn abbrev [form] - (cond - (seq? form) - (walk/postwalk (fn [form] - (cond - (c/and (symbol? form) (namespace form)) - (-> form name symbol) - - (c/and (seq? form) (= 'fn (first form)) (= '[%] (second form))) - (last form) - - :else form)) - form) - - (c/and (symbol? form) (namespace form)) - (-> form name symbol) - - :else form)) - -(defn describe - "returns an abbreviated description of the spec as data" - [spec] - (abbrev (form spec))) - -(defn with-gen - "Takes a spec and a no-arg, generator-returning fn and returns a version of that spec that uses that generator" - [spec gen-fn] - (let [spec (reg-resolve spec)] - (if (regex? spec) - (assoc spec ::gfn gen-fn) - (with-gen* (specize spec) gen-fn)))) - -(defn explain-data* [spec path via in x] - (let [probs (explain* (specize spec) path via in x)] - (when-not (empty? probs) - {::problems probs}))) - -(defn explain-data - "Given a spec and a value x which ought to conform, returns nil if x - conforms, else a map with at least the key ::problems whose value is - a collection of problem-maps, where problem-map has at least :path :pred and :val - keys describing the predicate and the value that failed at that - path." - [spec x] - (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) [] x)) - -(defn explain-printer - "Default printer for explain-data. nil indicates a successful validation." - [ed] - (if ed - (do - ;;(prn {:ed ed}) - (doseq [{:keys [path pred val reason via in] :as prob} (::problems ed)] - (when-not (empty? in) - (print "In:" (pr-str in) "")) - (print "val: ") - (pr val) - (print " fails") - (when-not (empty? via) - (print " spec:" (pr-str (last via)))) - (when-not (empty? path) - (print " at:" (pr-str path))) - (print " predicate: ") - (pr (abbrev pred)) - (when reason (print ", " reason)) - (doseq [[k v] prob] - (when-not (#{:path :pred :val :reason :via :in} k) - (print "\n\t" (pr-str k) " ") - (pr v))) - (newline)) - (doseq [[k v] ed] - (when-not (#{::problems} k) - (print (pr-str k) " ") - (pr v) - (newline)))) - (println "Success!"))) - -(def ^:dynamic *explain-out* explain-printer) - -(defn explain-out - "Prints explanation data (per 'explain-data') to *out* using the printer in *explain-out*, - by default explain-printer." - [ed] - (*explain-out* ed)) - -(defn explain - "Given a spec and a value that fails to conform, prints an explanation to *out*." - [spec x] - (explain-out (explain-data spec x))) - -(defn explain-str - "Given a spec and a value that fails to conform, returns an explanation as a string." - [spec x] - (with-out-str (explain spec x))) - -(declare valid?) - -(defn- gensub - [spec overrides path rmap form] - ;;(prn {:spec spec :over overrides :path path :form form}) - (let [spec (specize spec)] - (if-let [g (c/or (when-let [gfn (c/or (get overrides (c/or (spec-name spec) spec)) - (get overrides path))] - (gfn)) - (gen* spec overrides path rmap))] - (gen/such-that #(valid? spec %) g 100) - (let [abbr (abbrev form)] - (throw (ex-info (str "Unable to construct gen at: " path " for: " abbr) - {::path path ::form form ::failure :no-gen})))))) - -(defn gen - "Given a spec, returns the generator for it, or throws if none can - be constructed. Optionally an overrides map can be provided which - should map spec names or paths (vectors of keywords) to no-arg - generator-creating fns. These will be used instead of the generators at those - names/paths. Note that parent generator (in the spec or overrides - map) will supersede those of any subtrees. A generator for a regex - op must always return a sequential collection (i.e. a generator for - s/? should return either an empty sequence/vector or a - sequence/vector with one item in it)" - ([spec] (gen spec nil)) - ([spec overrides] (gensub spec overrides [] {::recursion-limit *recursion-limit*} spec))) - -(defn- ->sym - "Returns a symbol from a symbol or var" - [x] - (if (var? x) - (let [^clojure.lang.Var v x] - (symbol (str (.name (.ns v))) - (str (.sym v)))) - x)) - -(defn- unfn [expr] - (if (c/and (seq? expr) - (symbol? (first expr)) - (= "fn*" (name (first expr)))) - (let [[[s] & form] (rest expr)] - (conj (walk/postwalk-replace {s '%} form) '[%] 'fn)) - expr)) - -(defn- res [form] - (cond - (keyword? form) form - (symbol? form) (c/or (-> form resolve ->sym) form) - (sequential? form) (walk/postwalk #(if (symbol? %) (res %) %) (unfn form)) - :else form)) - -(defn ^:skip-wiki def-impl - "Do not call this directly, use 'def'" - [k form spec] - (c/assert (c/and (ident? k) (namespace k)) "k must be namespaced keyword or resolvable symbol") - (let [spec (if (c/or (spec? spec) (regex? spec) (get @registry-ref spec)) - spec - (spec-impl form spec nil nil))] - (swap! registry-ref assoc k (with-name spec k)) - k)) - -(defn- ns-qualify - "Qualify symbol s by resolving it or using the current *ns*." - [s] - (if-let [ns-sym (some-> s namespace symbol)] - (c/or (some-> (get (ns-aliases *ns*) ns-sym) str (symbol (name s))) - s) - (symbol (str (.name *ns*)) (str s)))) - -(defmacro def - "Given a namespace-qualified keyword or resolvable symbol k, and a - spec, spec-name, predicate or regex-op makes an entry in the - registry mapping k to the spec" - [k spec-form] - (let [k (if (symbol? k) (ns-qualify k) k)] - `(def-impl '~k '~(res spec-form) ~spec-form))) - -(defn registry - "returns the registry map, prefer 'get-spec' to lookup a spec by name" - [] - @registry-ref) - -(defn get-spec - "Returns spec registered for keyword/symbol/var k, or nil." - [k] - (get (registry) (if (keyword? k) k (->sym k)))) - -(declare map-spec) - -(defmacro spec - "Takes a single predicate form, e.g. can be the name of a predicate, - like even?, or a fn literal like #(< % 42). Note that it is not - generally necessary to wrap predicates in spec when using the rest - of the spec macros, only to attach a unique generator - - Can also be passed the result of one of the regex ops - - cat, alt, *, +, ?, in which case it will return a regex-conforming - spec, useful when nesting an independent regex. - --- - - Optionally takes :gen generator-fn, which must be a fn of no args that - returns a test.check generator. - - Returns a spec." - [form & {:keys [gen]}] - (when form - `(spec-impl '~(res form) ~form ~gen nil))) - -(defmacro multi-spec - "Takes the name of a spec/predicate-returning multimethod and a - tag-restoring keyword or fn (retag). Returns a spec that when - conforming or explaining data will pass it to the multimethod to get - an appropriate spec. You can e.g. use multi-spec to dynamically and - extensibly associate specs with 'tagged' data (i.e. data where one - of the fields indicates the shape of the rest of the structure). - - (defmulti mspec :tag) - - The methods should ignore their argument and return a predicate/spec: - (defmethod mspec :int [_] (s/keys :req-un [::tag ::i])) - - retag is used during generation to retag generated values with - matching tags. retag can either be a keyword, at which key the - dispatch-tag will be assoc'ed, or a fn of generated value and - dispatch-tag that should return an appropriately retagged value. - - Note that because the tags themselves comprise an open set, - the tag key spec cannot enumerate the values, but can e.g. - test for keyword?. - - Note also that the dispatch values of the multimethod will be - included in the path, i.e. in reporting and gen overrides, even - though those values are not evident in the spec. -" - [mm retag] - `(multi-spec-impl '~(res mm) (var ~mm) ~retag)) - -(defmacro keys - "Creates and returns a map validating spec. :req and :opt are both - vectors of namespaced-qualified keywords. The validator will ensure - the :req keys are present. The :opt keys serve as documentation and - may be used by the generator. - - The :req key vector supports 'and' and 'or' for key groups: - - (s/keys :req [::x ::y (or ::secret (and ::user ::pwd))] :opt [::z]) - - There are also -un versions of :req and :opt. These allow - you to connect unqualified keys to specs. In each case, fully - qualfied keywords are passed, which name the specs, but unqualified - keys (with the same name component) are expected and checked at - conform-time, and generated during gen: - - (s/keys :req-un [:my.ns/x :my.ns/y]) - - The above says keys :x and :y are required, and will be validated - and generated by specs (if they exist) named :my.ns/x :my.ns/y - respectively. - - In addition, the values of *all* namespace-qualified keys will be validated - (and possibly destructured) by any registered specs. Note: there is - no support for inline value specification, by design. - - Optionally takes :gen generator-fn, which must be a fn of no args that - returns a test.check generator." - [& {:keys [req req-un opt opt-un gen]}] - (let [unk #(-> % name keyword) - req-keys (filterv keyword? (flatten req)) - req-un-specs (filterv keyword? (flatten req-un)) - _ (c/assert (every? #(c/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un)) - "all keys must be namespace-qualified keywords") - req-specs (into req-keys req-un-specs) - req-keys (into req-keys (map unk req-un-specs)) - opt-keys (into (vec opt) (map unk opt-un)) - opt-specs (into (vec opt) opt-un) - gx (gensym) - parse-req (fn [rk f] - (map (fn [x] - (if (keyword? x) - `(contains? ~gx ~(f x)) - (walk/postwalk - (fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y)) - x))) - rk)) - pred-exprs [`(map? ~gx)] - pred-exprs (into pred-exprs (parse-req req identity)) - pred-exprs (into pred-exprs (parse-req req-un unk)) - keys-pred `(fn* [~gx] (c/and ~@pred-exprs)) - pred-exprs (mapv (fn [e] `(fn* [~gx] ~e)) pred-exprs) - pred-forms (walk/postwalk res pred-exprs)] - ;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen) - `(map-spec-impl {:req '~req :opt '~opt :req-un '~req-un :opt-un '~opt-un - :req-keys '~req-keys :req-specs '~req-specs - :opt-keys '~opt-keys :opt-specs '~opt-specs - :pred-forms '~pred-forms - :pred-exprs ~pred-exprs - :keys-pred ~keys-pred - :gfn ~gen}))) - -(defmacro or - "Takes key+pred pairs, e.g. - - (s/or :even even? :small #(< % 42)) - - Returns a destructuring spec that returns a map entry containing the - key of the first matching pred and the corresponding value. Thus the - 'key' and 'val' functions can be used to refer generically to the - components of the tagged return." - [& key-pred-forms] - (let [pairs (partition 2 key-pred-forms) - keys (mapv first pairs) - pred-forms (mapv second pairs) - pf (mapv res pred-forms)] - (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords") - `(or-spec-impl ~keys '~pf ~pred-forms nil))) - -(defmacro and - "Takes predicate/spec-forms, e.g. - - (s/and even? #(< % 42)) - - Returns a spec that returns the conformed value. Successive - conformed values propagate through rest of predicates." - [& pred-forms] - `(and-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) - -(defmacro merge - "Takes map-validating specs (e.g. 'keys' specs) and - returns a spec that returns a conformed map satisfying all of the - specs. Unlike 'and', merge can generate maps satisfying the - union of the predicates." - [& pred-forms] - `(merge-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) - -(defn- res-kind - [opts] - (let [{kind :kind :as mopts} opts] - (->> - (if kind - (assoc mopts :kind `~(res kind)) - mopts) - (mapcat identity)))) - -(defmacro every - "takes a pred and validates collection elements against that pred. - - Note that 'every' does not do exhaustive checking, rather it samples - *coll-check-limit* elements. Nor (as a result) does it do any - conforming of elements. 'explain' will report at most *coll-error-limit* - problems. Thus 'every' should be suitable for potentially large - collections. - - Takes several kwargs options that further constrain the collection: - - :kind - a pred/spec that the collection type must satisfy, e.g. vector? - (default nil) Note that if :kind is specified and :into is - not, this pred must generate in order for every to generate. - :count - specifies coll has exactly this count (default nil) - :min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil) - :distinct - all the elements are distinct (default nil) - - And additional args that control gen - - :gen-max - the maximum coll size to generate (default 20) - :into - one of [], (), {}, #{} - the default collection to generate into - (default: empty coll as generated by :kind pred if supplied, else []) - - Optionally takes :gen generator-fn, which must be a fn of no args that - returns a test.check generator - - See also - coll-of, every-kv -" - [pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}] - (let [desc (::describe opts) - nopts (-> opts - (dissoc :gen ::describe) - (assoc ::kind-form `'~(res (:kind opts)) - ::describe (c/or desc `'(every ~(res pred) ~@(res-kind opts))))) - gx (gensym) - cpreds (cond-> [(list (c/or kind `coll?) gx)] - count (conj `(= ~count (bounded-count ~count ~gx))) - - (c/or min-count max-count) - (conj `(<= (c/or ~min-count 0) - (bounded-count (if ~max-count (inc ~max-count) ~min-count) ~gx) - (c/or ~max-count Integer/MAX_VALUE))) - - distinct - (conj `(c/or (empty? ~gx) (apply distinct? ~gx))))] - `(every-impl '~pred ~pred ~(assoc nopts ::cpred `(fn* [~gx] (c/and ~@cpreds))) ~gen))) - -(defmacro every-kv - "like 'every' but takes separate key and val preds and works on associative collections. - - Same options as 'every', :into defaults to {} - - See also - map-of" - - [kpred vpred & opts] - (let [desc `(every-kv ~(res kpred) ~(res vpred) ~@(res-kind opts))] - `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :into {} ::describe '~desc ~@opts))) - -(defmacro coll-of - "Returns a spec for a collection of items satisfying pred. Unlike - 'every', coll-of will exhaustively conform every value. - - Same options as 'every'. conform will produce a collection - corresponding to :into if supplied, else will match the input collection, - avoiding rebuilding when possible. - - See also - every, map-of" - [pred & opts] - (let [desc `(coll-of ~(res pred) ~@(res-kind opts))] - `(every ~pred ::conform-all true ::describe '~desc ~@opts))) - -(defmacro map-of - "Returns a spec for a map whose keys satisfy kpred and vals satisfy - vpred. Unlike 'every-kv', map-of will exhaustively conform every - value. - - Same options as 'every', :kind defaults to map?, with the addition of: - - :conform-keys - conform keys as well as values (default false) - - See also - every-kv" - [kpred vpred & opts] - (let [desc `(map-of ~(res kpred) ~(res vpred) ~@(res-kind opts))] - `(every-kv ~kpred ~vpred ::conform-all true :kind map? ::describe '~desc ~@opts))) - - -(defmacro * - "Returns a regex op that matches zero or more values matching - pred. Produces a vector of matches iff there is at least one match" - [pred-form] - `(rep-impl '~(res pred-form) ~pred-form)) - -(defmacro + - "Returns a regex op that matches one or more values matching - pred. Produces a vector of matches" - [pred-form] - `(rep+impl '~(res pred-form) ~pred-form)) - -(defmacro ? - "Returns a regex op that matches zero or one value matching - pred. Produces a single value (not a collection) if matched." - [pred-form] - `(maybe-impl ~pred-form '~pred-form)) - -(defmacro alt - "Takes key+pred pairs, e.g. - - (s/alt :even even? :small #(< % 42)) - - Returns a regex op that returns a map entry containing the key of the - first matching pred and the corresponding value. Thus the - 'key' and 'val' functions can be used to refer generically to the - components of the tagged return" - [& key-pred-forms] - (let [pairs (partition 2 key-pred-forms) - keys (mapv first pairs) - pred-forms (mapv second pairs) - pf (mapv res pred-forms)] - (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords") - `(alt-impl ~keys ~pred-forms '~pf))) - -(defmacro cat - "Takes key+pred pairs, e.g. - - (s/cat :e even? :o odd?) - - Returns a regex op that matches (all) values in sequence, returning a map - containing the keys of each pred and the corresponding value." - [& key-pred-forms] - (let [pairs (partition 2 key-pred-forms) - keys (mapv first pairs) - pred-forms (mapv second pairs) - pf (mapv res pred-forms)] - ;;(prn key-pred-forms) - (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords") - `(cat-impl ~keys ~pred-forms '~pf))) - -(defmacro & - "takes a regex op re, and predicates. Returns a regex-op that consumes - input as per re but subjects the resulting value to the - conjunction of the predicates, and any conforming they might perform." - [re & preds] - (let [pv (vec preds)] - `(amp-impl ~re ~pv '~(mapv res pv)))) - -(defmacro conformer - "takes a predicate function with the semantics of conform i.e. it should return either a - (possibly converted) value or :clojure.spec/invalid, and returns a - spec that uses it as a predicate/conformer. Optionally takes a - second fn that does unform of result of first" - ([f] `(spec-impl '(conformer ~(res f)) ~f nil true)) - ([f unf] `(spec-impl '(conformer ~(res f) ~(res unf)) ~f nil true ~unf))) - -(defmacro fspec - "takes :args :ret and (optional) :fn kwargs whose values are preds - and returns a spec whose conform/explain take a fn and validates it - using generative testing. The conformed value is always the fn itself. - - See 'fdef' for a single operation that creates an fspec and - registers it, as well as a full description of :args, :ret and :fn - - fspecs can generate functions that validate the arguments and - fabricate a return value compliant with the :ret spec, ignoring - the :fn spec if present. - - Optionally takes :gen generator-fn, which must be a fn of no args - that returns a test.check generator." - - [& {:keys [args ret fn gen]}] - `(fspec-impl (spec ~args) '~(res args) - (spec ~ret) '~(res ret) - (spec ~fn) '~(res fn) ~gen)) - -(defmacro tuple - "takes one or more preds and returns a spec for a tuple, a vector - where each element conforms to the corresponding pred. Each element - will be referred to in paths using its ordinal." - [& preds] - (c/assert (not (empty? preds))) - `(tuple-impl '~(mapv res preds) ~(vec preds))) - -(defn- macroexpand-check - [v args] - (let [fn-spec (get-spec v)] - (when-let [arg-spec (:args fn-spec)] - (when (invalid? (conform arg-spec args)) - (let [ed (assoc (explain-data* arg-spec [:args] - (if-let [name (spec-name arg-spec)] [name] []) [] args) - ::args args)] - (throw (ex-info - (str - "Call to " (->sym v) " did not conform to spec:\n" - (with-out-str (explain-out ed))) - ed))))))) - -(defmacro fdef - "Takes a symbol naming a function, and one or more of the following: - - :args A regex spec for the function arguments as they were a list to be - passed to apply - in this way, a single spec can handle functions with - multiple arities - :ret A spec for the function's return value - :fn A spec of the relationship between args and ret - the - value passed is {:args conformed-args :ret conformed-ret} and is - expected to contain predicates that relate those values - - Qualifies fn-sym with resolve, or using *ns* if no resolution found. - Registers an fspec in the global registry, where it can be retrieved - by calling get-spec with the var or fully-qualified symbol. - - Once registered, function specs are included in doc, checked by - instrument, tested by the runner clojure.spec.test/check, and (if - a macro) used to explain errors during macroexpansion. - - Note that :fn specs require the presence of :args and :ret specs to - conform values, and so :fn specs will be ignored if :args or :ret - are missing. - - Returns the qualified fn-sym. - - For example, to register function specs for the symbol function: - - (s/fdef clojure.core/symbol - :args (s/alt :separate (s/cat :ns string? :n string?) - :str string? - :sym symbol?) - :ret symbol?)" - [fn-sym & specs] - `(clojure.spec/def ~fn-sym (clojure.spec/fspec ~@specs))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defn- recur-limit? [rmap id path k] - (c/and (> (get rmap id) (::recursion-limit rmap)) - (contains? (set path) k))) - -(defn- inck [m k] - (assoc m k (inc (c/or (get m k) 0)))) - -(defn- dt - ([pred x form] (dt pred x form nil)) - ([pred x form cpred?] - (if pred - (if-let [spec (the-spec pred)] - (conform spec x) - (if (ifn? pred) - (if cpred? - (pred x) - (if (pred x) x ::invalid)) - (throw (Exception. (str (pr-str form) " is not a fn, expected predicate fn"))))) - x))) - -(defn valid? - "Helper function that returns true when x is valid for spec." - ([spec x] - (let [spec (specize spec)] - (not (invalid? (conform* spec x))))) - ([spec x form] - (let [spec (specize spec form)] - (not (invalid? (conform* spec x)))))) - -(defn- pvalid? - "internal helper function that returns true when x is valid for spec." - ([pred x] - (not (invalid? (dt pred x ::unknown)))) - ([pred x form] - (not (invalid? (dt pred x form))))) - -(defn- explain-1 [form pred path via in v] - ;;(prn {:form form :pred pred :path path :in in :v v}) - (let [pred (maybe-spec pred)] - (if (spec? pred) - (explain* pred path (if-let [name (spec-name pred)] (conj via name) via) in v) - [{:path path :pred (abbrev form) :val v :via via :in in}]))) - -(defn ^:skip-wiki map-spec-impl - "Do not call this directly, use 'spec' with a map argument" - [{:keys [req-un opt-un keys-pred pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn] - :as argm}] - (let [k->s (zipmap (concat req-keys opt-keys) (concat req-specs opt-specs)) - keys->specnames #(c/or (k->s %) %) - id (java.util.UUID/randomUUID)] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ m] - (if (keys-pred m) - (let [reg (registry)] - (loop [ret m, [[k v] & ks :as keys] m] - (if keys - (let [sname (keys->specnames k)] - (if-let [s (get reg sname)] - (let [cv (conform s v)] - (if (invalid? cv) - ::invalid - (recur (if (identical? cv v) ret (assoc ret k cv)) - ks))) - (recur ret ks))) - ret))) - ::invalid)) - (unform* [_ m] - (let [reg (registry)] - (loop [ret m, [k & ks :as keys] (c/keys m)] - (if keys - (if (contains? reg (keys->specnames k)) - (let [cv (get m k) - v (unform (keys->specnames k) cv)] - (recur (if (identical? cv v) ret (assoc ret k v)) - ks)) - (recur ret ks)) - ret)))) - (explain* [_ path via in x] - (if-not (map? x) - [{:path path :pred 'map? :val x :via via :in in}] - (let [reg (registry)] - (apply concat - (when-let [probs (->> (map (fn [pred form] (when-not (pred x) (abbrev form))) - pred-exprs pred-forms) - (keep identity) - seq)] - (map - #(identity {:path path :pred % :val x :via via :in in}) - probs)) - (map (fn [[k v]] - (when-not (c/or (not (contains? reg (keys->specnames k))) - (pvalid? (keys->specnames k) v k)) - (explain-1 (keys->specnames k) (keys->specnames k) (conj path k) via (conj in k) v))) - (seq x)))))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [rmap (inck rmap id) - gen (fn [k s] (gensub s overrides (conj path k) rmap k)) - ogen (fn [k s] - (when-not (recur-limit? rmap id path k) - [k (gen/delay (gensub s overrides (conj path k) rmap k))])) - req-gens (map gen req-keys req-specs) - opt-gens (remove nil? (map ogen opt-keys opt-specs))] - (when (every? identity (concat req-gens opt-gens)) - (let [reqs (zipmap req-keys req-gens) - opts (into {} opt-gens)] - (gen/bind (gen/choose 0 (count opts)) - #(let [args (concat (seq reqs) (when (seq opts) (shuffle (seq opts))))] - (->> args - (take (c/+ % (count reqs))) - (apply concat) - (apply gen/hash-map))))))))) - (with-gen* [_ gfn] (map-spec-impl (assoc argm :gfn gfn))) - (describe* [_] (cons `keys - (cond-> [] - req (conj :req req) - opt (conj :opt opt) - req-un (conj :req-un req-un) - opt-un (conj :opt-un opt-un))))))) - - - - -(defn ^:skip-wiki spec-impl - "Do not call this directly, use 'spec'" - ([form pred gfn cpred?] (spec-impl form pred gfn cpred? nil)) - ([form pred gfn cpred? unc] - (cond - (spec? pred) (cond-> pred gfn (with-gen gfn)) - (regex? pred) (regex-spec-impl pred gfn) - (ident? pred) (cond-> (the-spec pred) gfn (with-gen gfn)) - :else - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (let [ret (pred x)] - (if cpred? - ret - (if ret x ::invalid)))) - (unform* [_ x] (if cpred? - (if unc - (unc x) - (throw (IllegalStateException. "no unform fn for conformer"))) - x)) - (explain* [_ path via in x] - (when (invalid? (dt pred x form cpred?)) - [{:path path :pred (abbrev form) :val x :via via :in in}])) - (gen* [_ _ _ _] (if gfn - (gfn) - (gen/gen-for-pred pred))) - (with-gen* [_ gfn] (spec-impl form pred gfn cpred? unc)) - (describe* [_] form))))) - -(defn ^:skip-wiki multi-spec-impl - "Do not call this directly, use 'multi-spec'" - ([form mmvar retag] (multi-spec-impl form mmvar retag nil)) - ([form mmvar retag gfn] - (let [id (java.util.UUID/randomUUID) - predx #(let [^clojure.lang.MultiFn mm @mmvar] - (c/and (.getMethod mm ((.dispatchFn mm) %)) - (mm %))) - dval #((.dispatchFn ^clojure.lang.MultiFn @mmvar) %) - tag (if (keyword? retag) - #(assoc %1 retag %2) - retag)] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (if-let [pred (predx x)] - (dt pred x form) - ::invalid)) - (unform* [_ x] (if-let [pred (predx x)] - (unform pred x) - (throw (IllegalStateException. (str "No method of: " form " for dispatch value: " (dval x)))))) - (explain* [_ path via in x] - (let [dv (dval x) - path (conj path dv)] - (if-let [pred (predx x)] - (explain-1 form pred path via in x) - [{:path path :pred (abbrev form) :val x :reason "no method" :via via :in in}]))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [gen (fn [[k f]] - (let [p (f nil)] - (let [rmap (inck rmap id)] - (when-not (recur-limit? rmap id path k) - (gen/delay - (gen/fmap - #(tag % k) - (gensub p overrides (conj path k) rmap (list 'method form k)))))))) - gs (->> (methods @mmvar) - (remove (fn [[k]] (invalid? k))) - (map gen) - (remove nil?))] - (when (every? identity gs) - (gen/one-of gs))))) - (with-gen* [_ gfn] (multi-spec-impl form mmvar retag gfn)) - (describe* [_] `(multi-spec ~form ~retag)))))) - -(defn ^:skip-wiki tuple-impl - "Do not call this directly, use 'tuple'" - ([forms preds] (tuple-impl forms preds nil)) - ([forms preds gfn] - (let [specs (delay (mapv specize preds forms)) - cnt (count preds)] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] - (let [specs @specs] - (if-not (c/and (vector? x) - (= (count x) cnt)) - ::invalid - (loop [ret x, i 0] - (if (= i cnt) - ret - (let [v (x i) - cv (conform* (specs i) v)] - (if (invalid? cv) - ::invalid - (recur (if (identical? cv v) ret (assoc ret i cv)) - (inc i))))))))) - (unform* [_ x] - (c/assert (c/and (vector? x) - (= (count x) (count preds)))) - (loop [ret x, i 0] - (if (= i (count x)) - ret - (let [cv (x i) - v (unform (preds i) cv)] - (recur (if (identical? cv v) ret (assoc ret i v)) - (inc i)))))) - (explain* [_ path via in x] - (cond - (not (vector? x)) - [{:path path :pred 'vector? :val x :via via :in in}] - - (not= (count x) (count preds)) - [{:path path :pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}] - - :else - (apply concat - (map (fn [i form pred] - (let [v (x i)] - (when-not (pvalid? pred v) - (explain-1 form pred (conj path i) via (conj in i) v)))) - (range (count preds)) forms preds)))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [gen (fn [i p f] - (gensub p overrides (conj path i) rmap f)) - gs (map gen (range (count preds)) preds forms)] - (when (every? identity gs) - (apply gen/tuple gs))))) - (with-gen* [_ gfn] (tuple-impl forms preds gfn)) - (describe* [_] `(tuple ~@forms)))))) - -(defn- tagged-ret [tag ret] - (clojure.lang.MapEntry. tag ret)) - -(defn ^:skip-wiki or-spec-impl - "Do not call this directly, use 'or'" - [keys forms preds gfn] - (let [id (java.util.UUID/randomUUID) - kps (zipmap keys preds) - specs (delay (mapv specize preds forms)) - cform (case (count preds) - 2 (fn [x] - (let [specs @specs - ret (conform* (specs 0) x)] - (if (invalid? ret) - (let [ret (conform* (specs 1) x)] - (if (invalid? ret) - ::invalid - (tagged-ret (keys 1) ret))) - (tagged-ret (keys 0) ret)))) - 3 (fn [x] - (let [specs @specs - ret (conform* (specs 0) x)] - (if (invalid? ret) - (let [ret (conform* (specs 1) x)] - (if (invalid? ret) - (let [ret (conform* (specs 2) x)] - (if (invalid? ret) - ::invalid - (tagged-ret (keys 2) ret))) - (tagged-ret (keys 1) ret))) - (tagged-ret (keys 0) ret)))) - (fn [x] - (let [specs @specs] - (loop [i 0] - (if (< i (count specs)) - (let [spec (specs i)] - (let [ret (conform* spec x)] - (if (invalid? ret) - (recur (inc i)) - (tagged-ret (keys i) ret)))) - ::invalid)))))] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (cform x)) - (unform* [_ [k x]] (unform (kps k) x)) - (explain* [this path via in x] - (when-not (pvalid? this x) - (apply concat - (map (fn [k form pred] - (when-not (pvalid? pred x) - (explain-1 form pred (conj path k) via in x))) - keys forms preds)))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [gen (fn [k p f] - (let [rmap (inck rmap id)] - (when-not (recur-limit? rmap id path k) - (gen/delay - (gensub p overrides (conj path k) rmap f))))) - gs (remove nil? (map gen keys preds forms))] - (when-not (empty? gs) - (gen/one-of gs))))) - (with-gen* [_ gfn] (or-spec-impl keys forms preds gfn)) - (describe* [_] `(or ~@(mapcat vector keys forms)))))) - -(defn- and-preds [x preds forms] - (loop [ret x - [pred & preds] preds - [form & forms] forms] - (if pred - (let [nret (dt pred ret form)] - (if (invalid? nret) - ::invalid - ;;propagate conformed values - (recur nret preds forms))) - ret))) - -(defn- explain-pred-list - [forms preds path via in x] - (loop [ret x - [form & forms] forms - [pred & preds] preds] - (when pred - (let [nret (dt pred ret form)] - (if (invalid? nret) - (explain-1 form pred path via in ret) - (recur nret forms preds)))))) - -(defn ^:skip-wiki and-spec-impl - "Do not call this directly, use 'and'" - [forms preds gfn] - (let [specs (delay (mapv specize preds forms)) - cform - (case (count preds) - 2 (fn [x] - (let [specs @specs - ret (conform* (specs 0) x)] - (if (invalid? ret) - ::invalid - (conform* (specs 1) ret)))) - 3 (fn [x] - (let [specs @specs - ret (conform* (specs 0) x)] - (if (invalid? ret) - ::invalid - (let [ret (conform* (specs 1) ret)] - (if (invalid? ret) - ::invalid - (conform* (specs 2) ret)))))) - (fn [x] - (let [specs @specs] - (loop [ret x i 0] - (if (< i (count specs)) - (let [nret (conform* (specs i) ret)] - (if (invalid? nret) - ::invalid - ;;propagate conformed values - (recur nret (inc i)))) - ret)))))] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (cform x)) - (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) - (explain* [_ path via in x] (explain-pred-list forms preds path via in x)) - (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms)))) - (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) - (describe* [_] `(and ~@forms))))) - -(defn ^:skip-wiki merge-spec-impl - "Do not call this directly, use 'merge'" - [forms preds gfn] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (let [ms (map #(dt %1 x %2) preds forms)] - (if (some invalid? ms) - ::invalid - (apply c/merge ms)))) - (unform* [_ x] (apply c/merge (map #(unform % x) (reverse preds)))) - (explain* [_ path via in x] - (apply concat - (map #(explain-1 %1 %2 path via in x) - forms preds))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (gen/fmap - #(apply c/merge %) - (apply gen/tuple (map #(gensub %1 overrides path rmap %2) - preds forms))))) - (with-gen* [_ gfn] (merge-spec-impl forms preds gfn)) - (describe* [_] `(merge ~@forms)))) - -(defn- coll-prob [x kfn kform distinct count min-count max-count - path via in] - (let [pred (c/or kfn coll?) - kform (c/or kform `coll?)] - (cond - (not (pvalid? pred x)) - (explain-1 kform pred path via in x) - - (c/and count (not= count (bounded-count count x))) - [{:path path :pred `(= ~count (c/count ~'%)) :val x :via via :in in}] - - (c/and (c/or min-count max-count) - (not (<= (c/or min-count 0) - (bounded-count (if max-count (inc max-count) min-count) x) - (c/or max-count Integer/MAX_VALUE)))) - [{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}] - - (c/and distinct (not (empty? x)) (not (apply distinct? x))) - [{:path path :pred 'distinct? :val x :via via :in in}]))) - -(defn ^:skip-wiki every-impl - "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'" - ([form pred opts] (every-impl form pred opts nil)) - ([form pred {gen-into :into - describe-form ::describe - :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn ::cpred - conform-keys ::conform-all] - :or {gen-max 20} - :as opts} - gfn] - (let [conform-into gen-into - spec (delay (specize pred)) - check? #(valid? @spec %) - kfn (c/or kfn (fn [i v] i)) - addcv (fn [ret i v cv] (conj ret cv)) - cfns (fn [x] - ;;returns a tuple of [init add complete] fns - (cond - (c/and (vector? x) (c/or (not conform-into) (vector? conform-into))) - [identity - (fn [ret i v cv] - (if (identical? v cv) - ret - (assoc ret i cv))) - identity] - - (c/and (map? x) (c/or (c/and kind (not conform-into)) (map? conform-into))) - [(if conform-keys empty identity) - (fn [ret i v cv] - (if (c/and (identical? v cv) (not conform-keys)) - ret - (assoc ret (nth (if conform-keys cv v) 0) (nth cv 1)))) - identity] - - (c/or (list? conform-into) (seq? conform-into) (c/and (not conform-into) (c/or (list? x) (seq? x)))) - [(constantly ()) addcv reverse] - - :else [#(empty (c/or conform-into %)) addcv identity]))] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] - (let [spec @spec] - (cond - (not (cpred x)) ::invalid - - conform-all - (let [[init add complete] (cfns x)] - (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)] - (if vseq - (let [cv (conform* spec v)] - (if (invalid? cv) - ::invalid - (recur (add ret i v cv) (inc i) vs))) - (complete ret)))) - - - :else - (if (indexed? x) - (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))] - (loop [i 0] - (if (>= i (c/count x)) - x - (if (valid? spec (nth x i)) - (recur (c/+ i step)) - ::invalid)))) - (let [limit *coll-check-limit*] - (loop [i 0 [v & vs :as vseq] (seq x)] - (cond - (c/or (nil? vseq) (= i limit)) x - (valid? spec v) (recur (inc i) vs) - :else ::invalid))))))) - (unform* [_ x] x) - (explain* [_ path via in x] - (c/or (coll-prob x kind kind-form distinct count min-count max-count - path via in) - (apply concat - ((if conform-all identity (partial take *coll-error-limit*)) - (keep identity - (map (fn [i v] - (let [k (kfn i v)] - (when-not (check? v) - (let [prob (explain-1 form pred path via (conj in k) v)] - prob)))) - (range) x)))))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [pgen (gensub pred overrides path rmap form)] - (gen/bind - (cond - gen-into (gen/return (empty gen-into)) - kind (gen/fmap #(if (empty? %) % (empty %)) - (gensub kind overrides path rmap form)) - :else (gen/return [])) - (fn [init] - (gen/fmap - #(if (vector? init) % (into init %)) - (cond - distinct - (if count - (gen/vector-distinct pgen {:num-elements count :max-tries 100}) - (gen/vector-distinct pgen {:min-elements (c/or min-count 0) - :max-elements (c/or max-count (max gen-max (c/* 2 (c/or min-count 0)))) - :max-tries 100})) - - count - (gen/vector pgen count) - - (c/or min-count max-count) - (gen/vector pgen (c/or min-count 0) (c/or max-count (max gen-max (c/* 2 (c/or min-count 0))))) - - :else - (gen/vector pgen 0 gen-max)))))))) - - (with-gen* [_ gfn] (every-impl form pred opts gfn)) - (describe* [_] (c/or describe-form `(every ~(res form) ~@(mapcat identity opts)))))))) - -;;;;;;;;;;;;;;;;;;;;;;; regex ;;;;;;;;;;;;;;;;;;; -;;See: -;; http://matt.might.net/articles/implementation-of-regular-expression-matching-in-scheme-with-derivatives/ -;; http://www.ccs.neu.edu/home/turon/re-deriv.pdf - -;;ctors -(defn- accept [x] {::op ::accept :ret x}) - -(defn- accept? [{:keys [::op]}] - (= ::accept op)) - -(defn- pcat* [{[p1 & pr :as ps] :ps, [k1 & kr :as ks] :ks, [f1 & fr :as forms] :forms, ret :ret, rep+ :rep+}] - (when (every? identity ps) - (if (accept? p1) - (let [rp (:ret p1) - ret (conj ret (if ks {k1 rp} rp))] - (if pr - (pcat* {:ps pr :ks kr :forms fr :ret ret}) - (accept ret))) - {::op ::pcat, :ps ps, :ret ret, :ks ks, :forms forms :rep+ rep+}))) - -(defn- pcat [& ps] (pcat* {:ps ps :ret []})) - -(defn ^:skip-wiki cat-impl - "Do not call this directly, use 'cat'" - [ks ps forms] - (pcat* {:ks ks, :ps ps, :forms forms, :ret {}})) - -(defn- rep* [p1 p2 ret splice form] - (when p1 - (let [r {::op ::rep, :p2 p2, :splice splice, :forms form :id (java.util.UUID/randomUUID)}] - (if (accept? p1) - (assoc r :p1 p2 :ret (conj ret (:ret p1))) - (assoc r :p1 p1, :ret ret))))) - -(defn ^:skip-wiki rep-impl - "Do not call this directly, use '*'" - [form p] (rep* p p [] false form)) - -(defn ^:skip-wiki rep+impl - "Do not call this directly, use '+'" - [form p] - (pcat* {:ps [p (rep* p p [] true form)] :forms `[~form (* ~form)] :ret [] :rep+ form})) - -(defn ^:skip-wiki amp-impl - "Do not call this directly, use '&'" - [re preds pred-forms] - {::op ::amp :p1 re :ps preds :forms pred-forms}) - -(defn- filter-alt [ps ks forms f] - (if (c/or ks forms) - (let [pks (->> (map vector ps - (c/or (seq ks) (repeat nil)) - (c/or (seq forms) (repeat nil))) - (filter #(-> % first f)))] - [(seq (map first pks)) (when ks (seq (map second pks))) (when forms (seq (map #(nth % 2) pks)))]) - [(seq (filter f ps)) ks forms])) - -(defn- alt* [ps ks forms] - (let [[[p1 & pr :as ps] [k1 :as ks] forms] (filter-alt ps ks forms identity)] - (when ps - (let [ret {::op ::alt, :ps ps, :ks ks :forms forms}] - (if (nil? pr) - (if k1 - (if (accept? p1) - (accept (tagged-ret k1 (:ret p1))) - ret) - p1) - ret))))) - -(defn- alts [& ps] (alt* ps nil nil)) -(defn- alt2 [p1 p2] (if (c/and p1 p2) (alts p1 p2) (c/or p1 p2))) - -(defn ^:skip-wiki alt-impl - "Do not call this directly, use 'alt'" - [ks ps forms] (assoc (alt* ps ks forms) :id (java.util.UUID/randomUUID))) - -(defn ^:skip-wiki maybe-impl - "Do not call this directly, use '?'" - [p form] (assoc (alt* [p (accept ::nil)] nil [form ::nil]) :maybe form)) - -(defn- noret? [p1 pret] - (c/or (= pret ::nil) - (c/and (#{::rep ::pcat} (::op (reg-resolve! p1))) ;;hrm, shouldn't know these - (empty? pret)) - nil)) - -(declare preturn) - -(defn- accept-nil? [p] - (let [{:keys [::op ps p1 p2 forms] :as p} (reg-resolve! p)] - (case op - ::accept true - nil nil - ::amp (c/and (accept-nil? p1) - (c/or (noret? p1 (preturn p1)) - (let [ret (-> (preturn p1) (and-preds ps (next forms)))] - (not (invalid? ret))))) - ::rep (c/or (identical? p1 p2) (accept-nil? p1)) - ::pcat (every? accept-nil? ps) - ::alt (c/some accept-nil? ps)))) - -(declare add-ret) - -(defn- preturn [p] - (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms] :as p} (reg-resolve! p)] - (case op - ::accept ret - nil nil - ::amp (let [pret (preturn p1)] - (if (noret? p1 pret) - ::nil - (and-preds pret ps forms))) - ::rep (add-ret p1 ret k) - ::pcat (add-ret p0 ret k) - ::alt (let [[[p0] [k0]] (filter-alt ps ks forms accept-nil?) - r (if (nil? p0) ::nil (preturn p0))] - (if k0 (tagged-ret k0 r) r))))) - -(defn- op-unform [p x] - ;;(prn {:p p :x x}) - (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms rep+ maybe] :as p} (reg-resolve! p) - kps (zipmap ks ps)] - (case op - ::accept [ret] - nil [(unform p x)] - ::amp (let [px (reduce #(unform %2 %1) x (reverse ps))] - (op-unform p1 px)) - ::rep (mapcat #(op-unform p1 %) x) - ::pcat (if rep+ - (mapcat #(op-unform p0 %) x) - (mapcat (fn [k] - (when (contains? x k) - (op-unform (kps k) (get x k)))) - ks)) - ::alt (if maybe - [(unform p0 x)] - (let [[k v] x] - (op-unform (kps k) v)))))) - -(defn- add-ret [p r k] - (let [{:keys [::op ps splice] :as p} (reg-resolve! p) - prop #(let [ret (preturn p)] - (if (empty? ret) r ((if splice into conj) r (if k {k ret} ret))))] - (case op - nil r - (::alt ::accept ::amp) - (let [ret (preturn p)] - ;;(prn {:ret ret}) - (if (= ret ::nil) r (conj r (if k {k ret} ret)))) - - (::rep ::pcat) (prop)))) - -(defn- deriv - [p x] - (let [{[p0 & pr :as ps] :ps, [k0 & kr :as ks] :ks, :keys [::op p1 p2 ret splice forms] :as p} (reg-resolve! p)] - (when p - (case op - ::accept nil - nil (let [ret (dt p x p)] - (when-not (invalid? ret) (accept ret))) - ::amp (when-let [p1 (deriv p1 x)] - (if (= ::accept (::op p1)) - (let [ret (-> (preturn p1) (and-preds ps (next forms)))] - (when-not (invalid? ret) - (accept ret))) - (amp-impl p1 ps forms))) - ::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret}) - (when (accept-nil? p0) (deriv (pcat* {:ps pr, :ks kr, :forms (next forms), :ret (add-ret p0 ret k0)}) x))) - ::alt (alt* (map #(deriv % x) ps) ks forms) - ::rep (alt2 (rep* (deriv p1 x) p2 ret splice forms) - (when (accept-nil? p1) (deriv (rep* p2 p2 (add-ret p1 ret nil) splice forms) x))))))) - -(defn- op-describe [p] - (let [{:keys [::op ps ks forms splice p1 rep+ maybe] :as p} (reg-resolve! p)] - ;;(prn {:op op :ks ks :forms forms :p p}) - (when p - (case op - ::accept nil - nil p - ::amp (list* 'clojure.spec/& (op-describe p1) forms) - ::pcat (if rep+ - (list `+ rep+) - (cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) forms))) - ::alt (if maybe - (list `? (res maybe)) - (cons `alt (mapcat vector ks forms))) - ::rep (list (if splice `+ `*) forms))))) - -(defn- op-explain [form p path via in input] - ;;(prn {:form form :p p :path path :input input}) - (let [[x :as input] input - {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve! p) - via (if-let [name (spec-name p)] (conj via name) via) - insufficient (fn [path form] - [{:path path - :reason "Insufficient input" - :pred (abbrev form) - :val () - :via via - :in in}])] - (when p - (case op - ::accept nil - nil (if (empty? input) - (insufficient path form) - (explain-1 form p path via in x)) - ::amp (if (empty? input) - (if (accept-nil? p1) - (explain-pred-list forms ps path via in (preturn p1)) - (insufficient path (op-describe p1))) - (if-let [p1 (deriv p1 x)] - (explain-pred-list forms ps path via in (preturn p1)) - (op-explain (op-describe p1) p1 path via in input))) - ::pcat (let [pkfs (map vector - ps - (c/or (seq ks) (repeat nil)) - (c/or (seq forms) (repeat nil))) - [pred k form] (if (= 1 (count pkfs)) - (first pkfs) - (first (remove (fn [[p]] (accept-nil? p)) pkfs))) - path (if k (conj path k) path) - form (c/or form (op-describe pred))] - (if (c/and (empty? input) (not pred)) - (insufficient path form) - (op-explain form pred path via in input))) - ::alt (if (empty? input) - (insufficient path (op-describe p)) - (apply concat - (map (fn [k form pred] - (op-explain (c/or form (op-describe pred)) - pred - (if k (conj path k) path) - via - in - input)) - (c/or (seq ks) (repeat nil)) - (c/or (seq forms) (repeat nil)) - ps))) - ::rep (op-explain (if (identical? p1 p2) - forms - (op-describe p1)) - p1 path via in input))))) - -(defn- re-gen [p overrides path rmap f] - ;;(prn {:op op :ks ks :forms forms}) - (let [origp p - {:keys [::op ps ks p1 p2 forms splice ret id ::gfn] :as p} (reg-resolve! p) - rmap (if id (inck rmap id) rmap) - ggens (fn [ps ks forms] - (let [gen (fn [p k f] - ;;(prn {:k k :path path :rmap rmap :op op :id id}) - (when-not (c/and rmap id k (recur-limit? rmap id path k)) - (if id - (gen/delay (re-gen p overrides (if k (conj path k) path) rmap (c/or f p))) - (re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))))] - (map gen ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)))))] - (c/or (when-let [gfn (c/or (get overrides (spec-name origp)) - (get overrides (spec-name p) ) - (get overrides path))] - (case op - (:accept nil) (gen/fmap vector (gfn)) - (gfn))) - (when gfn - (gfn)) - (when p - (case op - ::accept (if (= ret ::nil) - (gen/return []) - (gen/return [ret])) - nil (when-let [g (gensub p overrides path rmap f)] - (gen/fmap vector g)) - ::amp (re-gen p1 overrides path rmap (op-describe p1)) - ::pcat (let [gens (ggens ps ks forms)] - (when (every? identity gens) - (apply gen/cat gens))) - ::alt (let [gens (remove nil? (ggens ps ks forms))] - (when-not (empty? gens) - (gen/one-of gens))) - ::rep (if (recur-limit? rmap id [id] id) - (gen/return []) - (when-let [g (re-gen p2 overrides path rmap forms)] - (gen/fmap #(apply concat %) - (gen/vector g))))))))) - -(defn- re-conform [p [x & xs :as data]] - ;;(prn {:p p :x x :xs xs}) - (if (empty? data) - (if (accept-nil? p) - (let [ret (preturn p)] - (if (= ret ::nil) - nil - ret)) - ::invalid) - (if-let [dp (deriv p x)] - (recur dp xs) - ::invalid))) - -(defn- re-explain [path via in re input] - (loop [p re [x & xs :as data] input i 0] - ;;(prn {:p p :x x :xs xs :re re}) (prn) - (if (empty? data) - (if (accept-nil? p) - nil ;;success - (op-explain (op-describe p) p path via in nil)) - (if-let [dp (deriv p x)] - (recur dp xs (inc i)) - (if (accept? p) - (if (= (::op p) ::pcat) - (op-explain (op-describe p) p path via (conj in i) (seq data)) - [{:path path - :reason "Extra input" - :pred (abbrev (op-describe re)) - :val data - :via via - :in (conj in i)}]) - (c/or (op-explain (op-describe p) p path via (conj in i) (seq data)) - [{:path path - :reason "Extra input" - :pred (abbrev (op-describe p)) - :val data - :via via - :in (conj in i)}])))))) - -(defn ^:skip-wiki regex-spec-impl - "Do not call this directly, use 'spec' with a regex op argument" - [re gfn] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] - (if (c/or (nil? x) (coll? x)) - (re-conform re (seq x)) - ::invalid)) - (unform* [_ x] (op-unform re x)) - (explain* [_ path via in x] - (if (c/or (nil? x) (coll? x)) - (re-explain path via in re (seq x)) - [{:path path :pred (abbrev (op-describe re)) :val x :via via :in in}])) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (re-gen re overrides path rmap (op-describe re)))) - (with-gen* [_ gfn] (regex-spec-impl re gfn)) - (describe* [_] (op-describe re)))) - -;;;;;;;;;;;;;;;;; HOFs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- call-valid? - [f specs args] - (let [cargs (conform (:args specs) args)] - (when-not (invalid? cargs) - (let [ret (apply f args) - cret (conform (:ret specs) ret)] - (c/and (not (invalid? cret)) - (if (:fn specs) - (pvalid? (:fn specs) {:args cargs :ret cret}) - true)))))) - -(defn- validate-fn - "returns f if valid, else smallest" - [f specs iters] - (let [g (gen (:args specs)) - prop (gen/for-all* [g] #(call-valid? f specs %))] - (let [ret (gen/quick-check iters prop)] - (if-let [[smallest] (-> ret :shrunk :smallest)] - smallest - f)))) - -(defn ^:skip-wiki fspec-impl - "Do not call this directly, use 'fspec'" - [argspec aform retspec rform fnspec fform gfn] - (let [specs {:args argspec :ret retspec :fn fnspec}] - (reify - clojure.lang.ILookup - (valAt [this k] (get specs k)) - (valAt [_ k not-found] (get specs k not-found)) - - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [this f] (if argspec - (if (ifn? f) - (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) - ::invalid) - (throw (Exception. (str "Can't conform fspec without args spec: " (pr-str (describe this))))))) - (unform* [_ f] f) - (explain* [_ path via in f] - (if (ifn? f) - (let [args (validate-fn f specs 100)] - (if (identical? f args) ;;hrm, we might not be able to reproduce - nil - (let [ret (try (apply f args) (catch Throwable t t))] - (if (instance? Throwable ret) - ;;TODO add exception data - [{:path path :pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via :in in}] - - (let [cret (dt retspec ret rform)] - (if (invalid? cret) - (explain-1 rform retspec (conj path :ret) via in ret) - (when fnspec - (let [cargs (conform argspec args)] - (explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret}))))))))) - [{:path path :pred 'ifn? :val f :via via :in in}])) - (gen* [_ overrides _ _] (if gfn - (gfn) - (gen/return - (fn [& args] - (c/assert (pvalid? argspec args) (with-out-str (explain argspec args))) - (gen/generate (gen retspec overrides)))))) - (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn)) - (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(clojure.spec/def ::kvs->map (conformer #(zipmap (map ::k %) (map ::v %)) #(map (fn [[k v]] {::k k ::v v}) %))) - -(defmacro keys* - "takes the same arguments as spec/keys and returns a regex op that matches sequences of key/values, - converts them into a map, and conforms that map with a corresponding - spec/keys call: - - user=> (s/conform (s/keys :req-un [::a ::c]) {:a 1 :c 2}) - {:a 1, :c 2} - user=> (s/conform (s/keys* :req-un [::a ::c]) [:a 1 :c 2]) - {:a 1, :c 2} - - the resulting regex op can be composed into a larger regex: - - user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99]) - {:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}" - [& kspecs] - `(let [mspec# (keys ~@kspecs)] - (with-gen (clojure.spec/& (* (cat ::k keyword? ::v any?)) ::kvs->map mspec#) - (fn [] (gen/fmap (fn [m#] (apply concat m#)) (gen mspec#)))))) - -(defn ^:skip-wiki nonconforming - "takes a spec and returns a spec that has the same properties except - 'conform' returns the original (not the conformed) value. Note, will specize regex ops." - [spec] - (let [spec (delay (specize spec))] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (let [ret (conform* @spec x)] - (if (invalid? ret) - ::invalid - x))) - (unform* [_ x] x) - (explain* [_ path via in x] (explain* @spec path via in x)) - (gen* [_ overrides path rmap] (gen* @spec overrides path rmap)) - (with-gen* [_ gfn] (nonconforming (with-gen* @spec gfn))) - (describe* [_] `(nonconforming ~(describe* @spec)))))) - -(defn ^:skip-wiki nilable-impl - "Do not call this directly, use 'nilable'" - [form pred gfn] - (let [spec (delay (specize pred form))] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (if (nil? x) nil (conform* @spec x))) - (unform* [_ x] (if (nil? x) nil (unform* @spec x))) - (explain* [_ path via in x] - (when-not (c/or (pvalid? @spec x) (nil? x)) - (conj - (explain-1 form pred (conj path ::pred) via in x) - {:path (conj path ::nil) :pred 'nil? :val x :via via :in in}))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (gen/frequency - [[1 (gen/delay (gen/return nil))] - [9 (gen/delay (gensub pred overrides (conj path ::pred) rmap form))]]))) - (with-gen* [_ gfn] (nilable-impl form pred gfn)) - (describe* [_] `(nilable ~(res form)))))) - -(defmacro nilable - "returns a spec that accepts nil and values satisfying pred" - [pred] - (let [pf (res pred)] - `(nilable-impl '~pf ~pred nil))) - -(defn exercise - "generates a number (default 10) of values compatible with spec and maps conform over them, - returning a sequence of [val conformed-val] tuples. Optionally takes - a generator overrides map as per gen" - ([spec] (exercise spec 10)) - ([spec n] (exercise spec n nil)) - ([spec n overrides] - (map #(vector % (conform spec %)) (gen/sample (gen spec overrides) n)))) - -(defn exercise-fn - "exercises the fn named by sym (a symbol) by applying it to - n (default 10) generated samples of its args spec. When fspec is - supplied its arg spec is used, and sym-or-f can be a fn. Returns a - sequence of tuples of [args ret]. " - ([sym] (exercise-fn sym 10)) - ([sym n] (exercise-fn sym n (get-spec sym))) - ([sym-or-f n fspec] - (let [f (if (symbol? sym-or-f) (resolve sym-or-f) sym-or-f)] - (for [args (gen/sample (gen (:args fspec)) n)] - [args (apply f args)])))) - -(defn inst-in-range? - "Return true if inst at or after start and before end" - [start end inst] - (c/and (inst? inst) - (let [t (inst-ms inst)] - (c/and (<= (inst-ms start) t) (< t (inst-ms end)))))) - -(defmacro inst-in - "Returns a spec that validates insts in the range from start -(inclusive) to end (exclusive)." - [start end] - `(let [st# (inst-ms ~start) - et# (inst-ms ~end) - mkdate# (fn [d#] (java.util.Date. ^{:tag ~'long} d#))] - (spec (and inst? #(inst-in-range? ~start ~end %)) - :gen (fn [] - (gen/fmap mkdate# - (gen/large-integer* {:min st# :max et#})))))) - -(defn int-in-range? - "Return true if start <= val and val < end" - [start end val] - (c/and int? (<= start val) (< val end))) - -(defmacro int-in - "Returns a spec that validates ints in the range from start -(inclusive) to end (exclusive)." - [start end] - `(spec (and int? #(int-in-range? ~start ~end %)) - :gen #(gen/large-integer* {:min ~start :max (dec ~end)}))) - -(defmacro double-in - "Specs a 64-bit floating point number. Options: - - :infinite? - whether +/- infinity allowed (default true) - :NaN? - whether NaN allowed (default true) - :min - minimum value (inclusive, default none) - :max - maximum value (inclusive, default none)" - [& {:keys [infinite? NaN? min max] - :or {infinite? true NaN? true} - :as m}] - `(spec (and c/double? - ~@(when-not infinite? '[#(not (Double/isInfinite %))]) - ~@(when-not NaN? '[#(not (Double/isNaN %))]) - ~@(when max `[#(<= % ~max)]) - ~@(when min `[#(<= ~min %)])) - :gen #(gen/double* ~m))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; assert ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defonce - ^{:dynamic true - :doc "If true, compiler will enable spec asserts, which are then -subject to runtime control via check-asserts? If false, compiler -will eliminate all spec assert overhead. See 'assert'. - -Initially set to boolean value of clojure.spec.compile-asserts -system property. Defaults to true."} - *compile-asserts* - (not= "false" (System/getProperty "clojure.spec.compile-asserts"))) - -(defn check-asserts? - "Returns the value set by check-asserts." - [] - clojure.lang.RT/checkSpecAsserts) - -(defn check-asserts - "Enable or disable spec asserts that have been compiled -with '*compile-asserts*' true. See 'assert'. - -Initially set to boolean value of clojure.spec.check-asserts -system property. Defaults to false." - [flag] - (set! (. clojure.lang.RT checkSpecAsserts) flag)) - -(defn assert* - "Do not call this directly, use 'assert'." - [spec x] - (if (valid? spec x) - x - (let [ed (c/merge (assoc (explain-data* spec [] [] [] x) - ::failure :assertion-failed))] - (throw (ex-info - (str "Spec assertion failed\n" (with-out-str (explain-out ed))) - ed))))) - -(defmacro assert - "spec-checking assert expression. Returns x if x is valid? according -to spec, else throws an ex-info with explain-data plus ::failure of -:assertion-failed. - -Can be disabled at either compile time or runtime: - -If *compile-asserts* is false at compile time, compiles to x. Defaults -to value of 'clojure.spec.compile-asserts' system property, or true if -not set. - -If (check-asserts?) is false at runtime, always returns x. Defaults to -value of 'clojure.spec.check-asserts' system property, or false if not -set. You can toggle check-asserts? with (check-asserts bool)." - [spec x] - (if *compile-asserts* - `(if clojure.lang.RT/checkSpecAsserts - (assert* ~spec ~x) - ~x) - x)) - - diff --git a/src/clj/clojure/spec/gen.clj b/src/clj/clojure/spec/gen.clj deleted file mode 100644 index 6d8e2388..00000000 --- a/src/clj/clojure/spec/gen.clj +++ /dev/null @@ -1,224 +0,0 @@ -; Copyright (c) Rich Hickey. 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.spec.gen - (:refer-clojure :exclude [boolean bytes cat hash-map list map not-empty set vector - char double int keyword symbol string uuid delay])) - -(alias 'c 'clojure.core) - -(defn- dynaload - [s] - (let [ns (namespace s)] - (assert ns) - (require (c/symbol ns)) - (let [v (resolve s)] - (if v - @v - (throw (RuntimeException. (str "Var " s " is not on the classpath"))))))) - -(def ^:private quick-check-ref - (c/delay (dynaload 'clojure.test.check/quick-check))) -(defn quick-check - [& args] - (apply @quick-check-ref args)) - -(def ^:private for-all*-ref - (c/delay (dynaload 'clojure.test.check.properties/for-all*))) -(defn for-all* - "Dynamically loaded clojure.test.check.properties/for-all*." - [& args] - (apply @for-all*-ref args)) - -(let [g? (c/delay (dynaload 'clojure.test.check.generators/generator?)) - g (c/delay (dynaload 'clojure.test.check.generators/generate)) - mkg (c/delay (dynaload 'clojure.test.check.generators/->Generator))] - (defn- generator? - [x] - (@g? x)) - (defn- generator - [gfn] - (@mkg gfn)) - (defn generate - "Generate a single value using generator." - [generator] - (@g generator))) - -(defn ^:skip-wiki delay-impl - [gfnd] - ;;N.B. depends on test.check impl details - (generator (fn [rnd size] - ((:gen @gfnd) rnd size)))) - -(defmacro delay - "given body that returns a generator, returns a - generator that delegates to that, but delays - creation until used." - [& body] - `(delay-impl (c/delay ~@body))) - -(defn gen-for-name - "Dynamically loads test.check generator named s." - [s] - (let [g (dynaload s)] - (if (generator? g) - g - (throw (RuntimeException. (str "Var " s " is not a generator")))))) - -(defmacro ^:skip-wiki lazy-combinator - "Implementation macro, do not call directly." - [s] - (let [fqn (c/symbol "clojure.test.check.generators" (name s)) - doc (str "Lazy loaded version of " fqn)] - `(let [g# (c/delay (dynaload '~fqn))] - (defn ~s - ~doc - [& ~'args] - (apply @g# ~'args))))) - -(defmacro ^:skip-wiki lazy-combinators - "Implementation macro, do not call directly." - [& syms] - `(do - ~@(c/map - (fn [s] (c/list 'lazy-combinator s)) - syms))) - -(lazy-combinators hash-map list map not-empty set vector vector-distinct fmap elements - bind choose fmap one-of such-that tuple sample return - large-integer* double* frequency) - -(defmacro ^:skip-wiki lazy-prim - "Implementation macro, do not call directly." - [s] - (let [fqn (c/symbol "clojure.test.check.generators" (name s)) - doc (str "Fn returning " fqn)] - `(let [g# (c/delay (dynaload '~fqn))] - (defn ~s - ~doc - [& ~'args] - @g#)))) - -(defmacro ^:skip-wiki lazy-prims - "Implementation macro, do not call directly." - [& syms] - `(do - ~@(c/map - (fn [s] (c/list 'lazy-prim s)) - syms))) - -(lazy-prims any any-printable boolean bytes char char-alpha char-alphanumeric char-ascii double - int keyword keyword-ns large-integer ratio simple-type simple-type-printable - string string-ascii string-alphanumeric symbol symbol-ns uuid) - -(defn cat - "Returns a generator of a sequence catenated from results of -gens, each of which should generate something sequential." - [& gens] - (fmap #(apply concat %) - (apply tuple gens))) - -(defn- qualified? [ident] (not (nil? (namespace ident)))) - -(def ^:private - gen-builtins - (c/delay - (let [simple (simple-type-printable)] - {any? (one-of [(return nil) (any-printable)]) - some? (such-that some? (any-printable)) - number? (one-of [(large-integer) (double)]) - integer? (large-integer) - int? (large-integer) - pos-int? (large-integer* {:min 1}) - neg-int? (large-integer* {:max -1}) - nat-int? (large-integer* {:min 0}) - float? (double) - double? (double) - boolean? (boolean) - string? (string-alphanumeric) - ident? (one-of [(keyword-ns) (symbol-ns)]) - simple-ident? (one-of [(keyword) (symbol)]) - qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)])) - keyword? (keyword-ns) - simple-keyword? (keyword) - qualified-keyword? (such-that qualified? (keyword-ns)) - symbol? (symbol-ns) - simple-symbol? (symbol) - qualified-symbol? (such-that qualified? (symbol-ns)) - uuid? (uuid) - uri? (fmap #(java.net.URI/create (str "http://" % ".com")) (uuid)) - bigdec? (fmap #(BigDecimal/valueOf %) - (double* {:infinite? false :NaN? false})) - inst? (fmap #(java.util.Date. %) - (large-integer)) - seqable? (one-of [(return nil) - (list simple) - (vector simple) - (map simple simple) - (set simple) - (string-alphanumeric)]) - indexed? (vector simple) - map? (map simple simple) - vector? (vector simple) - list? (list simple) - seq? (list simple) - char? (char) - set? (set simple) - nil? (return nil) - false? (return false) - true? (return true) - zero? (return 0) - rational? (one-of [(large-integer) (ratio)]) - coll? (one-of [(map simple simple) - (list simple) - (vector simple) - (set simple)]) - empty? (elements [nil '() [] {} #{}]) - associative? (one-of [(map simple simple) (vector simple)]) - sequential? (one-of [(list simple) (vector simple)]) - ratio? (such-that ratio? (ratio)) - bytes? (bytes)}))) - -(defn gen-for-pred - "Given a predicate, returns a built-in generator if one exists." - [pred] - (if (set? pred) - (elements pred) - (get @gen-builtins pred))) - -(comment - (require :reload 'clojure.spec.gen) - (in-ns 'clojure.spec.gen) - - ;; combinators, see call to lazy-combinators above for complete list - (generate (one-of [(gen-for-pred integer?) (gen-for-pred string?)])) - (generate (such-that #(< 10000 %) (gen-for-pred integer?))) - (let [reqs {:a (gen-for-pred number?) - :b (gen-for-pred ratio?)} - opts {:c (gen-for-pred string?)}] - (generate (bind (choose 0 (count opts)) - #(let [args (concat (seq reqs) (shuffle (seq opts)))] - (->> args - (take (+ % (count reqs))) - (mapcat identity) - (apply hash-map)))))) - (generate (cat (list (gen-for-pred string?)) - (list (gen-for-pred ratio?)))) - - ;; load your own generator - (gen-for-name 'clojure.test.check.generators/int) - - ;; failure modes - (gen-for-name 'unqualified) - (gen-for-name 'clojure.core/+) - (gen-for-name 'clojure.core/name-does-not-exist) - (gen-for-name 'ns.does.not.exist/f) - - ) - - diff --git a/src/clj/clojure/spec/test.clj b/src/clj/clojure/spec/test.clj deleted file mode 100644 index 587f441e..00000000 --- a/src/clj/clojure/spec/test.clj +++ /dev/null @@ -1,466 +0,0 @@ -; Copyright (c) Rich Hickey. 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.spec.test - (:refer-clojure :exclude [test]) - (:require - [clojure.pprint :as pp] - [clojure.spec :as s] - [clojure.spec.gen :as gen] - [clojure.string :as str])) - -(in-ns 'clojure.spec.test.check) -(in-ns 'clojure.spec.test) -(alias 'stc 'clojure.spec.test.check) - -(defn- throwable? - [x] - (instance? Throwable x)) - -(defn ->sym - [x] - (@#'s/->sym x)) - -(defn- ->var - [s-or-v] - (if (var? s-or-v) - s-or-v - (let [v (and (symbol? s-or-v) (resolve s-or-v))] - (if (var? v) - v - (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var"))))))) - -(defn- collectionize - [x] - (if (symbol? x) - (list x) - x)) - -(defn enumerate-namespace - "Given a symbol naming an ns, or a collection of such symbols, -returns the set of all symbols naming vars in those nses." - [ns-sym-or-syms] - (into - #{} - (mapcat (fn [ns-sym] - (map - (fn [name-sym] - (symbol (name ns-sym) (name name-sym))) - (keys (ns-interns ns-sym))))) - (collectionize ns-sym-or-syms))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^:private ^:dynamic *instrument-enabled* - "if false, instrumented fns call straight through" - true) - -(defn- fn-spec? - "Fn-spec must include at least :args or :ret specs." - [m] - (or (:args m) (:ret m))) - -(defmacro with-instrument-disabled - "Disables instrument's checking of calls, within a scope." - [& body] - `(binding [*instrument-enabled* nil] - ~@body)) - -(defn- interpret-stack-trace-element - "Given the vector-of-syms form of a stacktrace element produced -by e.g. Throwable->map, returns a map form that adds some keys -guessing the original Clojure names. Returns a map with - - :class class name symbol from stack trace - :method method symbol from stack trace - :file filename from stack trace - :line line number from stack trace - :var-scope optional Clojure var symbol scoping fn def - :local-fn optional local Clojure symbol scoping fn def - -For non-Clojure fns, :scope and :local-fn will be absent." - [[cls method file line]] - (let [clojure? (contains? '#{invoke invokeStatic} method) - demunge #(clojure.lang.Compiler/demunge %) - degensym #(str/replace % #"--.*" "") - [ns-sym name-sym local] (when clojure? - (->> (str/split (str cls) #"\$" 3) - (map demunge)))] - (merge {:file file - :line line - :method method - :class cls} - (when (and ns-sym name-sym) - {:var-scope (symbol ns-sym name-sym)}) - (when local - {:local-fn (symbol (degensym local))})))) - -(defn- stacktrace-relevant-to-instrument - "Takes a coll of stack trace elements (as returned by -StackTraceElement->vec) and returns a coll of maps as per -interpret-stack-trace-element that are relevant to a -failure in instrument." - [elems] - (let [plumbing? (fn [{:keys [var-scope]}] - (contains? '#{clojure.spec.test/spec-checking-fn} var-scope))] - (sequence (comp (map StackTraceElement->vec) - (map interpret-stack-trace-element) - (filter :var-scope) - (drop-while plumbing?)) - elems))) - -(defn- spec-checking-fn - [v f fn-spec] - (let [fn-spec (@#'s/maybe-spec fn-spec) - conform! (fn [v role spec data args] - (let [conformed (s/conform spec data)] - (if (= ::s/invalid conformed) - (let [caller (->> (.getStackTrace (Thread/currentThread)) - stacktrace-relevant-to-instrument - first) - ed (merge (assoc (s/explain-data* spec [role] [] [] data) - ::s/args args - ::s/failure :instrument) - (when caller - {::caller (dissoc caller :class :method)}))] - (throw (ex-info - (str "Call to " v " did not conform to spec:\n" (with-out-str (s/explain-out ed))) - ed))) - conformed)))] - (fn - [& args] - (if *instrument-enabled* - (with-instrument-disabled - (when (:args fn-spec) (conform! v :args (:args fn-spec) args args)) - (binding [*instrument-enabled* true] - (.applyTo ^clojure.lang.IFn f args))) - (.applyTo ^clojure.lang.IFn f args))))) - -(defn- no-fspec - [v spec] - (ex-info (str "Fn at " v " is not spec'ed.") - {:var v :spec spec ::s/failure :no-fspec})) - -(defonce ^:private instrumented-vars (atom {})) - -(defn- instrument-choose-fn - "Helper for instrument." - [f spec sym {over :gen :keys [stub replace]}] - (if (some #{sym} stub) - (-> spec (s/gen over) gen/generate) - (get replace sym f))) - -(defn- instrument-choose-spec - "Helper for instrument" - [spec sym {overrides :spec}] - (get overrides sym spec)) - -(defn- instrument-1 - [s opts] - (when-let [v (resolve s)] - (when-not (-> v meta :macro) - (let [spec (s/get-spec v) - {:keys [raw wrapped]} (get @instrumented-vars v) - current @v - to-wrap (if (= wrapped current) raw current) - ospec (or (instrument-choose-spec spec s opts) - (throw (no-fspec v spec))) - ofn (instrument-choose-fn to-wrap ospec s opts) - checked (spec-checking-fn v ofn ospec)] - (alter-var-root v (constantly checked)) - (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked}) - (->sym v))))) - -(defn- unstrument-1 - [s] - (when-let [v (resolve s)] - (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] - (swap! instrumented-vars dissoc v) - (let [current @v] - (when (= wrapped current) - (alter-var-root v (constantly raw)) - (->sym v)))))) - -(defn- opt-syms - "Returns set of symbols referenced by 'instrument' opts map" - [opts] - (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))])) - -(defn- fn-spec-name? - [s] - (and (symbol? s) - (not (some-> (resolve s) meta :macro)))) - -(defn instrumentable-syms - "Given an opts map as per instrument, returns the set of syms -that can be instrumented." - ([] (instrumentable-syms nil)) - ([opts] - (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys") - (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) - (keys (:spec opts)) - (:stub opts) - (keys (:replace opts))]))) - -(defn instrument - "Instruments the vars named by sym-or-syms, a symbol or collection -of symbols, or all instrumentable vars if sym-or-syms is not -specified. - -If a var has an :args fn-spec, sets the var's root binding to a -fn that checks arg conformance (throwing an exception on failure) -before delegating to the original fn. - -The opts map can be used to override registered specs, and/or to -replace fn implementations entirely. Opts for symbols not included -in sym-or-syms are ignored. This facilitates sharing a common -options map across many different calls to instrument. - -The opts map may have the following keys: - - :spec a map from var-name symbols to override specs - :stub a set of var-name symbols to be replaced by stubs - :gen a map from spec names to generator overrides - :replace a map from var-name symbols to replacement fns - -:spec overrides registered fn-specs with specs your provide. Use -:spec overrides to provide specs for libraries that do not have -them, or to constrain your own use of a fn to a subset of its -spec'ed contract. - -:stub replaces a fn with a stub that checks :args, then uses the -:ret spec to generate a return value. - -:gen overrides are used only for :stub generation. - -:replace replaces a fn with a fn that checks args conformance, then -invokes the fn you provide, enabling arbitrary stubbing and mocking. - -:spec can be used in combination with :stub or :replace. - -Returns a collection of syms naming the vars instrumented." - ([] (instrument (instrumentable-syms))) - ([sym-or-syms] (instrument sym-or-syms nil)) - ([sym-or-syms opts] - (locking instrumented-vars - (into - [] - (comp (filter (instrumentable-syms opts)) - (distinct) - (map #(instrument-1 % opts)) - (remove nil?)) - (collectionize sym-or-syms))))) - -(defn unstrument - "Undoes instrument on the vars named by sym-or-syms, specified -as in instrument. With no args, unstruments all instrumented vars. -Returns a collection of syms naming the vars unstrumented." - ([] (unstrument (map ->sym (keys @instrumented-vars)))) - ([sym-or-syms] - (locking instrumented-vars - (into - [] - (comp (filter symbol?) - (map unstrument-1) - (remove nil?)) - (collectionize sym-or-syms))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- explain-check - [args spec v role] - (ex-info - "Specification-based check failed" - (when-not (s/valid? spec v nil) - (assoc (s/explain-data* spec [role] [] [] v) - ::args args - ::val v - ::s/failure :check-failed)))) - -(defn- check-call - "Returns true if call passes specs, otherwise *returns* an exception -with explain-data + ::s/failure." - [f specs args] - (let [cargs (when (:args specs) (s/conform (:args specs) args))] - (if (= cargs ::s/invalid) - (explain-check args (:args specs) args :args) - (let [ret (apply f args) - cret (when (:ret specs) (s/conform (:ret specs) ret))] - (if (= cret ::s/invalid) - (explain-check args (:ret specs) ret :ret) - (if (and (:args specs) (:ret specs) (:fn specs)) - (if (s/valid? (:fn specs) {:args cargs :ret cret}) - true - (explain-check args (:fn specs) {:args cargs :ret cret} :fn)) - true)))))) - -(defn- quick-check - [f specs {gen :gen opts ::stc/opts}] - (let [{:keys [num-tests] :or {num-tests 1000}} opts - g (try (s/gen (:args specs) gen) (catch Throwable t t))] - (if (throwable? g) - {:result g} - (let [prop (gen/for-all* [g] #(check-call f specs %))] - (apply gen/quick-check num-tests prop (mapcat identity opts)))))) - -(defn- make-check-result - "Builds spec result map." - [check-sym spec test-check-ret] - (merge {:spec spec - ::stc/ret test-check-ret} - (when check-sym - {:sym check-sym}) - (when-let [result (-> test-check-ret :result)] - (when-not (true? result) {:failure result})) - (when-let [shrunk (-> test-check-ret :shrunk)] - {:failure (:result shrunk)}))) - -(defn- check-1 - [{:keys [s f v spec]} opts] - (let [re-inst? (and v (seq (unstrument s)) true) - f (or f (when v @v)) - specd (s/spec spec)] - (try - (cond - (or (nil? f) (some-> v meta :macro)) - {:failure (ex-info "No fn to spec" {::s/failure :no-fn}) - :sym s :spec spec} - - (:args specd) - (let [tcret (quick-check f specd opts)] - (make-check-result s spec tcret)) - - :default - {:failure (ex-info "No :args spec" {::s/failure :no-args-spec}) - :sym s :spec spec}) - (finally - (when re-inst? (instrument s)))))) - -(defn- sym->check-map - [s] - (let [v (resolve s)] - {:s s - :v v - :spec (when v (s/get-spec v))})) - -(defn- validate-check-opts - [opts] - (assert (every? ident? (keys (:gen opts))) "check :gen expects ident keys")) - -(defn check-fn - "Runs generative tests for fn f using spec and opts. See -'check' for options and return." - ([f spec] (check-fn f spec nil)) - ([f spec opts] - (validate-check-opts opts) - (check-1 {:f f :spec spec} opts))) - -(defn checkable-syms - "Given an opts map as per check, returns the set of syms that -can be checked." - ([] (checkable-syms nil)) - ([opts] - (validate-check-opts opts) - (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) - (keys (:spec opts))]))) - -(defn check - "Run generative tests for spec conformance on vars named by -sym-or-syms, a symbol or collection of symbols. If sym-or-syms -is not specified, check all checkable vars. - -The opts map includes the following optional keys, where stc -aliases clojure.spec.test.check: - -::stc/opts opts to flow through test.check/quick-check -:gen map from spec names to generator overrides - -The ::stc/opts include :num-tests in addition to the keys -documented by test.check. Generator overrides are passed to -spec/gen when generating function args. - -Returns a lazy sequence of check result maps with the following -keys - -:spec the spec tested -:sym optional symbol naming the var tested -:failure optional test failure -::stc/ret optional value returned by test.check/quick-check - -The value for :failure can be any exception. Exceptions thrown by -spec itself will have an ::s/failure value in ex-data: - -:check-failed at least one checked return did not conform -:no-args-spec no :args spec provided -:no-fn no fn provided -:no-fspec no fspec provided -:no-gen unable to generate :args -:instrument invalid args detected by instrument -" - ([] (check (checkable-syms))) - ([sym-or-syms] (check sym-or-syms nil)) - ([sym-or-syms opts] - (->> (collectionize sym-or-syms) - (filter (checkable-syms opts)) - (pmap - #(check-1 (sym->check-map %) opts))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting ;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- failure-type - [x] - (::s/failure (ex-data x))) - -(defn- unwrap-failure - [x] - (if (failure-type x) - (ex-data x) - x)) - -(defn- result-type - "Returns the type of the check result. This can be any of the -::s/failure keywords documented in 'check', or: - - :check-passed all checked fn returns conformed - :check-threw checked fn threw an exception" - [ret] - (let [failure (:failure ret)] - (cond - (nil? failure) :check-passed - (failure-type failure) (failure-type failure) - :default :check-threw))) - -(defn abbrev-result - "Given a check result, returns an abbreviated version -suitable for summary use." - [x] - (if (:failure x) - (-> (dissoc x ::stc/ret) - (update :spec s/describe) - (update :failure unwrap-failure)) - (dissoc x :spec ::stc/ret))) - -(defn summarize-results - "Given a collection of check-results, e.g. from 'check', pretty -prints the summary-result (default abbrev-result) of each. - -Returns a map with :total, the total number of results, plus a -key with a count for each different :type of result." - ([check-results] (summarize-results check-results abbrev-result)) - ([check-results summary-result] - (reduce - (fn [summary result] - (pp/pprint (summary-result result)) - (-> summary - (update :total inc) - (update (result-type result) (fnil inc 0)))) - {:total 0} - check-results))) - - - diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index 7211e6c4..4ebc85fa 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -6803,19 +6803,18 @@ public static Object macroexpand1(Object x) { Var v = isMacro(op); if(v != null) { - // Do not check specs while inside clojure.spec - if(! "clojure/spec.clj".equals(SOURCE_PATH.deref())) + // Do not check specs while inside clojure.spec.alpha + if(! "clojure/spec/alpha.clj".equals(SOURCE_PATH.deref())) { try { - final Namespace checkns = Namespace.find(Symbol.intern("clojure.spec")); + final Namespace checkns = Namespace.find(Symbol.intern("clojure.spec.alpha")); if (checkns != null) { - final Var check = Var.find(Symbol.intern("clojure.spec/macroexpand-check")); + final Var check = Var.find(Symbol.intern("clojure.spec.alpha/macroexpand-check")); if ((check != null) && (check.isBound())) check.applyTo(RT.cons(v, RT.list(form.next()))); } - Symbol.intern("clojure.spec"); } catch(IllegalArgumentException e) { diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index 4a6d0a57..a6552f74 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -461,8 +461,8 @@ else if(!loaded && failIfNotFound) static void doInit() throws ClassNotFoundException, IOException{ load("clojure/core"); - load("clojure/spec"); - load("clojure/core/specs"); + load("clojure/spec/alpha"); + load("clojure/core/specs/alpha"); Var.pushThreadBindings( RT.mapUniqueKeys(CURRENT_NS, CURRENT_NS.deref(), diff --git a/test/clojure/test_clojure/spec.clj b/test/clojure/test_clojure/spec.clj deleted file mode 100644 index 658017e9..00000000 --- a/test/clojure/test_clojure/spec.clj +++ /dev/null @@ -1,201 +0,0 @@ -(ns clojure.test-clojure.spec - (:require [clojure.spec :as s] - [clojure.spec.gen :as gen] - [clojure.spec.test :as stest] - [clojure.test :refer :all])) - -(set! *warn-on-reflection* true) - -(defmacro result-or-ex [x] - `(try - ~x - (catch Throwable t# - (.getName (class t#))))) - -(def even-count? #(even? (count %))) - -(defn submap? - "Is m1 a subset of m2?" - [m1 m2] - (if (and (map? m1) (map? m2)) - (every? (fn [[k v]] (and (contains? m2 k) - (submap? v (get m2 k)))) - m1) - (= m1 m2))) - -(deftest conform-explain - (let [a (s/and #(> % 5) #(< % 10)) - o (s/or :s string? :k keyword?) - c (s/cat :a string? :b keyword?) - either (s/alt :a string? :b keyword?) - star (s/* keyword?) - plus (s/+ keyword?) - opt (s/? keyword?) - andre (s/& (s/* keyword?) even-count?) - m (s/map-of keyword? string?) - mkeys (s/map-of (s/and keyword? (s/conformer name)) any?) - mkeys2 (s/map-of (s/and keyword? (s/conformer name)) any? :conform-keys true) - s (s/coll-of (s/spec (s/cat :tag keyword? :val any?)) :kind list?) - v (s/coll-of keyword? :kind vector?) - coll (s/coll-of keyword?) - lrange (s/int-in 7 42) - drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2) - irange (s/inst-in #inst "1939" #inst "1946") - ] - (are [spec x conformed ed] - (let [co (result-or-ex (s/conform spec x)) - e (result-or-ex (::s/problems (s/explain-data spec x)))] - (when (not= conformed co) (println "conform fail\n\texpect=" conformed "\n\tactual=" co)) - (when (not (every? true? (map submap? ed e))) - (println "explain failures\n\texpect=" ed "\n\tactual failures=" e "\n\tsubmap?=" (map submap? ed e))) - (and (= conformed co) (every? true? (map submap? ed e)))) - - lrange 7 7 nil - lrange 8 8 nil - lrange 42 ::s/invalid [{:pred '(int-in-range? 7 42 %), :val 42}] - - irange #inst "1938" ::s/invalid [{:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1938"}] - irange #inst "1942" #inst "1942" nil - irange #inst "1946" ::s/invalid [{:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1946"}] - - drange 3.0 ::s/invalid [{:pred '(<= 3.1 %), :val 3.0}] - drange 3.1 3.1 nil - drange 3.2 3.2 nil - drange Double/POSITIVE_INFINITY ::s/invalid [{:pred '(not (isInfinite %)), :val Double/POSITIVE_INFINITY}] - ;; can't use equality-based test for Double/NaN - ;; drange Double/NaN ::s/invalid {[] {:pred '(not (isNaN %)), :val Double/NaN}} - - keyword? :k :k nil - keyword? nil ::s/invalid [{:pred ::s/unknown :val nil}] - keyword? "abc" ::s/invalid [{:pred ::s/unknown :val "abc"}] - - a 6 6 nil - a 3 ::s/invalid '[{:pred (> % 5), :val 3}] - a 20 ::s/invalid '[{:pred (< % 10), :val 20}] - a nil "java.lang.NullPointerException" "java.lang.NullPointerException" - a :k "java.lang.ClassCastException" "java.lang.ClassCastException" - - o "a" [:s "a"] nil - o :a [:k :a] nil - o 'a ::s/invalid '[{:pred string?, :val a, :path [:s]} {:pred keyword?, :val a :path [:k]}] - - c nil ::s/invalid '[{:reason "Insufficient input", :pred string?, :val (), :path [:a]}] - c [] ::s/invalid '[{:reason "Insufficient input", :pred string?, :val (), :path [:a]}] - c [:a] ::s/invalid '[{:pred string?, :val :a, :path [:a], :in [0]}] - c ["a"] ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val (), :path [:b]}] - c ["s" :k] '{:a "s" :b :k} nil - c ["s" :k 5] ::s/invalid '[{:reason "Extra input", :pred (cat :a string? :b keyword?), :val (5)}] - (s/cat) nil {} nil - (s/cat) [5] ::s/invalid '[{:reason "Extra input", :pred (cat), :val (5), :in [0]}] - - either nil ::s/invalid '[{:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}] - either [] ::s/invalid '[{:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}] - either [:k] [:b :k] nil - either ["s"] [:a "s"] nil - either [:b "s"] ::s/invalid '[{:reason "Extra input", :pred (alt :a string? :b keyword?), :val ("s") :via []}] - - star nil [] nil - star [] [] nil - star [:k] [:k] nil - star [:k1 :k2] [:k1 :k2] nil - star [:k1 :k2 "x"] ::s/invalid '[{:pred keyword?, :val "x" :via []}] - star ["a"] ::s/invalid '[{:pred keyword?, :val "a" :via []}] - - plus nil ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val () :via []}] - plus [] ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val () :via []}] - plus [:k] [:k] nil - plus [:k1 :k2] [:k1 :k2] nil - plus [:k1 :k2 "x"] ::s/invalid '[{:pred keyword?, :val "x", :in [2]}] - plus ["a"] ::s/invalid '[{:pred keyword?, :val "a" :via []}] - - opt nil nil nil - opt [] nil nil - opt :k ::s/invalid '[{:pred (? keyword?), :val :k}] - opt [:k] :k nil - opt [:k1 :k2] ::s/invalid '[{:reason "Extra input", :pred (? keyword?), :val (:k2)}] - opt [:k1 :k2 "x"] ::s/invalid '[{:reason "Extra input", :pred (? keyword?), :val (:k2 "x")}] - opt ["a"] ::s/invalid '[{:pred keyword?, :val "a"}] - - andre nil nil nil - andre [] nil nil - andre :k :clojure.spec/invalid '[{:pred (& (* keyword?) even-count?), :val :k}] - andre [:k] ::s/invalid '[{:pred even-count?, :val [:k]}] - andre [:j :k] [:j :k] nil - - m nil ::s/invalid '[{:pred map?, :val nil}] - m {} {} nil - m {:a "b"} {:a "b"} nil - - mkeys nil ::s/invalid '[{:pred map?, :val nil}] - mkeys {} {} nil - mkeys {:a 1 :b 2} {:a 1 :b 2} nil - - mkeys2 nil ::s/invalid '[{:pred map?, :val nil}] - mkeys2 {} {} nil - mkeys2 {:a 1 :b 2} {"a" 1 "b" 2} nil - - s '([:a 1] [:b "2"]) '({:tag :a :val 1} {:tag :b :val "2"}) nil - - v [:a :b] [:a :b] nil - v '(:a :b) ::s/invalid '[{:pred vector? :val (:a :b)}] - - coll nil ::s/invalid '[{:path [], :pred coll?, :val nil, :via [], :in []}] - coll [] [] nil - coll [:a] [:a] nil - coll [:a :b] [:a :b] nil - coll (map identity [:a :b]) '(:a :b) nil - ;;coll [:a "b"] ::s/invalid '[{:pred (coll-checker keyword?), :val [:a b]}] - ))) - -(defn check-conform-unform [spec vals expected-conforms] - (let [actual-conforms (map #(s/conform spec %) vals) - unforms (map #(s/unform spec %) actual-conforms)] - (is (= actual-conforms expected-conforms)) - (is (= vals unforms)))) - -(deftest nilable-conform-unform - (check-conform-unform - (s/nilable int?) - [5 nil] - [5 nil]) - (check-conform-unform - (s/nilable (s/or :i int? :s string?)) - [5 "x" nil] - [[:i 5] [:s "x"] nil])) - -(deftest nonconforming-conform-unform - (check-conform-unform - (s/nonconforming (s/or :i int? :s string?)) - [5 "x"] - [5 "x"])) - -(deftest coll-form - (are [spec form] - (= (s/form spec) form) - (s/map-of int? any?) - '(clojure.spec/map-of clojure.core/int? clojure.core/any?) - - (s/coll-of int?) - '(clojure.spec/coll-of clojure.core/int?) - - (s/every-kv int? int?) - '(clojure.spec/every-kv clojure.core/int? clojure.core/int?) - - (s/every int?) - '(clojure.spec/every clojure.core/int?) - - (s/coll-of (s/tuple (s/tuple int?))) - '(clojure.spec/coll-of (clojure.spec/tuple (clojure.spec/tuple clojure.core/int?))) - - (s/coll-of int? :kind vector?) - '(clojure.spec/coll-of clojure.core/int? :kind clojure.core/vector?) - - (s/coll-of int? :gen #(gen/return [1 2])) - '(clojure.spec/coll-of clojure.core/int? :gen (fn* [] (gen/return [1 2]))))) - -(comment - (require '[clojure.test :refer (run-tests)]) - (in-ns 'clojure.test-clojure.spec) - (run-tests) - - ) From be17c7c1d2777139c178a4d3dab4b4517385a8bd Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Thu, 27 Apr 2017 09:22:14 -0500 Subject: [PATCH 166/246] Use maven test classpath for compiling tests Signed-off-by: Stuart Halloway --- build.xml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/build.xml b/build.xml index 41790f50..07628534 100644 --- a/build.xml +++ b/build.xml @@ -91,9 +91,8 @@ Direct linking = ${directlinking} - ${test-classes}:${test}:${build}:${cljsrc}:${maven.compile.classpath} From 843583cb2fb444996375f5ee88a655cd1362d61e Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Thu, 27 Apr 2017 09:42:26 -0500 Subject: [PATCH 167/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha16 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 566b8df6..6512dea1 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha16 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-alpha16 From 21a7d5192d7503c58dc97256617beae7c330b7bd Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Thu, 27 Apr 2017 09:42:26 -0500 Subject: [PATCH 168/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 6512dea1..566b8df6 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha16 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-alpha16 + HEAD From 72594111ef5390bdb18f239f8cf72a8237fd94e4 Mon Sep 17 00:00:00 2001 From: Ghadi Shayban Date: Thu, 8 Sep 2016 17:13:03 -0500 Subject: [PATCH 169/246] CLJ-1793 - Clear 'this' before calls in tail position The criteria for when a tail call is a safe point to clear 'this': 1) Must be in return position 2) Not in a try block (might need 'this' during catch/finally) 3) When not direct linked Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Compiler.java | 125 +++++++++++++--------- test/clojure/test_clojure/compilation.clj | 27 +++++ test/clojure/test_clojure/reducers.clj | 4 + 3 files changed, 108 insertions(+), 48 deletions(-) diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index 4ebc85fa..03342325 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -226,6 +226,8 @@ public class Compiler implements Opcodes{ //null or not static final public Var IN_CATCH_FINALLY = Var.create(null).setDynamic(); +static final public Var METHOD_RETURN_CONTEXT = Var.create(null).setDynamic(); + static final public Var NO_RECUR = Var.create(null).setDynamic(); //DynamicClassLoader @@ -373,6 +375,10 @@ static boolean isSpecial(Object sym){ return specials.containsKey(sym); } +static boolean inTailCall(C context) { + return (context == C.RETURN) && (METHOD_RETURN_CONTEXT.deref() != null) && (IN_CATCH_FINALLY.deref() == null); +} + static Symbol resolveSymbol(Symbol sym){ //already qualified or classname? if(sym.name.indexOf('.') > 0) @@ -1005,12 +1011,13 @@ else if(instance != null && instance.hasJavaClass() && instance.getJavaClass() ! Symbol sym = (Symbol) RT.first(call); Symbol tag = tagOf(form); PersistentVector args = PersistentVector.EMPTY; + boolean tailPosition = inTailCall(context); for(ISeq s = RT.next(call); s != null; s = s.next()) args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first())); if(c != null) - return new StaticMethodExpr(source, line, column, tag, c, munge(sym.name), args); + return new StaticMethodExpr(source, line, column, tag, c, munge(sym.name), args, tailPosition); else - return new InstanceMethodExpr(source, line, column, tag, instance, munge(sym.name), args); + return new InstanceMethodExpr(source, line, column, tag, instance, munge(sym.name), args, tailPosition); } } } @@ -1440,13 +1447,15 @@ static class InstanceMethodExpr extends MethodExpr{ public final int line; public final int column; public final Symbol tag; + public final boolean tailPosition; public final java.lang.reflect.Method method; final static Method invokeInstanceMethodMethod = Method.getMethod("Object invokeInstanceMethod(Object,String,Object[])"); - public InstanceMethodExpr(String source, int line, int column, Symbol tag, Expr target, String methodName, IPersistentVector args) + public InstanceMethodExpr(String source, int line, int column, Symbol tag, Expr target, + String methodName, IPersistentVector args, boolean tailPosition) { this.source = source; this.line = line; @@ -1455,6 +1464,7 @@ public InstanceMethodExpr(String source, int line, int column, Symbol tag, Expr this.methodName = methodName; this.target = target; this.tag = tag; + this.tailPosition = tailPosition; if(target.hasJavaClass() && target.getJavaClass() != null) { List methods = Reflector.getMethods(target.getJavaClass(), args.count(), methodName, false); @@ -1548,10 +1558,10 @@ public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ gen.checkCast(type); MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); gen.visitLineNumber(line, gen.mark()); - if(context == C.RETURN) + if(tailPosition && !objx.canBeDirect) { ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); + method.emitClearThis(gen); } Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); if(method.getDeclaringClass().isInterface()) @@ -1622,12 +1632,14 @@ static class StaticMethodExpr extends MethodExpr{ public final int column; public final java.lang.reflect.Method method; public final Symbol tag; + public final boolean tailPosition; final static Method forNameMethod = Method.getMethod("Class classForName(String)"); final static Method invokeStaticMethodMethod = Method.getMethod("Object invokeStaticMethod(Class,String,Object[])"); final static Keyword warnOnBoxedKeyword = Keyword.intern("warn-on-boxed"); - public StaticMethodExpr(String source, int line, int column, Symbol tag, Class c, String methodName, IPersistentVector args) + public StaticMethodExpr(String source, int line, int column, Symbol tag, Class c, + String methodName, IPersistentVector args, boolean tailPosition) { this.c = c; this.methodName = methodName; @@ -1636,6 +1648,7 @@ public StaticMethodExpr(String source, int line, int column, Symbol tag, Class c this.line = line; this.column = column; this.tag = tag; + this.tailPosition = tailPosition; List methods = Reflector.getMethods(c, args.count(), methodName, true); if(methods.isEmpty()) @@ -1774,10 +1787,10 @@ public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); gen.visitLineNumber(line, gen.mark()); //Type type = Type.getObjectType(className.replace('.', '/')); - if(context == C.RETURN) + if(tailPosition && !objx.canBeDirect) { ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); + method.emitClearThis(gen); } Type type = Type.getType(c); Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); @@ -2271,13 +2284,14 @@ public Expr parse(C context, Object frm) { } else { - if(bodyExpr == null) - try { - Var.pushThreadBindings(RT.map(NO_RECUR, true)); - bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body)); - } finally { - Var.popThreadBindings(); - } + if(bodyExpr == null) + try { + Var.pushThreadBindings(RT.map(NO_RECUR, true, METHOD_RETURN_CONTEXT, null)); + bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body)); + } finally { + Var.popThreadBindings(); + } + if(Util.equals(op, CATCH)) { Class c = HostExpr.maybeClass(RT.second(f), false); @@ -2325,17 +2339,21 @@ public Expr parse(C context, Object frm) { } } } - if(bodyExpr == null) { - try - { - Var.pushThreadBindings(RT.map(NO_RECUR, true)); - bodyExpr = (new BodyExpr.Parser()).parse(C.EXPRESSION, RT.seq(body)); - } - finally - { - Var.popThreadBindings(); - } - } + if(bodyExpr == null) + { + // this codepath is hit when there is neither catch or finally, e.g. (try (expr)) + // return a body expr directly + try + { + Var.pushThreadBindings(RT.map(NO_RECUR, true)); + bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body)); + } + finally + { + Var.popThreadBindings(); + } + return bodyExpr; + } return new TryExpr(bodyExpr, catches, finallyExpr, retLocal, finallyLocal); @@ -2587,11 +2605,6 @@ public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ gen.newInstance(type); gen.dup(); MethodExpr.emitTypedArgs(objx, gen, ctor.getParameterTypes(), args); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } gen.invokeConstructor(type, new Method("", Type.getConstructorDescriptor(ctor))); } else @@ -2599,11 +2612,6 @@ public void emit(C context, ObjExpr objx, GeneratorAdapter gen){ gen.push(destubClassName(c.getName())); gen.invokeStatic(RT_TYPE, forNameMethod); MethodExpr.emitArgsAsArray(args, objx, gen); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } gen.invokeStatic(REFLECTOR_TYPE, invokeConstructorMethod); } if(context == C.STATEMENT) @@ -3431,16 +3439,18 @@ static class StaticInvokeExpr implements Expr, MaybePrimitiveExpr{ public final Type[] paramtypes; public final IPersistentVector args; public final boolean variadic; + public final boolean tailPosition; public final Object tag; StaticInvokeExpr(Type target, Class retClass, Class[] paramclasses, Type[] paramtypes, boolean variadic, - IPersistentVector args,Object tag){ + IPersistentVector args,Object tag, boolean tailPosition){ this.target = target; this.retClass = retClass; this.paramclasses = paramclasses; this.paramtypes = paramtypes; this.args = args; this.variadic = variadic; + this.tailPosition = tailPosition; this.tag = tag; } @@ -3497,6 +3507,12 @@ public void emitUnboxed(C context, ObjExpr objx, GeneratorAdapter gen){ else MethodExpr.emitTypedArgs(objx, gen, paramclasses, args); + if(tailPosition && !objx.canBeDirect) + { + ObjMethod method = (ObjMethod) METHOD.deref(); + method.emitClearThis(gen); + } + gen.invokeStatic(target, ms); } @@ -3504,7 +3520,7 @@ private Type getReturnType(){ return Type.getType(retClass); } - public static Expr parse(Var v, ISeq args, Object tag) { + public static Expr parse(Var v, ISeq args, Object tag, boolean tailPosition) { if(!v.isBound() || v.get() == null) { // System.out.println("Not bound: " + v); @@ -3560,7 +3576,7 @@ else if(argcount > params.length for(ISeq s = RT.seq(args); s != null; s = s.next()) argv = argv.cons(analyze(C.EXPRESSION, s.first())); - return new StaticInvokeExpr(target,retClass,paramClasses, paramTypes,variadic, argv, tag); + return new StaticInvokeExpr(target,retClass,paramClasses, paramTypes,variadic, argv, tag, tailPosition); } } @@ -3571,6 +3587,7 @@ static class InvokeExpr implements Expr{ public final IPersistentVector args; public final int line; public final int column; + public final boolean tailPosition; public final String source; public boolean isProtocol = false; public boolean isDirect = false; @@ -3593,12 +3610,14 @@ static Object sigTag(int argcount, Var v){ return null; } - public InvokeExpr(String source, int line, int column, Symbol tag, Expr fexpr, IPersistentVector args) { + public InvokeExpr(String source, int line, int column, Symbol tag, Expr fexpr, IPersistentVector args, boolean tailPosition) { this.source = source; this.fexpr = fexpr; this.args = args; this.line = line; this.column = column; + this.tailPosition = tailPosition; + if(fexpr instanceof VarExpr) { Var fvar = ((VarExpr)fexpr).var; @@ -3743,10 +3762,10 @@ void emitArgsAndCall(int firstArgToEmit, C context, ObjExpr objx, GeneratorAdapt } gen.visitLineNumber(line, gen.mark()); - if(context == C.RETURN) + if(tailPosition && !objx.canBeDirect) { ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); + method.emitClearThis(gen); } gen.invokeInterface(IFN_TYPE, new Method("invoke", OBJECT_TYPE, ARG_TYPES[Math.min(MAX_POSITIONAL_ARITY + 1, @@ -3762,6 +3781,7 @@ public Class getJavaClass() { } static public Expr parse(C context, ISeq form) { + boolean tailPosition = inTailCall(context); if(context != C.EVAL) context = C.EXPRESSION; Expr fexpr = analyze(context, form.first()); @@ -3791,7 +3811,7 @@ static public Expr parse(C context, ISeq form) { Object sigtag = sigTag(arity, v); Object vtag = RT.get(RT.meta(v), RT.TAG_KEY); Expr ret = StaticInvokeExpr - .parse(v, RT.next(form), formtag != null ? formtag : sigtag != null ? sigtag : vtag); + .parse(v, RT.next(form), formtag != null ? formtag : sigtag != null ? sigtag : vtag, tailPosition); if(ret != null) { // System.out.println("invoke direct: " + v); @@ -3838,7 +3858,7 @@ static public Expr parse(C context, ISeq form) { // throw new IllegalArgumentException( // String.format("No more than %d args supported", MAX_POSITIONAL_ARITY)); - return new InvokeExpr((String) SOURCE.deref(), lineDeref(), columnDeref(), tagOf(form), fexpr, args); + return new InvokeExpr((String) SOURCE.deref(), lineDeref(), columnDeref(), tagOf(form), fexpr, args, tailPosition); } } @@ -5296,6 +5316,7 @@ static FnMethod parse(ObjExpr objx, ISeq form, Object rettag) { ,CLEAR_PATH, pnode ,CLEAR_ROOT, pnode ,CLEAR_SITES, PersistentHashMap.EMPTY + ,METHOD_RETURN_CONTEXT, RT.T )); method.prim = primInterface(parms); @@ -5873,6 +5894,11 @@ void emitClearLocalsOld(GeneratorAdapter gen){ } } } + + void emitClearThis(GeneratorAdapter gen) { + gen.visitInsn(Opcodes.ACONST_NULL); + gen.visitVarInsn(Opcodes.ASTORE, 0); + } } public static class LocalBinding{ @@ -6300,14 +6326,14 @@ public Expr parse(C context, Object frm) { { if(recurMismatches != null && RT.booleanCast(recurMismatches.nth(i/2))) { - init = new StaticMethodExpr("", 0, 0, null, RT.class, "box", RT.vector(init)); + init = new StaticMethodExpr("", 0, 0, null, RT.class, "box", RT.vector(init), false); if(RT.booleanCast(RT.WARN_ON_REFLECTION.deref())) RT.errPrintWriter().println("Auto-boxing loop arg: " + sym); } else if(maybePrimitiveType(init) == int.class) - init = new StaticMethodExpr("", 0, 0, null, RT.class, "longCast", RT.vector(init)); + init = new StaticMethodExpr("", 0, 0, null, RT.class, "longCast", RT.vector(init), false); else if(maybePrimitiveType(init) == float.class) - init = new StaticMethodExpr("", 0, 0, null, RT.class, "doubleCast", RT.vector(init)); + init = new StaticMethodExpr("", 0, 0, null, RT.class, "doubleCast", RT.vector(init), false); } //sequential enhancement of env (like Lisp let*) try @@ -6339,10 +6365,12 @@ else if(maybePrimitiveType(init) == float.class) try { if(isLoop) { + Object methodReturnContext = context == C.RETURN ? METHOD_RETURN_CONTEXT.deref() : null; Var.pushThreadBindings( RT.map(CLEAR_PATH, clearpath, CLEAR_ROOT, clearroot, - NO_RECUR, null)); + NO_RECUR, null, + METHOD_RETURN_CONTEXT, methodReturnContext)); } bodyExpr = (new BodyExpr.Parser()).parse(isLoop ? C.RETURN : context, body); @@ -8247,6 +8275,7 @@ static NewInstanceMethod parse(ObjExpr objx, ISeq form, Symbol thistag, ,CLEAR_PATH, pnode ,CLEAR_ROOT, pnode ,CLEAR_SITES, PersistentHashMap.EMPTY + ,METHOD_RETURN_CONTEXT, RT.T )); //register 'this' as local 0 diff --git a/test/clojure/test_clojure/compilation.clj b/test/clojure/test_clojure/compilation.clj index a730b89c..df0f995d 100644 --- a/test/clojure/test_clojure/compilation.clj +++ b/test/clojure/test_clojure/compilation.clj @@ -354,6 +354,33 @@ ;; throws an exception on failure (is (eval `(fn [] ~(CLJ1399. 1))))) +(deftest CLJ-1250-this-clearing + (testing "clearing during try/catch/finally" + (let [closed-over-in-catch (let [x :foo] + (fn [] + (try + (throw (Exception. "boom")) + (catch Exception e + x)))) ;; x should remain accessible to the fn + + a (atom nil) + closed-over-in-finally (fn [] + (try + :ret + (finally + (reset! a :run))))] + (is (= :foo (closed-over-in-catch))) + (is (= :ret (closed-over-in-finally))) + (is (= :run @a)))) + (testing "no clearing when loop not in return context" + (let [x (atom 5) + bad (fn [] + (loop [] (System/getProperties)) + (swap! x dec) + (when (pos? @x) + (recur)))] + (is (nil? (bad)))))) + (deftest CLJ-1586-lazyseq-literals-preserve-metadata (should-not-reflect (eval (list '.substring (with-meta (concat '(identity) '("foo")) {:tag 'String}) 0)))) diff --git a/test/clojure/test_clojure/reducers.clj b/test/clojure/test_clojure/reducers.clj index c2852ccb..a884c851 100644 --- a/test/clojure/test_clojure/reducers.clj +++ b/test/clojure/test_clojure/reducers.clj @@ -89,3 +89,7 @@ ([ret k v] (when (= k k-fail) (throw (IndexOutOfBoundsException.))))) (zipmap (range test-map-count) (repeat :dummy))))))) + +(deftest test-closed-over-clearing + ;; this will throw OutOfMemory without proper reference clearing + (is (number? (reduce + 0 (r/map identity (range 1e8)))))) From ebfdbca535b81808b3ddc369d4a4e98b8f1524c7 Mon Sep 17 00:00:00 2001 From: thurston nabe Date: Fri, 6 Jan 2017 21:15:27 -0800 Subject: [PATCH 170/246] CLJ-2091 Squashed commit of the following: commit 528884a36a98e852984e5968f6e26932855ceef8 Author: thurston nabe Date: Fri Jan 6 19:55:39 2017 -0800 CLJ-2091 Replaced the inline intialization of #_hash and #_hasheq with default intialization; and then check for zero in the corresponding methods. The 4 persistent classes are now multi thread-safe even if unsafely published, commit fd4eb4176da710fda229a3005d19ee091fc34d11 Author: thurston nabe Date: Tue Jan 3 18:36:51 2017 -0800 CLJ-2091 Refactored persistent classes so that #hashCode() and #hashequals() do only a single read Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/APersistentMap.java | 18 ++++++++++-------- src/jvm/clojure/lang/APersistentSet.java | 17 +++++++++-------- src/jvm/clojure/lang/APersistentVector.java | 20 +++++++++++--------- src/jvm/clojure/lang/PersistentQueue.java | 20 +++++++++++--------- 4 files changed, 41 insertions(+), 34 deletions(-) diff --git a/src/jvm/clojure/lang/APersistentMap.java b/src/jvm/clojure/lang/APersistentMap.java index 6e01ddc2..09ad42cc 100644 --- a/src/jvm/clojure/lang/APersistentMap.java +++ b/src/jvm/clojure/lang/APersistentMap.java @@ -14,8 +14,8 @@ import java.util.*; public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable, MapEquivalence, IHashEq { -int _hash = -1; -int _hasheq = -1; +int _hash; +int _hasheq; public String toString(){ return RT.printString(this); @@ -93,11 +93,12 @@ public boolean equiv(Object obj){ return true; } public int hashCode(){ - if(_hash == -1) + int cached = this._hash; + if(cached == 0) { - this._hash = mapHash(this); + this._hash = cached = mapHash(this); } - return _hash; + return cached; } static public int mapHash(IPersistentMap m){ @@ -112,12 +113,13 @@ static public int mapHash(IPersistentMap m){ } public int hasheq(){ - if(_hasheq == -1) + int cached = this._hasheq; + if(cached == 0) { //this._hasheq = mapHasheq(this); - _hasheq = Murmur3.hashUnordered(this); + this._hasheq = cached = Murmur3.hashUnordered(this); } - return _hasheq; + return cached; } static public int mapHasheq(IPersistentMap m) { diff --git a/src/jvm/clojure/lang/APersistentSet.java b/src/jvm/clojure/lang/APersistentSet.java index c71eb84c..1c2ce8f4 100644 --- a/src/jvm/clojure/lang/APersistentSet.java +++ b/src/jvm/clojure/lang/APersistentSet.java @@ -18,8 +18,8 @@ import java.util.Set; public abstract class APersistentSet extends AFn implements IPersistentSet, Collection, Set, Serializable, IHashEq { -int _hash = -1; -int _hasheq = -1; +int _hash; +int _hasheq; final IPersistentMap impl; protected APersistentSet(IPersistentMap impl){ @@ -91,10 +91,10 @@ public boolean equiv(Object obj){ } public int hashCode(){ - if(_hash == -1) + int hash = this._hash; + if(hash == 0) { //int hash = count(); - int hash = 0; for(ISeq s = seq(); s != null; s = s.next()) { Object e = s.first(); @@ -103,11 +103,12 @@ public int hashCode(){ } this._hash = hash; } - return _hash; + return hash; } public int hasheq(){ - if(_hasheq == -1){ + int cached = this._hasheq; + if(cached == 0){ // int hash = 0; // for(ISeq s = seq(); s != null; s = s.next()) // { @@ -115,9 +116,9 @@ public int hasheq(){ // hash += Util.hasheq(e); // } // this._hasheq = hash; - _hasheq = Murmur3.hashUnordered(this); + this._hasheq = cached = Murmur3.hashUnordered(this); } - return _hasheq; + return cached; } public Object[] toArray(){ diff --git a/src/jvm/clojure/lang/APersistentVector.java b/src/jvm/clojure/lang/APersistentVector.java index b55ead84..f87ad7a0 100644 --- a/src/jvm/clojure/lang/APersistentVector.java +++ b/src/jvm/clojure/lang/APersistentVector.java @@ -19,8 +19,8 @@ public abstract class APersistentVector extends AFn implements IPersistentVector List, RandomAccess, Comparable, Serializable, IHashEq { -int _hash = -1; -int _hasheq = -1; +int _hash; +int _hasheq; public String toString(){ return RT.printString(this); @@ -139,9 +139,10 @@ public boolean equiv(Object obj){ } public int hashCode(){ - if(_hash == -1) + int hash = this._hash; + if(hash == 0) { - int hash = 1; + hash = 1; for(int i = 0;i Date: Fri, 10 Mar 2017 08:47:36 -0600 Subject: [PATCH 171/246] CLJ-1860 Make -0.0 hash consistent with 0.0 0.0 and -0.0 compared equal but hashed differently. The patch makes -0.0 (double and float) hash to 0, same as 0.0. Also, the patch restructures hasheq to cover just long and double and moves the rest to a helper function to improve inlining. Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Numbers.java | 46 +++++++++++++++++++-------- test/clojure/test_clojure/numbers.clj | 4 ++- 2 files changed, 36 insertions(+), 14 deletions(-) diff --git a/src/jvm/clojure/lang/Numbers.java b/src/jvm/clojure/lang/Numbers.java index 623743bc..ae42676d 100644 --- a/src/jvm/clojure/lang/Numbers.java +++ b/src/jvm/clojure/lang/Numbers.java @@ -1033,21 +1033,18 @@ else if(xc == BigDecimal.class) } @WarnBoxedMath(false) -static int hasheq(Number x){ - Class xc = x.getClass(); - - if(xc == Long.class - || xc == Integer.class - || xc == Short.class - || xc == Byte.class - || (xc == BigInteger.class && lte(x, Long.MAX_VALUE) && gte(x,Long.MIN_VALUE))) - { +static int hasheqFrom(Number x, Class xc){ + if(xc == Integer.class + || xc == Short.class + || xc == Byte.class + || (xc == BigInteger.class && lte(x, Long.MAX_VALUE) && gte(x,Long.MIN_VALUE))) + { long lpart = x.longValue(); return Murmur3.hashLong(lpart); //return (int) (lpart ^ (lpart >>> 32)); - } + } if(xc == BigDecimal.class) - { + { // stripTrailingZeros() to make all numerically equal // BigDecimal values come out the same before calling // hashCode. Special check for 0 because @@ -1056,14 +1053,37 @@ static int hasheq(Number x){ if (isZero(x)) return BigDecimal.ZERO.hashCode(); else - { + { BigDecimal tmp = ((BigDecimal) x).stripTrailingZeros(); return tmp.hashCode(); - } } + } + if(xc == Float.class && x.equals(-0.0f)) + { + return 0; // match 0.0f + } return x.hashCode(); } +@WarnBoxedMath(false) +static int hasheq(Number x){ + Class xc = x.getClass(); + + if(xc == Long.class) + { + long lpart = x.longValue(); + return Murmur3.hashLong(lpart); + //return (int) (lpart ^ (lpart >>> 32)); + } + if(xc == Double.class) + { + if(x.equals(-0.0)) + return 0; // match 0.0 + return x.hashCode(); + } + return hasheqFrom(x, xc); +} + static Category category(Object x){ Class xc = x.getClass(); diff --git a/test/clojure/test_clojure/numbers.clj b/test/clojure/test_clojure/numbers.clj index f09dd4bf..b3d14235 100644 --- a/test/clojure/test_clojure/numbers.clj +++ b/test/clojure/test_clojure/numbers.clj @@ -72,6 +72,7 @@ (all-pairs-equal #'= [(byte 2) (short 2) (int 2) (long 2) (bigint 2) (biginteger 2)]) (all-pairs-equal #'= [(float 2.0) (double 2.0)]) + (all-pairs-equal #'= [(float 0.0) (double 0.0) (float -0.0) (double -0.0)]) (all-pairs-equal #'= [2.0M 2.00M]) (all-pairs-equal #'= [(float 1.5) (double 1.5)]) (all-pairs-equal #'= [1.50M 1.500M]) @@ -85,12 +86,13 @@ (bigint 2) (double 2.0) 2.0M 2.00M]) (all-pairs-hash-consistent-with-= [(/ 3 2) (double 1.5) 1.50M 1.500M]) - (all-pairs-hash-consistent-with-= [(double 0.0) 0.0M 0.00M]) + (all-pairs-hash-consistent-with-= [(double -0.0) (double 0.0) -0.0M -0.00M 0.0M 0.00M (float -0.0) (float 0.0)]) ;; == tests for numerical equality, returning true even for numbers ;; in different categories. (all-pairs-equal #'== [(byte 0) (short 0) (int 0) (long 0) (bigint 0) (biginteger 0) + (float -0.0) (double -0.0) -0.0M -0.00M (float 0.0) (double 0.0) 0.0M 0.00M]) (all-pairs-equal #'== [(byte 2) (short 2) (int 2) (long 2) (bigint 2) (biginteger 2) From e9e57e4808b7700ccee2ea32e17051ba1063112e Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 26 May 2017 08:17:56 -0500 Subject: [PATCH 172/246] CLJ-2141 Return only true/false from qualified-* predicates Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 72383d6b..177f8c1a 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -1599,6 +1599,13 @@ [^clojure.lang.Named x] (. x (getNamespace))) +(defn boolean + "Coerce to boolean" + { + :inline (fn [x] `(. clojure.lang.RT (booleanCast ~x))) + :added "1.0"} + [x] (clojure.lang.RT/booleanCast x)) + (defn ident? "Return true if x is a symbol or keyword" {:added "1.9"} @@ -1612,7 +1619,7 @@ (defn qualified-ident? "Return true if x is a symbol or keyword with a namespace" {:added "1.9"} - [x] (and (ident? x) (namespace x) true)) + [x] (boolean (and (ident? x) (namespace x) true))) (defn simple-symbol? "Return true if x is a symbol without a namespace" @@ -1622,7 +1629,7 @@ (defn qualified-symbol? "Return true if x is a symbol with a namespace" {:added "1.9"} - [x] (and (symbol? x) (namespace x) true)) + [x] (boolean (and (symbol? x) (namespace x) true))) (defn simple-keyword? "Return true if x is a keyword without a namespace" @@ -1632,7 +1639,7 @@ (defn qualified-keyword? "Return true if x is a keyword with a namespace" {:added "1.9"} - [x] (and (keyword? x) (namespace x) true)) + [x] (boolean (and (keyword? x) (namespace x) true))) (defmacro locking "Executes exprs in an implicit do, while holding the monitor of x. @@ -3486,13 +3493,6 @@ :added "1.1"} [x] (. clojure.lang.RT (charCast x))) -(defn boolean - "Coerce to boolean" - { - :inline (fn [x] `(. clojure.lang.RT (booleanCast ~x))) - :added "1.0"} - [x] (clojure.lang.RT/booleanCast x)) - (defn unchecked-byte "Coerce to byte. Subject to rounding or truncation." {:inline (fn [x] `(. clojure.lang.RT (uncheckedByteCast ~x))) From 964232c7bf442787740fa0200b289b3495b1ec09 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 3 Apr 2017 10:15:15 -0500 Subject: [PATCH 173/246] CLJ-2142 Check for duplicate keys with namespace map syntax Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/EdnReader.java | 22 +++++++++------------- src/jvm/clojure/lang/LispReader.java | 22 +++++++++------------- test/clojure/test_clojure/reader.cljc | 6 +++++- 3 files changed, 23 insertions(+), 27 deletions(-) diff --git a/src/jvm/clojure/lang/EdnReader.java b/src/jvm/clojure/lang/EdnReader.java index 5c3bd104..c5c3665e 100644 --- a/src/jvm/clojure/lang/EdnReader.java +++ b/src/jvm/clojure/lang/EdnReader.java @@ -505,35 +505,31 @@ public Object invoke(Object reader, Object colon, Object opts) { throw Util.runtimeException("Namespaced map literal must contain an even number of forms"); // Construct output map - IPersistentMap m = RT.map(); + Object[] a = new Object[kvs.size()]; Iterator iter = kvs.iterator(); - while(iter.hasNext()) { + for(int i = 0; iter.hasNext(); i += 2) { Object key = iter.next(); Object val = iter.next(); if(key instanceof Keyword) { Keyword kw = (Keyword) key; if (kw.getNamespace() == null) { - m = m.assoc(Keyword.intern(ns, kw.getName()), val); + key = Keyword.intern(ns, kw.getName()); } else if (kw.getNamespace().equals("_")) { - m = m.assoc(Keyword.intern(null, kw.getName()), val); - } else { - m = m.assoc(kw, val); + key = Keyword.intern(null, kw.getName()); } } else if(key instanceof Symbol) { Symbol s = (Symbol) key; if (s.getNamespace() == null) { - m = m.assoc(Symbol.intern(ns, s.getName()), val); + key = Symbol.intern(ns, s.getName()); } else if (s.getNamespace().equals("_")) { - m = m.assoc(Symbol.intern(null, s.getName()), val); - } else { - m = m.assoc(s, val); + key = Symbol.intern(null, s.getName()); } - } else { - m = m.assoc(key, val); } + a[i] = key; + a[i+1] = val; } - return m; + return RT.map(a); } } diff --git a/src/jvm/clojure/lang/LispReader.java b/src/jvm/clojure/lang/LispReader.java index a4afb847..35b77468 100644 --- a/src/jvm/clojure/lang/LispReader.java +++ b/src/jvm/clojure/lang/LispReader.java @@ -667,35 +667,31 @@ public Object invoke(Object reader, Object colon, Object opts, Object pendingFor throw Util.runtimeException("Namespaced map literal must contain an even number of forms"); // Construct output map - IPersistentMap m = RT.map(); + Object[] a = new Object[kvs.size()]; Iterator iter = kvs.iterator(); - while(iter.hasNext()) { + for(int i = 0; iter.hasNext(); i += 2) { Object key = iter.next(); Object val = iter.next(); if(key instanceof Keyword) { Keyword kw = (Keyword) key; if (kw.getNamespace() == null) { - m = m.assoc(Keyword.intern(ns, kw.getName()), val); + key = Keyword.intern(ns, kw.getName()); } else if (kw.getNamespace().equals("_")) { - m = m.assoc(Keyword.intern(null, kw.getName()), val); - } else { - m = m.assoc(kw, val); + key = Keyword.intern(null, kw.getName()); } } else if(key instanceof Symbol) { Symbol s = (Symbol) key; if (s.getNamespace() == null) { - m = m.assoc(Symbol.intern(ns, s.getName()), val); + key = Symbol.intern(ns, s.getName()); } else if (s.getNamespace().equals("_")) { - m = m.assoc(Symbol.intern(null, s.getName()), val); - } else { - m = m.assoc(s, val); + key = Symbol.intern(null, s.getName()); } - } else { - m = m.assoc(key, val); } + a[i] = key; + a[i+1] = val; } - return m; + return RT.map(a); } } diff --git a/test/clojure/test_clojure/reader.cljc b/test/clojure/test_clojure/reader.cljc index 91ce25ec..eb1e24de 100644 --- a/test/clojure/test_clojure/reader.cljc +++ b/test/clojure/test_clojure/reader.cljc @@ -742,7 +742,11 @@ Exception #"Namespaced map must specify a valid namespace" "#::clojure.core/t{1 2}" Exception #"Unknown auto-resolved namespace alias" "#::BOGUS{1 2}" Exception #"Namespaced map must specify a namespace" "#:: clojure.core{:a 1}" - Exception #"Namespaced map must specify a namespace" "#: clojure.core{:a 1}")) + Exception #"Namespaced map must specify a namespace" "#: clojure.core{:a 1}" + Exception #"Duplicate key: :user/a" "#::{:a 1 :a 2}" + Exception #"Duplicate key: :clojure.core/a" "#::clojure.core{:a 1 :a 2}" + Exception #"Duplicate key: user/a" "#::{a 1 a 2}" + Exception #"Duplicate key: clojure.core/+" "#::clojure.core{+ 1 + 2}")) (deftest namespaced-map-edn (is (= {1 1, :a/b 2, :b/c 3, :d 4} From f2987665d00a579bf4efb169cf86ed141e0c1106 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Fri, 26 May 2017 11:39:24 -0400 Subject: [PATCH 174/246] CLJ-2128 spec failure during macroexpand should wrap in compiler exception with location info --- src/jvm/clojure/lang/Compiler.java | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index 03342325..b5c881f2 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -6844,7 +6844,7 @@ public static Object macroexpand1(Object x) { check.applyTo(RT.cons(v, RT.list(form.next()))); } } - catch(IllegalArgumentException e) + catch(Exception e) { throw new CompilerException((String) SOURCE_PATH.deref(), lineDeref(), columnDeref(), e); } From 6a03b43d5aa66164ef45679916233c4c16fd9d3e Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Fri, 26 May 2017 12:20:12 -0400 Subject: [PATCH 175/246] bump spec.alpha --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 566b8df6..1b38eb9e 100644 --- a/pom.xml +++ b/pom.xml @@ -41,7 +41,7 @@ org.clojure spec.alpha - 0.1.94 + 0.1.123 org.clojure From 3b246576f49c19e511d7027296139a6e45ccaf90 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Fri, 26 May 2017 15:03:47 -0500 Subject: [PATCH 176/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha17 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 1b38eb9e..b17a0183 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha17 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-alpha17 From d7e92e5d71ca2cf4503165e551859207ba709ddf Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Fri, 26 May 2017 15:03:47 -0500 Subject: [PATCH 177/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index b17a0183..1b38eb9e 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha17 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-alpha17 + HEAD From 005692d9e21fa058c2c5d263899e2b78f33176e4 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Thu, 17 Aug 2017 07:40:14 -0400 Subject: [PATCH 178/246] move to latest specs --- pom.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pom.xml b/pom.xml index 1b38eb9e..3b52bbdb 100644 --- a/pom.xml +++ b/pom.xml @@ -52,7 +52,7 @@ org.clojure core.specs.alpha - 0.1.10 + 0.1.24 org.clojure From dd851520f0c94727591b8b605176755b2a993b0e Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 21 Aug 2017 10:54:23 -0400 Subject: [PATCH 179/246] accept only aliases after ::, pluggable read resolver --- src/jvm/clojure/lang/LispReader.java | 122 ++++++++++++++++++++------ src/jvm/clojure/lang/RT.java | 1 + test/clojure/test_clojure/reader.cljc | 13 +-- 3 files changed, 97 insertions(+), 39 deletions(-) diff --git a/src/jvm/clojure/lang/LispReader.java b/src/jvm/clojure/lang/LispReader.java index 35b77468..c331ac8d 100644 --- a/src/jvm/clojure/lang/LispReader.java +++ b/src/jvm/clojure/lang/LispReader.java @@ -119,6 +119,13 @@ public class LispReader{ dispatchMacros[':'] = new NamespaceMapReader(); } +public static interface Resolver{ + Symbol currentNS(); + Symbol resolveClass(Symbol sym); + Symbol resolveAlias(Symbol sym); + Symbol resolveVar(Symbol sym); +} + static boolean isWhitespace(int ch){ return Character.isWhitespace(ch) || ch == ','; } @@ -195,11 +202,11 @@ static public Object read(PushbackReader r, boolean eofIsError, Object eofValue, static public Object read(PushbackReader r, boolean eofIsError, Object eofValue, boolean isRecursive, Object opts) { // start with pendingForms null as reader conditional splicing is not allowed at top level - return read(r, eofIsError, eofValue, null, null, isRecursive, opts, null); + return read(r, eofIsError, eofValue, null, null, isRecursive, opts, null, (Resolver) RT.READER_RESOLVER.deref()); } static private Object read(PushbackReader r, boolean eofIsError, Object eofValue, boolean isRecursive, Object opts, Object pendingForms) { - return read(r, eofIsError, eofValue, null, null, isRecursive, opts, ensurePending(pendingForms)); + return read(r, eofIsError, eofValue, null, null, isRecursive, opts, ensurePending(pendingForms), (Resolver) RT.READER_RESOLVER.deref()); } static private Object ensurePending(Object pendingForms) { @@ -222,7 +229,9 @@ static private Object installPlatformFeature(Object opts) { } } -static private Object read(PushbackReader r, boolean eofIsError, Object eofValue, Character returnOn, Object returnOnValue, boolean isRecursive, Object opts, Object pendingForms) +static private Object read(PushbackReader r, boolean eofIsError, Object eofValue, Character returnOn, + Object returnOnValue, boolean isRecursive, Object opts, Object pendingForms, + Resolver resolver) { if(RT.READEVAL.deref() == UNKNOWN) throw Util.runtimeException("Reading disallowed - *read-eval* bound to :unknown"); @@ -282,7 +291,7 @@ static private Object read(PushbackReader r, boolean eofIsError, Object eofValue } String token = readToken(r, (char) ch); - return interpretToken(token); + return interpretToken(token, resolver); } } catch(Exception e) @@ -370,7 +379,7 @@ static private int readUnicodeChar(PushbackReader r, int initch, int base, int l return uc; } -static private Object interpretToken(String s) { +static private Object interpretToken(String s, Resolver resolver) { if(s.equals("nil")) { return null; @@ -385,7 +394,7 @@ else if(s.equals("false")) } Object ret = null; - ret = matchSymbol(s); + ret = matchSymbol(s, resolver); if(ret != null) return ret; @@ -393,7 +402,7 @@ else if(s.equals("false")) } -private static Object matchSymbol(String s){ +private static Object matchSymbol(String s, Resolver resolver){ Matcher m = symbolPat.matcher(s); if(m.matches()) { @@ -407,17 +416,33 @@ private static Object matchSymbol(String s){ if(s.startsWith("::")) { Symbol ks = Symbol.intern(s.substring(2)); - Namespace kns; - if(ks.ns != null) - kns = Compiler.namespaceFor(ks); - else - kns = Compiler.currentNS(); - //auto-resolving keyword - if (kns != null) - return Keyword.intern(kns.name.name,ks.name); - else - return null; - } + if(resolver != null) + { + Symbol nsym; + if(ks.ns != null) + nsym = resolver.resolveAlias(Symbol.intern(ks.ns)); + else + nsym = resolver.currentNS(); + //auto-resolving keyword + if(nsym != null) + return Keyword.intern(nsym.name, ks.name); + else + return null; + } + else + { + Namespace kns; + if(ks.ns != null) + kns = Compiler.currentNS().lookupAlias(Symbol.intern(ks.ns)); + else + kns = Compiler.currentNS(); + //auto-resolving keyword + if(kns != null) + return Keyword.intern(kns.name.name, ks.name); + else + return null; + } + } boolean isKeyword = s.charAt(0) == ':'; Symbol sym = Symbol.intern(s.substring(isKeyword ? 1 : 0)); if(isKeyword) @@ -640,19 +665,27 @@ public Object invoke(Object reader, Object colon, Object opts, Object pendingFor // Resolve autoresolved ns String ns; if (auto) { + Resolver resolver = (Resolver) RT.READER_RESOLVER.deref(); if (sym == null) { - ns = Compiler.currentNS().getName().getName(); + if(resolver != null) + ns = resolver.currentNS().name; + else + ns = Compiler.currentNS().getName().getName(); } else if (!(sym instanceof Symbol) || ((Symbol)sym).getNamespace() != null) { throw Util.runtimeException("Namespaced map must specify a valid namespace: " + sym); } else { - Namespace resolvedNS = Compiler.currentNS().lookupAlias((Symbol)sym); - if(resolvedNS == null) - resolvedNS = Namespace.find((Symbol)sym); + Symbol resolvedNS; + if (resolver != null) + resolvedNS = resolver.resolveAlias((Symbol) sym); + else{ + Namespace rns = Compiler.currentNS().lookupAlias((Symbol)sym); + resolvedNS = rns != null?rns.getName():null; + } if(resolvedNS == null) { throw Util.runtimeException("Unknown auto-resolved namespace alias: " + sym); } else { - ns = resolvedNS.getName().getName(); + ns = resolvedNS.getName(); } } } else if (!(sym instanceof Symbol) || ((Symbol)sym).getNamespace() != null) { @@ -858,7 +891,7 @@ public Object invoke(Object reader, Object pct, Object opts, Object pendingForms PushbackReader r = (PushbackReader) reader; if(ARG_ENV.deref() == null) { - return interpretToken(readToken(r, '%')); + return interpretToken(readToken(r, '%'), null); } int ch = read1(r); unread(r, ch); @@ -943,6 +976,7 @@ static Object syntaxQuote(Object form) { ret = RT.list(Compiler.QUOTE, form); else if(form instanceof Symbol) { + Resolver resolver = (Resolver) RT.READER_RESOLVER.deref(); Symbol sym = (Symbol) form; if(sym.ns == null && sym.name.endsWith("#")) { @@ -959,13 +993,41 @@ else if(form instanceof Symbol) else if(sym.ns == null && sym.name.endsWith(".")) { Symbol csym = Symbol.intern(null, sym.name.substring(0, sym.name.length() - 1)); - csym = Compiler.resolveSymbol(csym); + if(resolver != null){ + Symbol rc = resolver.resolveClass(csym); + if(rc != null) + csym = rc; + } + else + csym = Compiler.resolveSymbol(csym); sym = Symbol.intern(null, csym.name.concat(".")); } else if(sym.ns == null && sym.name.startsWith(".")) { // Simply quote method names. } + else if(resolver != null) + { + Symbol nsym = null; + if(sym.ns != null && sym.ns.indexOf('.') == -1){ + Symbol alias = Symbol.intern(null, sym.ns); + nsym = resolver.resolveClass(alias); + if(nsym == null) + nsym = resolver.resolveAlias(alias); + } + if(nsym != null){ + // Classname/foo -> package.qualified.Classname/foo + sym = Symbol.intern(nsym.name, sym.name); + } + else if(sym.ns == null){ + Symbol rsym = resolver.resolveClass(sym); + if(rsym == null) + rsym = resolver.resolveVar(sym); + if(rsym != null) + sym = rsym; + } + //leave alone if no resolution + } else { Object maybeClass = null; @@ -1292,10 +1354,12 @@ public static List readDelimitedList(char delim, PushbackReader r, boolean isRec ((LineNumberingPushbackReader) r).getLineNumber() : -1; ArrayList a = new ArrayList(); + Resolver resolver = (Resolver) RT.READER_RESOLVER.deref(); for(; ;) { - Object form = read(r, false, READ_EOF, delim, READ_FINISHED, isRecursive, opts, pendingForms); + Object form = read(r, false, READ_EOF, delim, READ_FINISHED, isRecursive, opts, pendingForms, + resolver); if (form == READ_EOF) { if (firstline < 0) @@ -1441,7 +1505,7 @@ public static Object readCondDelimited(PushbackReader r, boolean splicing, Objec for(; ;) { if(result == READ_STARTED) { // Read the next feature - form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms); + form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms, null); if (form == READ_EOF) { if (firstline < 0) @@ -1459,7 +1523,7 @@ public static Object readCondDelimited(PushbackReader r, boolean splicing, Objec //Read the form corresponding to the feature, and assign it to result if everything is kosher - form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms); + form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms, (Resolver) RT.READER_RESOLVER.deref()); if (form == READ_EOF) { if (firstline < 0) @@ -1480,7 +1544,7 @@ public static Object readCondDelimited(PushbackReader r, boolean splicing, Objec // When we already have a result, or when the feature didn't match, discard the next form in the reader try { Var.pushThreadBindings(RT.map(RT.SUPPRESS_READ, RT.T)); - form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms); + form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms, (Resolver) RT.READER_RESOLVER.deref()); if (form == READ_EOF) { if (firstline < 0) diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index a6552f74..6723298c 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -227,6 +227,7 @@ else if(s.equals("false")) final static Var PRINT_DUP = Var.intern(CLOJURE_NS, Symbol.intern("*print-dup*"), F).setDynamic(); final static Var WARN_ON_REFLECTION = Var.intern(CLOJURE_NS, Symbol.intern("*warn-on-reflection*"), F).setDynamic(); final static Var ALLOW_UNRESOLVED_VARS = Var.intern(CLOJURE_NS, Symbol.intern("*allow-unresolved-vars*"), F).setDynamic(); +final static Var READER_RESOLVER = Var.intern(CLOJURE_NS, Symbol.intern("*reader-resolver*"), null).setDynamic(); final static Var IN_NS_VAR = Var.intern(CLOJURE_NS, Symbol.intern("in-ns"), F); final static Var NS_VAR = Var.intern(CLOJURE_NS, Symbol.intern("ns"), F); diff --git a/test/clojure/test_clojure/reader.cljc b/test/clojure/test_clojure/reader.cljc index eb1e24de..2e646733 100644 --- a/test/clojure/test_clojure/reader.cljc +++ b/test/clojure/test_clojure/reader.cljc @@ -727,26 +727,19 @@ (is (= #::s{1 nil, :a nil, :a/b nil, :_/d nil} #::s {1 nil, :a nil, :a/b nil, :_/d nil} {1 nil, :clojure.string/a nil, :a/b nil, :d nil})) - (is (= #::clojure.core{1 nil, :a nil, :a/b nil, :_/d nil} {1 nil, :clojure.core/a nil, :a/b nil, :d nil})) (is (= (read-string "#:a{b 1 b/c 2}") {'a/b 1, 'b/c 2})) (is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::{b 1, b/c 2, _/d 3}")) {'clojure.test-clojure.reader/b 1, 'b/c 2, 'd 3})) - (is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::s{b 1, b/c 2, _/d 3}")) {'clojure.string/b 1, 'b/c 2, 'd 3})) - (is (= (read-string "#::clojure.core{b 1, b/c 2, _/d 3}") {'clojure.core/b 1, 'b/c 2, 'd 3}))) + (is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::s{b 1, b/c 2, _/d 3}")) {'clojure.string/b 1, 'b/c 2, 'd 3}))) (deftest namespaced-map-errors (are [err msg form] (thrown-with-msg? err msg (read-string form)) Exception #"Invalid token" "#:::" Exception #"Namespaced map literal must contain an even number of forms" "#:s{1}" Exception #"Namespaced map must specify a valid namespace" "#:s/t{1 2}" - Exception #"Namespaced map literal must contain an even number of forms" "#::clojure.core{1}" - Exception #"Namespaced map must specify a valid namespace" "#::clojure.core/t{1 2}" Exception #"Unknown auto-resolved namespace alias" "#::BOGUS{1 2}" - Exception #"Namespaced map must specify a namespace" "#:: clojure.core{:a 1}" - Exception #"Namespaced map must specify a namespace" "#: clojure.core{:a 1}" + Exception #"Namespaced map must specify a namespace" "#: s{:a 1}" Exception #"Duplicate key: :user/a" "#::{:a 1 :a 2}" - Exception #"Duplicate key: :clojure.core/a" "#::clojure.core{:a 1 :a 2}" - Exception #"Duplicate key: user/a" "#::{a 1 a 2}" - Exception #"Duplicate key: clojure.core/+" "#::clojure.core{+ 1 + 2}")) + Exception #"Duplicate key: user/a" "#::{a 1 a 2}")) (deftest namespaced-map-edn (is (= {1 1, :a/b 2, :b/c 3, :d 4} From cfe6d14be41f47c91f63955910709c10f487f39e Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 21 Aug 2017 11:01:26 -0400 Subject: [PATCH 180/246] default qualify with resovler.currentNS() in syntax quote --- src/jvm/clojure/lang/LispReader.java | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/jvm/clojure/lang/LispReader.java b/src/jvm/clojure/lang/LispReader.java index c331ac8d..82c10747 100644 --- a/src/jvm/clojure/lang/LispReader.java +++ b/src/jvm/clojure/lang/LispReader.java @@ -1025,8 +1025,10 @@ else if(sym.ns == null){ rsym = resolver.resolveVar(sym); if(rsym != null) sym = rsym; + else + sym = Symbol.intern(resolver.currentNS().name,sym.name); } - //leave alone if no resolution + //leave alone if qualified } else { From c569e5874c298a18ca9ce5fbe5133c963bf0f6b3 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Mon, 21 Aug 2017 13:52:59 -0400 Subject: [PATCH 181/246] don't preclude '.' in alias --- src/jvm/clojure/lang/LispReader.java | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/jvm/clojure/lang/LispReader.java b/src/jvm/clojure/lang/LispReader.java index 82c10747..588dcd63 100644 --- a/src/jvm/clojure/lang/LispReader.java +++ b/src/jvm/clojure/lang/LispReader.java @@ -1009,7 +1009,7 @@ else if(sym.ns == null && sym.name.startsWith(".")) else if(resolver != null) { Symbol nsym = null; - if(sym.ns != null && sym.ns.indexOf('.') == -1){ + if(sym.ns != null){ Symbol alias = Symbol.intern(null, sym.ns); nsym = resolver.resolveClass(alias); if(nsym == null) From fb2b62d763c6f7ce33f9edabb0aab015d7197a52 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Wed, 23 Aug 2017 08:48:21 -0500 Subject: [PATCH 182/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha18 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 3b52bbdb..a88e921a 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha18 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-alpha18 From 9696403a2976bd6d1fd241555fbc9ff78d924867 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Wed, 23 Aug 2017 08:48:21 -0500 Subject: [PATCH 183/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index a88e921a..3b52bbdb 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha18 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-alpha18 + HEAD From b7756a64b0707b2a8f4ce23ef7d994410083faa9 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Thu, 24 Aug 2017 09:17:24 -0400 Subject: [PATCH 184/246] make default imports public --- src/jvm/clojure/lang/RT.java | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index 6723298c..e044e88a 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -36,7 +36,7 @@ public class RT{ static final public String LOADER_SUFFIX = "__init"; //simple-symbol->class -final static IPersistentMap DEFAULT_IMPORTS = map( +final static public IPersistentMap DEFAULT_IMPORTS = map( // Symbol.intern("RT"), "clojure.lang.RT", // Symbol.intern("Num"), "clojure.lang.Num", // Symbol.intern("Symbol"), "clojure.lang.Symbol", From c99ebfe98be6bbc4c44ed045927bfdf3e6b8dbac Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Thu, 24 Aug 2017 08:38:09 -0500 Subject: [PATCH 185/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha19 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 3b52bbdb..607168f1 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha19 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-alpha19 From 8a3f296dd3fa037852cfd4c201a5b2a6606260fc Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Thu, 24 Aug 2017 08:38:09 -0500 Subject: [PATCH 186/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 607168f1..3b52bbdb 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha19 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-alpha19 + HEAD From 9960566994cb22a3bb79d3e7a6dd459e9420838f Mon Sep 17 00:00:00 2001 From: Nicola Mometto Date: Fri, 21 Jul 2017 11:06:36 +0100 Subject: [PATCH 187/246] CLJ-2210: cache non-trivial getJavaClass/hasJavaClass to avoid exponential compilation times Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Compiler.java | 92 ++++++++++++++++++++++-------- 1 file changed, 68 insertions(+), 24 deletions(-) diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index b5c881f2..f15de1ef 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -643,6 +643,8 @@ public static class VarExpr implements Expr, AssignableExpr{ final static Method getMethod = Method.getMethod("Object get()"); final static Method setMethod = Method.getMethod("Object set(Object)"); + Class jc; + public VarExpr(Var var, Symbol tag){ this.var = var; this.tag = tag != null ? tag : var.getTag(); @@ -665,7 +667,9 @@ public boolean hasJavaClass(){ } public Class getJavaClass() { - return HostExpr.tagToClass(tag); + if (jc == null) + jc = HostExpr.tagToClass(tag); + return jc; } public Object evalAssign(Expr val) { @@ -1141,6 +1145,7 @@ static class InstanceFieldExpr extends FieldExpr implements AssignableExpr{ final static Method invokeNoArgInstanceMember = Method.getMethod("Object invokeNoArgInstanceMember(Object,String,boolean)"); final static Method setInstanceFieldMethod = Method.getMethod("Object setInstanceField(Object,String,Object)"); + Class jc; public InstanceFieldExpr(int line, int column, Expr target, String fieldName, Symbol tag, boolean requireField) { this.target = target; @@ -1220,7 +1225,9 @@ public boolean hasJavaClass() { } public Class getJavaClass() { - return tag != null ? HostExpr.tagToClass(tag) : field.getType(); + if (jc == null) + jc = tag != null ? HostExpr.tagToClass(tag) : field.getType(); + return jc; } public Object evalAssign(Expr val) { @@ -1263,6 +1270,8 @@ static class StaticFieldExpr extends FieldExpr implements AssignableExpr{ final int line; final int column; + Class jc; + public StaticFieldExpr(int line, int column, Class c, String fieldName, Symbol tag) { //this.className = className; this.fieldName = fieldName; @@ -1316,7 +1325,9 @@ public boolean hasJavaClass(){ public Class getJavaClass() { //Class c = Class.forName(className); //java.lang.reflect.Field field = c.getField(fieldName); - return tag != null ? HostExpr.tagToClass(tag) : field.getType(); + if (jc == null) + jc =tag != null ? HostExpr.tagToClass(tag) : field.getType(); + return jc; } public Object evalAssign(Expr val) { @@ -1449,6 +1460,7 @@ static class InstanceMethodExpr extends MethodExpr{ public final Symbol tag; public final boolean tailPosition; public final java.lang.reflect.Method method; + Class jc; final static Method invokeInstanceMethodMethod = Method.getMethod("Object invokeInstanceMethod(Object,String,Object[])"); @@ -1617,7 +1629,9 @@ public boolean hasJavaClass(){ } public Class getJavaClass() { - return retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null); + if (jc == null) + jc = retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null); + return jc; } } @@ -1637,6 +1651,7 @@ static class StaticMethodExpr extends MethodExpr{ final static Method invokeStaticMethodMethod = Method.getMethod("Object invokeStaticMethod(Class,String,Object[])"); final static Keyword warnOnBoxedKeyword = Keyword.intern("warn-on-boxed"); + Class jc; public StaticMethodExpr(String source, int line, int column, Symbol tag, Class c, String methodName, IPersistentVector args, boolean tailPosition) @@ -1833,7 +1848,9 @@ public boolean hasJavaClass(){ } public Class getJavaClass() { - return retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null); + if (jc == null) + jc = retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null); + return jc; } } @@ -3268,6 +3285,7 @@ static class KeywordInvokeExpr implements Expr{ public final int siteIndex; public final String source; static Type ILOOKUP_TYPE = Type.getType(ILookup.class); + Class jc; public KeywordInvokeExpr(String source, int line, int column, Symbol tag, KeywordExpr kw, Expr target){ this.source = source; @@ -3332,7 +3350,9 @@ public boolean hasJavaClass() { } public Class getJavaClass() { - return HostExpr.tagToClass(tag); + if(jc == null) + jc = HostExpr.tagToClass(tag); + return jc; } } @@ -3441,6 +3461,7 @@ static class StaticInvokeExpr implements Expr, MaybePrimitiveExpr{ public final boolean variadic; public final boolean tailPosition; public final Object tag; + Class jc; StaticInvokeExpr(Type target, Class retClass, Class[] paramclasses, Type[] paramtypes, boolean variadic, IPersistentVector args,Object tag, boolean tailPosition){ @@ -3476,7 +3497,9 @@ public boolean hasJavaClass() { } public Class getJavaClass() { - return retType((tag!=null)?HostExpr.tagToClass(tag):null, retClass); + if(jc == null) + jc =retType((tag!=null)?HostExpr.tagToClass(tag):null, retClass); + return jc; } public boolean canEmitPrimitive(){ @@ -3596,6 +3619,7 @@ static class InvokeExpr implements Expr{ public java.lang.reflect.Method onMethod; static Keyword onKey = Keyword.intern("on"); static Keyword methodMapKey = Keyword.intern("method-map"); + Class jc; static Object sigTag(int argcount, Var v){ Object arglists = RT.get(RT.meta(v), arglistsKey); @@ -3777,7 +3801,9 @@ public boolean hasJavaClass() { } public Class getJavaClass() { - return HostExpr.tagToClass(tag); + if (jc == null) + jc = HostExpr.tagToClass(tag); + return jc; } static public Expr parse(C context, ISeq form) { @@ -3883,6 +3909,7 @@ static public class FnExpr extends ObjExpr{ private boolean hasMeta; private boolean hasEnclosingMethod; // String superName = null; + Class jc; public FnExpr(Object tag){ super(tag); @@ -3897,7 +3924,9 @@ boolean supportsMeta(){ } public Class getJavaClass() { - return tag != null ? HostExpr.tagToClass(tag) : AFunction.class; + if (jc == null) + jc = tag != null ? HostExpr.tagToClass(tag) : AFunction.class; + return jc; } protected void emitMethods(ClassVisitor cv){ @@ -5025,10 +5054,13 @@ public boolean hasJavaClass() { return true; } + Class jc; public Class getJavaClass() { - return (compiledClass != null) ? compiledClass - : (tag != null) ? HostExpr.tagToClass(tag) - : IFn.class; + if (jc == null) + jc = (compiledClass != null) ? compiledClass + : (tag != null) ? HostExpr.tagToClass(tag) + : IFn.class; + return jc; } public void emitAssignLocal(GeneratorAdapter gen, LocalBinding lb,Expr val){ @@ -5926,18 +5958,25 @@ public LocalBinding(int num, Symbol sym, Symbol tag, Expr init, boolean isArg,Pa name = munge(sym.name); } + Boolean hjc; + public boolean hasJavaClass() { - if(init != null && init.hasJavaClass() - && Util.isPrimitive(init.getJavaClass()) - && !(init instanceof MaybePrimitiveExpr)) - return false; - return tag != null - || (init != null && init.hasJavaClass()); - } + if (hjc == null) + { + if(init != null && init.hasJavaClass() && Util.isPrimitive(init.getJavaClass()) && !(init instanceof MaybePrimitiveExpr)) + hjc = false; + else + hjc = tag != null || (init != null && init.hasJavaClass()); + } + return hjc; + } + + Class jc; public Class getJavaClass() { - return tag != null ? HostExpr.tagToClass(tag) - : init.getJavaClass(); + if (jc == null) + jc = tag != null ? HostExpr.tagToClass(tag) : init.getJavaClass(); + return jc; } public Class getPrimitiveType(){ @@ -6025,10 +6064,15 @@ public boolean hasJavaClass() { return tag != null || b.hasJavaClass(); } + Class jc; public Class getJavaClass() { - if(tag != null) - return HostExpr.tagToClass(tag); - return b.getJavaClass(); + if (jc == null) { + if(tag != null) + jc = HostExpr.tagToClass(tag); + else + jc = b.getJavaClass(); + } + return jc; } From 271674c9b484d798484d134a5ac40a6df15d3ac3 Mon Sep 17 00:00:00 2001 From: Chouser Date: Mon, 17 Jul 2017 23:04:41 -0400 Subject: [PATCH 188/246] CLJ-2204 Disable serialization of proxy classes Signed-off-by: Stuart Halloway --- src/clj/clojure/core_proxy.clj | 20 +++++++++++++- test/clojure/test_clojure/java_interop.clj | 31 +++++++++++++++++++++- 2 files changed, 49 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core_proxy.clj b/src/clj/clojure/core_proxy.clj index 813c8bbe..70d0528f 100644 --- a/src/clj/clojure/core_proxy.clj +++ b/src/clj/clojure/core_proxy.clj @@ -13,6 +13,7 @@ (import '(clojure.asm ClassWriter ClassVisitor Opcodes Type) '(java.lang.reflect Modifier Constructor) + '(java.io Serializable NotSerializableException) '(clojure.asm.commons Method GeneratorAdapter) '(clojure.lang IProxy Reflector DynamicClassLoader IPersistentMap PersistentHashMap RT)) @@ -44,7 +45,8 @@ (defn- generate-proxy [^Class super interfaces] (let [cv (new ClassWriter (. ClassWriter COMPUTE_MAXS)) - cname (.replace (proxy-name super interfaces) \. \/) ;(str "clojure/lang/" (gensym "Proxy__")) + pname (proxy-name super interfaces) + cname (.replace pname \. \/) ;(str "clojure/lang/" (gensym "Proxy__")) ctype (. Type (getObjectType cname)) iname (fn [^Class c] (.. Type (getType c) (getInternalName))) fmap "__clojureFnMap" @@ -148,6 +150,22 @@ (. gen (returnValue)) (. gen (endMethod))))) + ;disable serialization + (when (some #(isa? % Serializable) (cons super interfaces)) + (let [m (. Method (getMethod "void writeObject(java.io.ObjectOutputStream)")) + gen (new GeneratorAdapter (. Opcodes ACC_PRIVATE) m nil nil cv)] + (. gen (visitCode)) + (. gen (loadThis)) + (. gen (loadArgs)) + (. gen (throwException (totype NotSerializableException) pname)) + (. gen (endMethod))) + (let [m (. Method (getMethod "void readObject(java.io.ObjectInputStream)")) + gen (new GeneratorAdapter (. Opcodes ACC_PRIVATE) m nil nil cv)] + (. gen (visitCode)) + (. gen (loadThis)) + (. gen (loadArgs)) + (. gen (throwException (totype NotSerializableException) pname)) + (. gen (endMethod)))) ;add IProxy methods (let [m (. Method (getMethod "void __initClojureFnMappings(clojure.lang.IPersistentMap)")) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] diff --git a/test/clojure/test_clojure/java_interop.clj b/test/clojure/test_clojure/java_interop.clj index 86ba5ca6..44b5c707 100644 --- a/test/clojure/test_clojure/java_interop.clj +++ b/test/clojure/test_clojure/java_interop.clj @@ -10,7 +10,8 @@ (ns clojure.test-clojure.java-interop - (:use clojure.test)) + (:use clojure.test) + (:require [clojure.inspector])) ; http://clojure.org/java_interop ; http://clojure.org/compilation @@ -171,6 +172,34 @@ "chain chain chain"))) +;; serialized-proxy can be regenerated using a modified version of +;; Clojure with the proxy serialization prohibition disabled and the +;; following code: +#_(let [baos (java.io.ByteArrayOutputStream.) ] + (with-open [baos baos] + (.writeObject (java.io.ObjectOutputStream. baos) (clojure.inspector/list-model nil))) + (println (apply str (for [c (String. (.toByteArray baos) "ISO-8859-1")] + (if (<= 32 (int c) (int \z)) c (format "\\%03o" (int c))))))) +(def serialized-proxy "\254\355\000\005sr\000Eclojure.inspector.proxy$javax.swing.table.AbstractTableModel$ff19274art\330\266_\010ME\002\000\001L\000\016__clojureFnMapt\000\035Lclojure/lang/IPersistentMap;xr\000$javax.swing.table.AbstractTableModelr\313\3538\256\001\377\276\002\000\001L\000\014listenerListt\000%Ljavax/swing/event/EventListenerList;xpsr\000#javax.swing.event.EventListenerList\2616\306\175\204\352\326D\003\000\000xppxsr\000\037clojure.lang.PersistentArrayMap\3437p\017\230\305\364\337\002\000\002L\000\005_metaq\000\176\000\001[\000\005arrayt\000\023[Ljava/lang/Object;xr\000\033clojure.lang.APersistentMap]\174/\003t r\173\002\000\002I\000\005_hashI\000\007_hasheqxp\000\000\000\000\000\000\000\000pur\000\023[Ljava.lang.Object;\220\316X\237\020s)l\002\000\000xp\000\000\000\006t\000\016getColumnCountsr\000%clojure.inspector$list_model$fn__8816H\252\320\325b\371!+\002\000\000xr\000\026clojure.lang.AFunction>\006p\234\236F\375\313\002\000\001L\000\021__methodImplCachet\000\036Lclojure/lang/MethodImplCache;xppt\000\013getRowCountsr\000%clojure.inspector$list_model$fn__8818-\037I\247\234/U\226\002\000\001L\000\005nrowst\000\022Ljava/lang/Object;xq\000\176\000\017ppt\000\012getValueAtsr\000%clojure.inspector$list_model$fn__8820\323\331\174ke\233\370\034\002\000\002L\000\011get_labelq\000\176\000\024L\000\011get_valueq\000\176\000\024xq\000\176\000\017ppp") + +(deftest test-proxy-non-serializable + (testing "That proxy classes refuse serialization and deserialization" + ;; Serializable listed directly in interface list: + (is (thrown? java.io.NotSerializableException + (-> (java.io.ByteArrayOutputStream.) + (java.io.ObjectOutputStream.) + (.writeObject (proxy [Object java.io.Serializable] []))))) + ;; Serializable included via inheritence: + (is (thrown? java.io.NotSerializableException + (-> (java.io.ByteArrayOutputStream.) + (java.io.ObjectOutputStream.) + (.writeObject (clojure.inspector/list-model nil))))) + ;; Deserialization also prohibited: + (is (thrown? java.io.NotSerializableException + (-> serialized-proxy (.getBytes "ISO-8859-1") + java.io.ByteArrayInputStream. java.io.ObjectInputStream. + .readObject))))) + (deftest test-bases (are [x y] (= x y) (bases java.lang.Math) From c3be1aab7f857cd2bc5ad8a8fac1603e87d9f021 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Wed, 30 Aug 2017 09:50:23 -0500 Subject: [PATCH 189/246] CLJ-2108 - delay loading of spec and core specs Signed-off-by: Stuart Halloway --- src/clj/clojure/main.clj | 1 + src/jvm/clojure/lang/Compile.java | 5 ++- src/jvm/clojure/lang/Compiler.java | 49 +++++++++++++++++++----------- src/jvm/clojure/lang/RT.java | 6 ++-- 4 files changed, 40 insertions(+), 21 deletions(-) diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj index 3394f6be..53b1dc3f 100644 --- a/src/clj/clojure/main.clj +++ b/src/clj/clojure/main.clj @@ -12,6 +12,7 @@ :author "Stephen C. Gilardi and Rich Hickey"} clojure.main (:refer-clojure :exclude [with-bindings]) + (:require [clojure.spec.alpha]) (:import (clojure.lang Compiler Compiler$CompilerException LineNumberingPushbackReader RT)) ;;(:use [clojure.repl :only (demunge root-cause stack-element-str)]) diff --git a/src/jvm/clojure/lang/Compile.java b/src/jvm/clojure/lang/Compile.java index c99dae80..1396be3b 100644 --- a/src/jvm/clojure/lang/Compile.java +++ b/src/jvm/clojure/lang/Compile.java @@ -31,7 +31,7 @@ public class Compile{ private static final Var warn_on_reflection = RT.var("clojure.core", "*warn-on-reflection*"); private static final Var unchecked_math = RT.var("clojure.core", "*unchecked-math*"); -public static void main(String[] args) throws IOException{ +public static void main(String[] args) throws IOException, ClassNotFoundException{ OutputStreamWriter out = (OutputStreamWriter) RT.OUT.deref(); PrintWriter err = RT.errPrintWriter(); @@ -54,6 +54,9 @@ public static void main(String[] args) throws IOException{ else if("warn-on-boxed".equals(uncheckedMathProp)) uncheckedMath = Keyword.intern("warn-on-boxed"); + // force load to avoid transitive compilation during lazy load + RT.load("clojure/core/specs/alpha"); + try { Var.pushThreadBindings(RT.map(compile_path, path, diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index f15de1ef..db1a2a7f 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -6864,6 +6864,35 @@ public static Object preserveTag(ISeq src, Object dst) { return dst; } +private static volatile Var MACRO_CHECK = null; +private static volatile boolean MACRO_CHECK_LOADING = false; +private static final Object MACRO_CHECK_LOCK = new Object(); + +private static Var ensureMacroCheck() throws ClassNotFoundException, IOException { + if(MACRO_CHECK == null) { + synchronized(MACRO_CHECK_LOCK) { + if(MACRO_CHECK == null) { + MACRO_CHECK_LOADING = true; + RT.load("clojure/spec/alpha"); + RT.load("clojure/core/specs/alpha"); + MACRO_CHECK = Var.find(Symbol.intern("clojure.spec.alpha", "macroexpand-check")); + MACRO_CHECK_LOADING = false; + } + } + } + return MACRO_CHECK; +} + +public static void checkSpecs(Var v, ISeq form) { + if(RT.CHECK_SPECS && !MACRO_CHECK_LOADING) { + try { + ensureMacroCheck().applyTo(RT.cons(v, RT.list(form.next()))); + } catch(Exception e) { + throw new CompilerException((String) SOURCE_PATH.deref(), lineDeref(), columnDeref(), e); + } + } +} + public static Object macroexpand1(Object x) { if(x instanceof ISeq) { @@ -6875,24 +6904,8 @@ public static Object macroexpand1(Object x) { Var v = isMacro(op); if(v != null) { - // Do not check specs while inside clojure.spec.alpha - if(! "clojure/spec/alpha.clj".equals(SOURCE_PATH.deref())) - { - try - { - final Namespace checkns = Namespace.find(Symbol.intern("clojure.spec.alpha")); - if (checkns != null) - { - final Var check = Var.find(Symbol.intern("clojure.spec.alpha/macroexpand-check")); - if ((check != null) && (check.isBound())) - check.applyTo(RT.cons(v, RT.list(form.next()))); - } - } - catch(Exception e) - { - throw new CompilerException((String) SOURCE_PATH.deref(), lineDeref(), columnDeref(), e); - } - } + checkSpecs(v, form); + try { ISeq args = RT.cons(form, RT.cons(Compiler.LOCAL_ENV.get(), form.next())); diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index e044e88a..3c835e3f 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -301,6 +301,8 @@ static public void addURL(Object url) throws MalformedURLException{ public static boolean checkSpecAsserts = Boolean.getBoolean("clojure.spec.check-asserts"); +static volatile boolean CHECK_SPECS = false; + static{ Keyword arglistskw = Keyword.intern(null, "arglists"); Symbol namesym = Symbol.intern("name"); @@ -336,6 +338,8 @@ public Object invoke(Object arg1) { catch(Exception e) { throw Util.sneakyThrow(e); } + + CHECK_SPECS = true; } static public Keyword keyword(String ns, String name){ @@ -462,8 +466,6 @@ else if(!loaded && failIfNotFound) static void doInit() throws ClassNotFoundException, IOException{ load("clojure/core"); - load("clojure/spec/alpha"); - load("clojure/core/specs/alpha"); Var.pushThreadBindings( RT.mapUniqueKeys(CURRENT_NS, CURRENT_NS.deref(), From 9048707079e2450ad7c3f672794926f401e2a0e8 Mon Sep 17 00:00:00 2001 From: dennis zhuang Date: Wed, 30 Nov 2016 00:13:04 +0800 Subject: [PATCH 190/246] CLJ-2070: faster clojure.core/delay Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Delay.java | 33 +++++++++++-------- test/clojure/test_clojure/delays.clj | 49 +++++++++++++++++++++++++++- 2 files changed, 68 insertions(+), 14 deletions(-) diff --git a/src/jvm/clojure/lang/Delay.java b/src/jvm/clojure/lang/Delay.java index ef8110b9..262c9c1a 100644 --- a/src/jvm/clojure/lang/Delay.java +++ b/src/jvm/clojure/lang/Delay.java @@ -13,9 +13,9 @@ package clojure.lang; public class Delay implements IDeref, IPending{ -Object val; -Throwable exception; -IFn fn; +volatile Object val; +volatile Throwable exception; +volatile IFn fn; public Delay(IFn fn){ this.fn = fn; @@ -29,18 +29,25 @@ static public Object force(Object x) { : x; } -synchronized public Object deref() { +public Object deref() { if(fn != null) { - try - { - val = fn.invoke(); - } - catch(Throwable t) - { - exception = t; - } - fn = null; + synchronized(this) + { + //double check + if(fn!=null) + { + try + { + val = fn.invoke(); + } + catch(Throwable t) + { + exception = t; + } + fn = null; + } + } } if(exception != null) throw Util.sneakyThrow(exception); diff --git a/test/clojure/test_clojure/delays.clj b/test/clojure/test_clojure/delays.clj index 0de33410..0a2a1c99 100644 --- a/test/clojure/test_clojure/delays.clj +++ b/test/clojure/test_clojure/delays.clj @@ -1,5 +1,6 @@ (ns clojure.test-clojure.delays - (:use clojure.test)) + (:use clojure.test) + (:import [java.util.concurrent CyclicBarrier])) (deftest calls-once (let [a (atom 0) @@ -9,6 +10,27 @@ (is (= 1 @d)) (is (= 1 @a)))) +(deftest calls-once-in-parallel + (let [a (atom 0) + d (delay (swap! a inc)) + threads 100 + ^CyclicBarrier barrier (CyclicBarrier. (+ threads 1))] + (is (= 0 @a)) + (dotimes [_ threads] + (-> + (Thread. + (fn [] + (.await barrier) + (dotimes [_ 10000] + (is (= 1 @d))) + (.await barrier))) + (.start))) + (.await barrier) + (.await barrier) + (is (= 1 @d)) + (is (= 1 @d)) + (is (= 1 @a)))) + (deftest saves-exceptions (let [f #(do (throw (Exception. "broken")) 1) @@ -19,3 +41,28 @@ first-result (try-call)] (is (instance? Exception first-result)) (is (identical? first-result (try-call))))) + +(deftest saves-exceptions-in-parallel + (let [f #(do (throw (Exception. "broken")) + 1) + d (delay (f)) + try-call #(try + @d + (catch Exception e e)) + threads 100 + ^CyclicBarrier barrier (CyclicBarrier. (+ threads 1))] + (dotimes [_ threads] + (-> + (Thread. + (fn [] + (.await barrier) + (let [first-result (try-call)] + (dotimes [_ 10000] + (is (instance? Exception (try-call))) + (is (identical? first-result (try-call))))) + (.await barrier))) + (.start))) + (.await barrier) + (.await barrier) + (is (instance? Exception (try-call))) + (is (identical? (try-call) (try-call))))) From e32471325e715bcb3e4c56bbe66e897d6f3a88b8 Mon Sep 17 00:00:00 2001 From: Gerrit Jansen van Vuuren Date: Fri, 21 Oct 2016 16:09:00 +0200 Subject: [PATCH 191/246] CLJ-2048 add StackTraceElement to throw-if into-array to avoid classcastexception on [Object array when stack trace is nil Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 177f8c1a..ab789fda 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -5763,7 +5763,7 @@ exception (Exception. message) raw-trace (.getStackTrace exception) boring? #(not= (.getMethodName ^StackTraceElement %) "doInvoke") - trace (into-array (drop 2 (drop-while boring? raw-trace)))] + trace (into-array StackTraceElement (drop 2 (drop-while boring? raw-trace)))] (.setStackTrace exception trace) (throw (clojure.lang.Compiler$CompilerException. *file* @@ -7718,4 +7718,4 @@ (defn uri? "Return true if x is a java.net.URI" {:added "1.9"} - [x] (instance? java.net.URI x)) \ No newline at end of file + [x] (instance? java.net.URI x)) From 2b242f943b9a74e753b7ee1b951a8699966ea560 Mon Sep 17 00:00:00 2001 From: Jozef Wagner Date: Wed, 6 Sep 2017 09:25:33 -0500 Subject: [PATCH 192/246] CLJ-1917 Call String/length outside of a loop in the internal-reduce extended on StringSeq Signed-off-by: Stuart Halloway --- src/clj/clojure/core/protocols.clj | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core/protocols.clj b/src/clj/clojure/core/protocols.clj index 5c68ba35..e3bedb25 100644 --- a/src/clj/clojure/core/protocols.clj +++ b/src/clj/clojure/core/protocols.clj @@ -145,10 +145,11 @@ clojure.lang.StringSeq (internal-reduce [str-seq f val] - (let [s (.s str-seq)] + (let [s (.s str-seq) + len (.length s)] (loop [i (.i str-seq) val val] - (if (< i (.length s)) + (if (< i len) (let [ret (f val (.charAt s i))] (if (reduced? ret) @ret From 244aec97eb32642977ffd7f8ed77f263918beed7 Mon Sep 17 00:00:00 2001 From: jimpil Date: Sun, 13 Mar 2016 14:35:55 +0000 Subject: [PATCH 193/246] amap calls alength once Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index ab789fda..d3168dac 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -5157,10 +5157,10 @@ array ret." {:added "1.0"} [a idx ret expr] - `(let [a# ~a + `(let [a# ~a l# (alength a#) ~ret (aclone a#)] (loop [~idx 0] - (if (< ~idx (alength a#)) + (if (< ~idx l#) (do (aset ~ret ~idx ~expr) (recur (unchecked-inc ~idx))) From 46eb144b12d1b5dbf543384984a57a4dfa3d8531 Mon Sep 17 00:00:00 2001 From: Steffen Dienst Date: Tue, 26 Jan 2016 10:45:45 +0100 Subject: [PATCH 194/246] CLJ-1887 Implement missing IPersistentVector method .length Signed-off-by: Stuart Halloway --- src/clj/clojure/gvec.clj | 1 + test/clojure/test_clojure/vectors.clj | 10 +++++++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/src/clj/clojure/gvec.clj b/src/clj/clojure/gvec.clj index dbfe9282..b60f9a48 100644 --- a/src/clj/clojure/gvec.clj +++ b/src/clj/clojure/gvec.clj @@ -249,6 +249,7 @@ (new Vec am cnt shift (.doAssoc this shift root i val) tail (meta this))) (= i cnt) (.cons this val) :else (throw (IndexOutOfBoundsException.)))) + (length [_] cnt) clojure.lang.Reversible (rseq [this] diff --git a/test/clojure/test_clojure/vectors.clj b/test/clojure/test_clojure/vectors.clj index d9faccb1..232b2c93 100644 --- a/test/clojure/test_clojure/vectors.clj +++ b/test/clojure/test_clojure/vectors.clj @@ -360,7 +360,15 @@ (vector-of :int #{1 2 3 4}) (vector-of :int (sorted-set 1 2 3 4)) (vector-of :int 1 2 "3") - (vector-of :int "1" "2" "3"))))) + (vector-of :int "1" "2" "3"))) + (testing "instances of IPersistentVector" + (are [gvec] (instance? clojure.lang.IPersistentVector gvec) + (vector-of :int 1 2 3) + (vector-of :double 1 2 3))) + (testing "fully implements IPersistentVector" + (are [gvec] (= 3 (.length gvec)) + (vector-of :int 1 2 3) + (vector-of :double 1 2 3))))) (deftest empty-vector-equality (let [colls [[] (vector-of :long) '()]] From 31b197110d1498d3523a698fa06975e89ecc6f30 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 22 Jan 2016 14:38:22 -0600 Subject: [PATCH 195/246] CLJ-1841 bean iterator was broken, now matches seq data Signed-off-by: Stuart Halloway --- src/clj/clojure/core_proxy.clj | 15 ++++++++------- test/clojure/test_clojure/java_interop.clj | 6 ++++-- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/src/clj/clojure/core_proxy.clj b/src/clj/clojure/core_proxy.clj index 70d0528f..efa2437b 100644 --- a/src/clj/clojure/core_proxy.clj +++ b/src/clj/clojure/core_proxy.clj @@ -413,10 +413,15 @@ snapshot (fn [] (reduce1 (fn [m e] (assoc m (key e) ((val e)))) - {} (seq pmap)))] + {} (seq pmap))) + thisfn (fn thisfn [plseq] + (lazy-seq + (when-let [pseq (seq plseq)] + (cons (clojure.lang.MapEntry/create (first pseq) (v (first pseq))) + (thisfn (rest pseq))))))] (proxy [clojure.lang.APersistentMap] [] - (iterator [] (.iterator ^Iterable pmap)) + (iterator [] (clojure.lang.SeqIterator. ^java.util.Iterator (thisfn (keys pmap)))) (containsKey [k] (contains? pmap k)) (entryAt [k] (when (contains? pmap k) (clojure.lang.MapEntry/create k (v k)))) (valAt ([k] (when (contains? pmap k) (v k))) @@ -425,11 +430,7 @@ (count [] (count pmap)) (assoc [k v] (assoc (snapshot) k v)) (without [k] (dissoc (snapshot) k)) - (seq [] ((fn thisfn [plseq] - (lazy-seq - (when-let [pseq (seq plseq)] - (cons (clojure.lang.MapEntry/create (first pseq) (v (first pseq))) - (thisfn (rest pseq)))))) (keys pmap)))))) + (seq [] (thisfn (keys pmap)))))) diff --git a/test/clojure/test_clojure/java_interop.clj b/test/clojure/test_clojure/java_interop.clj index 44b5c707..223d6efd 100644 --- a/test/clojure/test_clojure/java_interop.clj +++ b/test/clojure/test_clojure/java_interop.clj @@ -151,8 +151,10 @@ (:class b) java.awt.Color ))) (deftest test-iterable-bean - (is (.iterator ^Iterable (bean (java.util.Date.)))) - (is (hash (bean (java.util.Date.))))) + (let [b (bean (java.util.Date.))] + (is (.iterator ^Iterable b)) + (is (= (into [] b) (into [] (seq b)))) + (is (hash b)))) ; proxy, proxy-super From 9bca33911e130d3962dd75a13dbede9d49eea1f6 Mon Sep 17 00:00:00 2001 From: Adam Clements Date: Wed, 28 Sep 2016 14:37:12 -0500 Subject: [PATCH 196/246] CLJ-1714 Using a class in a type hint shouldn't cause the static initialiser to be executed Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Compiler.java | 6 +++--- test/clojure/test_clojure/compilation.clj | 6 ++++++ .../ClassWithFailingStaticInitialiser.java | 13 +++++++++++++ 3 files changed, 22 insertions(+), 3 deletions(-) create mode 100644 test/java/compilation/ClassWithFailingStaticInitialiser.java diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index db1a2a7f..faa9f4b5 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -1038,7 +1038,7 @@ public static Class maybeClass(Object form, boolean stringOk) { if(Util.equals(sym,COMPILE_STUB_SYM.get())) return (Class) COMPILE_STUB_CLASS.get(); if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[') - c = RT.classForName(sym.name); + c = RT.classForNameNonLoading(sym.name); else { Object o = currentNS().getMapping(sym); @@ -1049,7 +1049,7 @@ else if(LOCAL_ENV.deref() != null && ((java.util.Map)LOCAL_ENV.deref()).contains else { try{ - c = RT.classForName(sym.name); + c = RT.classForNameNonLoading(sym.name); } catch(Exception e){ // aargh @@ -1060,7 +1060,7 @@ else if(LOCAL_ENV.deref() != null && ((java.util.Map)LOCAL_ENV.deref()).contains } } else if(stringOk && form instanceof String) - c = RT.classForName((String) form); + c = RT.classForNameNonLoading((String) form); return c; } diff --git a/test/clojure/test_clojure/compilation.clj b/test/clojure/test_clojure/compilation.clj index df0f995d..11a57372 100644 --- a/test/clojure/test_clojure/compilation.clj +++ b/test/clojure/test_clojure/compilation.clj @@ -422,3 +422,9 @@ ;; eventually call `load` and reset called?. (require 'clojure.repl :reload)) (is @called?))) + +(deftest clj-1714 + (testing "CLJ-1714 Classes shouldn't have their static initialisers called simply by type hinting or importing" + ;; ClassWithFailingStaticInitialiser will throw if its static initialiser is called + (is (eval '(fn [^compilation.ClassWithFailingStaticInitialiser c]))) + (is (eval '(import (compilation ClassWithFailingStaticInitialiser)))))) diff --git a/test/java/compilation/ClassWithFailingStaticInitialiser.java b/test/java/compilation/ClassWithFailingStaticInitialiser.java new file mode 100644 index 00000000..6e6c8f7e --- /dev/null +++ b/test/java/compilation/ClassWithFailingStaticInitialiser.java @@ -0,0 +1,13 @@ +package compilation; + +public class ClassWithFailingStaticInitialiser { + static { + // Static analysis refuses to compile a static initialiser + // which will always throw, so we pretend to branch. This may + // need updating if the static analysis gets cleverer in the + // future + if(true) { + throw new AssertionError("Static Initialiser was run when it shouldn't have been"); + } + } +} From 2dafcd3b11ad9d8a911a32c0a62b637c43ed0588 Mon Sep 17 00:00:00 2001 From: Eli Lindsey Date: Mon, 1 Feb 2016 06:08:14 -0600 Subject: [PATCH 197/246] CLJ-1398 update javadoc urls Signed-off-by: Stuart Halloway --- src/clj/clojure/java/javadoc.clj | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/clj/clojure/java/javadoc.clj b/src/clj/clojure/java/javadoc.clj index 36527097..4eea1ec2 100644 --- a/src/clj/clojure/java/javadoc.clj +++ b/src/clj/clojure/java/javadoc.clj @@ -20,20 +20,24 @@ (def ^:dynamic *core-java-api* (case (System/getProperty "java.specification.version") - "1.6" "http://java.sun.com/javase/6/docs/api/" - "http://java.sun.com/javase/7/docs/api/")) + "1.6" "http://docs.oracle.com/javase/6/docs/api/" + "1.7" "http://docs.oracle.com/javase/7/docs/api/" + "1.8" "http://docs.oracle.com/javase/8/docs/api/" + "http://docs.oracle.com/javase/8/docs/api/")) (def ^:dynamic *remote-javadocs* (ref (sorted-map + "com.google.common." "http://docs.guava-libraries.googlecode.com/git/javadoc/" "java." *core-java-api* "javax." *core-java-api* "org.ietf.jgss." *core-java-api* "org.omg." *core-java-api* "org.w3c.dom." *core-java-api* "org.xml.sax." *core-java-api* - "org.apache.commons.codec." "http://commons.apache.org/codec/api-release/" - "org.apache.commons.io." "http://commons.apache.org/io/api-release/" - "org.apache.commons.lang." "http://commons.apache.org/lang/api-release/"))) + "org.apache.commons.codec." "http://commons.apache.org/proper/commons-codec/apidocs/" + "org.apache.commons.io." "http://commons.apache.org/proper/commons-io/javadocs/api-release/" + "org.apache.commons.lang." "http://commons.apache.org/proper/commons-lang/javadocs/api-2.6/" + "org.apache.commons.lang3." "http://commons.apache.org/proper/commons-lang/javadocs/api-release/"))) (defn add-local-javadoc "Adds to the list of local Javadoc paths." From d10a9d36ef91e1f329528890d6fc70471d78485d Mon Sep 17 00:00:00 2001 From: Andy Fingerhut Date: Thu, 15 Nov 2012 19:33:47 -0800 Subject: [PATCH 198/246] CLJ-99: Make min-key and max-key evaluate k on each argument at most once Previous versions of these functions evaluated k on most argument twice if there were 3 or more. Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 22 +++++++++++++++++-- test/clojure/test_clojure/other_functions.clj | 10 +++++++++ 2 files changed, 30 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index d3168dac..8d90af4a 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -4919,7 +4919,16 @@ ([k x] x) ([k x y] (if (> (k x) (k y)) x y)) ([k x y & more] - (reduce1 #(max-key k %1 %2) (max-key k x y) more))) + (let [kx (k x) ky (k y) + [v kv] (if (> kx ky) [x kx] [y ky])] + (loop [v v kv kv more more] + (if more + (let [w (first more) + kw (k w)] + (if (> kw kv) + (recur w kw (next more)) + (recur v kv (next more)))) + v))))) (defn min-key "Returns the x for which (k x), a number, is least." @@ -4928,7 +4937,16 @@ ([k x] x) ([k x y] (if (< (k x) (k y)) x y)) ([k x y & more] - (reduce1 #(min-key k %1 %2) (min-key k x y) more))) + (let [kx (k x) ky (k y) + [v kv] (if (< kx ky) [x kx] [y ky])] + (loop [v v kv kv more more] + (if more + (let [w (first more) + kw (k w)] + (if (< kw kv) + (recur w kw (next more)) + (recur v kv (next more)))) + v))))) (defn distinct "Returns a lazy sequence of the elements of coll with duplicates removed. diff --git a/test/clojure/test_clojure/other_functions.clj b/test/clojure/test_clojure/other_functions.clj index f5d438d9..94ce9d70 100644 --- a/test/clojure/test_clojure/other_functions.clj +++ b/test/clojure/test_clojure/other_functions.clj @@ -328,6 +328,16 @@ (apply (apply some-fn (repeat i (comp not boolean))) (range i)))) true)))) + +(deftest test-max-min-key + (are [k coll min-item max-item] (and (= min-item (apply min-key k coll)) + (= max-item (apply max-key k coll))) + count ["longest" "a" "xy" "foo" "bar"] "a" "longest" + - [5 10 15 20 25] 25 5 + #(if (neg? %) (- %) %) [-2 -1 0 1 2 3 4] 0 4 + {nil 1 false -1 true 0} [true true false nil] false nil)) + + ; Printing ; pr prn print println newline ; pr-str prn-str print-str println-str [with-out-str (vars.clj)] From 2a08ef40018f1b504602545603eec840b05b33b1 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Wed, 6 Sep 2017 09:11:15 -0500 Subject: [PATCH 199/246] CLJ-1371 Add checks in divide(Object, Object) to check for NaN Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Numbers.java | 5 ++ test/clojure/test_clojure/numbers.clj | 70 +++++++++++++++++++++++++++ 2 files changed, 75 insertions(+) diff --git a/src/jvm/clojure/lang/Numbers.java b/src/jvm/clojure/lang/Numbers.java index ae42676d..0440aebd 100644 --- a/src/jvm/clojure/lang/Numbers.java +++ b/src/jvm/clojure/lang/Numbers.java @@ -153,6 +153,11 @@ static public Number multiplyP(Object x, Object y){ } static public Number divide(Object x, Object y){ + if (isNaN(x)){ + return (Number)x; + } else if(isNaN(y)){ + return (Number)y; + } Ops yops = ops(y); if(yops.isZero((Number)y)) throw new ArithmeticException("Divide by zero"); diff --git a/test/clojure/test_clojure/numbers.clj b/test/clojure/test_clojure/numbers.clj index b3d14235..c315caa5 100644 --- a/test/clojure/test_clojure/numbers.clj +++ b/test/clojure/test_clojure/numbers.clj @@ -809,3 +809,73 @@ Math/pow overflows to Infinity." (<= 1000 Double/NaN) (<= 1000 (Double. Double/NaN)) (> 1000 Double/NaN) (> 1000 (Double. Double/NaN)) (>= 1000 Double/NaN) (>= 1000 (Double. Double/NaN)))) + +(deftest test-nan-as-operand + (testing "All numeric operations with NaN as an operand produce NaN as a result" + (let [nan Double/NaN + onan (cast Object Double/NaN)] + (are [x] (Double/isNaN x) + (+ nan 1) + (+ nan 0) + (+ nan 0.0) + (+ 1 nan) + (+ 0 nan) + (+ 0.0 nan) + (+ nan nan) + (- nan 1) + (- nan 0) + (- nan 0.0) + (- 1 nan) + (- 0 nan) + (- 0.0 nan) + (- nan nan) + (* nan 1) + (* nan 0) + (* nan 0.0) + (* 1 nan) + (* 0 nan) + (* 0.0 nan) + (* nan nan) + (/ nan 1) + (/ nan 0) + (/ nan 0.0) + (/ 1 nan) + (/ 0 nan) + (/ 0.0 nan) + (/ nan nan) + (+ onan 1) + (+ onan 0) + (+ onan 0.0) + (+ 1 onan) + (+ 0 onan) + (+ 0.0 onan) + (+ onan onan) + (- onan 1) + (- onan 0) + (- onan 0.0) + (- 1 onan) + (- 0 onan) + (- 0.0 onan) + (- onan onan) + (* onan 1) + (* onan 0) + (* onan 0.0) + (* 1 onan) + (* 0 onan) + (* 0.0 onan) + (* onan onan) + (/ onan 1) + (/ onan 0) + (/ onan 0.0) + (/ 1 onan) + (/ 0 onan) + (/ 0.0 onan) + (/ onan onan) + (+ nan onan) + (+ onan nan) + (- nan onan) + (- onan nan) + (* nan onan) + (* onan nan) + (/ nan onan) + (/ onan nan) )))) From eac8de58b0a552f6f34f2803bf8a3bbb4ec2e257 Mon Sep 17 00:00:00 2001 From: Cameron Desautels Date: Mon, 29 May 2017 22:17:44 +0800 Subject: [PATCH 200/246] Fix improperly located docstrings Signed-off-by: Stuart Halloway --- src/clj/clojure/core_proxy.clj | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core_proxy.clj b/src/clj/clojure/core_proxy.clj index efa2437b..de08a730 100644 --- a/src/clj/clojure/core_proxy.clj +++ b/src/clj/clojure/core_proxy.clj @@ -24,8 +24,10 @@ (or (some (fn [t] (when (every? #(isa? t %) rtypes) t)) rtypes) (throw (Exception. "Incompatible return types")))) -(defn- group-by-sig [coll] - "takes a collection of [msig meth] and returns a seq of maps from return-types to meths." +(defn- group-by-sig + "Takes a collection of [msig meth] and returns a seq of maps from + return-types to meths." + [coll] (vals (reduce1 (fn [m [msig meth]] (let [rtype (peek msig) argsig (pop msig)] From c80d9b01ae58939e1bcf93a4a2a0089369cec2a1 Mon Sep 17 00:00:00 2001 From: Yegor Timoshenko Date: Sat, 22 Apr 2017 14:40:46 +0000 Subject: [PATCH 201/246] Document char[] input support in clojure.java.io/copy Signed-off-by: Stuart Halloway --- src/clj/clojure/java/io.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/java/io.clj b/src/clj/clojure/java/io.clj index 948561a0..d9e67f2e 100644 --- a/src/clj/clojure/java/io.clj +++ b/src/clj/clojure/java/io.clj @@ -390,7 +390,7 @@ (defn copy "Copies input to output. Returns nil or throws IOException. - Input may be an InputStream, Reader, File, byte[], or String. + Input may be an InputStream, Reader, File, byte[], char[], or String. Output may be an OutputStream, Writer, or File. Options are key/value pairs and may be one of From b13c45dfaa4de1691284cc7f99daa1872f868367 Mon Sep 17 00:00:00 2001 From: Greg Leppert Date: Wed, 2 Nov 2016 19:03:54 -0400 Subject: [PATCH 202/246] Fix typo Signed-off-by: Stuart Halloway --- src/clj/clojure/instant.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/instant.clj b/src/clj/clojure/instant.clj index ddece220..9c8eb5ec 100644 --- a/src/clj/clojure/instant.clj +++ b/src/clj/clojure/instant.clj @@ -136,7 +136,7 @@ specified. ((if leap-year? dim-leap dim-norm) month)))) (defn validated - "Return a function which constructs and instant by calling constructor + "Return a function which constructs an instant by calling constructor after first validating that those arguments are in range and otherwise plausible. The resulting function will throw an exception if called with invalid arguments." From 26bd803a8a05f398fa1c036104db04a890cb5d80 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Sun, 29 Jan 2017 21:10:34 -0600 Subject: [PATCH 203/246] CLJ-2104 Fix typo in docstring Signed-off-by: Stuart Halloway --- src/clj/clojure/pprint.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/pprint.clj b/src/clj/clojure/pprint.clj index f09f4da0..53ff9057 100644 --- a/src/clj/clojure/pprint.clj +++ b/src/clj/clojure/pprint.clj @@ -32,7 +32,7 @@ cl-format, it supports very concise custom dispatch. It also provides a more powerful alternative to Clojure's standard format function. See documentation for pprint and cl-format for more information or -complete documentation on the the clojure web site on github.", +complete documentation on the clojure web site on github.", :added "1.2"} clojure.pprint (:refer-clojure :exclude (deftype)) From 6d08609c208ae49a3d411efbdc316ec102fdef1d Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Wed, 6 Sep 2017 20:41:16 -0400 Subject: [PATCH 204/246] finish partial application of previous commits --- src/clj/clojure/pprint.clj | 2 +- src/clj/clojure/pprint/pretty_writer.clj | 5 ++-- src/clj/clojure/pprint/utilities.clj | 37 ++++++++++++++---------- src/clj/clojure/set.clj | 7 +++-- 4 files changed, 30 insertions(+), 21 deletions(-) diff --git a/src/clj/clojure/pprint.clj b/src/clj/clojure/pprint.clj index 53ff9057..42836ac8 100644 --- a/src/clj/clojure/pprint.clj +++ b/src/clj/clojure/pprint.clj @@ -32,7 +32,7 @@ cl-format, it supports very concise custom dispatch. It also provides a more powerful alternative to Clojure's standard format function. See documentation for pprint and cl-format for more information or -complete documentation on the clojure web site on github.", +complete documentation on the Clojure web site on GitHub.", :added "1.2"} clojure.pprint (:refer-clojure :exclude (deftype)) diff --git a/src/clj/clojure/pprint/pretty_writer.clj b/src/clj/clojure/pprint/pretty_writer.clj index e3a6e338..49023b82 100644 --- a/src/clj/clojure/pprint/pretty_writer.clj +++ b/src/clj/clojure/pprint/pretty_writer.clj @@ -40,9 +40,10 @@ [sym] `(~sym @@~'this)) -(defmacro ^{:private true} - setf [sym new-val] +(defmacro ^{:private true} + setf "Set the value of the field SYM to NEW-VAL" + [sym new-val] `(alter @~'this assoc ~sym ~new-val)) (defmacro ^{:private true} diff --git a/src/clj/clojure/pprint/utilities.clj b/src/clj/clojure/pprint/utilities.clj index 53c4e973..95655bd6 100644 --- a/src/clj/clojure/pprint/utilities.clj +++ b/src/clj/clojure/pprint/utilities.clj @@ -50,19 +50,22 @@ [acc context] (recur new-context (conj acc result)))))) -(defn- unzip-map [m] - "Take a map that has pairs in the value slots and produce a pair of maps, - the first having all the first elements of the pairs and the second all - the second elements of the pairs" +(defn- unzip-map + "Take a map that has pairs in the value slots and produce a pair of + maps, the first having all the first elements of the pairs and the + second all the second elements of the pairs" + [m] [(into {} (for [[k [v1 v2]] m] [k v1])) (into {} (for [[k [v1 v2]] m] [k v2]))]) -(defn- tuple-map [m v1] +(defn- tuple-map "For all the values, v, in the map, replace them with [v v1]" + [m v1] (into {} (for [[k v] m] [k [v v1]]))) -(defn- rtrim [s c] +(defn- rtrim "Trim all instances of c from the end of sequence s" + [s c] (let [len (count s)] (if (and (pos? len) (= (nth s (dec (count s))) c)) (loop [n (dec len)] @@ -72,8 +75,9 @@ true (recur (dec n)))) s))) -(defn- ltrim [s c] +(defn- ltrim "Trim all instances of c from the beginning of sequence s" + [s c] (let [len (count s)] (if (and (pos? len) (= (nth s 0) c)) (loop [n 0] @@ -82,24 +86,27 @@ (recur (inc n)))) s))) -(defn- prefix-count [aseq val] - "Return the number of times that val occurs at the start of sequence aseq, -if val is a seq itself, count the number of times any element of val occurs at the -beginning of aseq" +(defn- prefix-count + "Return the number of times that val occurs at the start of sequence aseq, + if val is a seq itself, count the number of times any element of val + occurs at the beginning of aseq" + [aseq val] (let [test (if (coll? val) (set val) #{val})] (loop [pos 0] (if (or (= pos (count aseq)) (not (test (nth aseq pos)))) pos (recur (inc pos)))))) -(defn- prerr [& args] +(defn- prerr "Println to *err*" + [& args] (binding [*out* *err*] (apply println args))) - -(defmacro ^{:private true} prlabel [prefix arg & more-args] + +(defmacro ^{:private true} prlabel "Print args to *err* in name = value format" - `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) + [prefix arg & more-args] + `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) (cons arg (seq more-args)))))) ;; Flush the pretty-print buffer without flushing the underlying stream diff --git a/src/clj/clojure/set.clj b/src/clj/clojure/set.clj index 6a60d4f2..b63a0044 100644 --- a/src/clj/clojure/set.clj +++ b/src/clj/clojure/set.clj @@ -10,9 +10,10 @@ :author "Rich Hickey"} clojure.set) -(defn- bubble-max-key [k coll] - "Move a maximal element of coll according to fn k (which returns a number) - to the front of coll." +(defn- bubble-max-key + "Move a maximal element of coll according to fn k (which returns a + number) to the front of coll." + [k coll] (let [max (apply max-key k coll)] (cons max (remove #(identical? max %) coll)))) From 4ddc34ee11563345ad2142763c03495bf85110ff Mon Sep 17 00:00:00 2001 From: Jozef Wagner Date: Thu, 27 Oct 2016 14:07:50 +0200 Subject: [PATCH 205/246] CLJ-2028 Fix docstrings in filter, filterv, remove and take-while Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 8d90af4a..9750923b 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -2772,7 +2772,7 @@ (defn filter "Returns a lazy sequence of the items in coll for which - (pred item) returns true. pred must be free of side-effects. + (pred item) returns logical true. pred must be free of side-effects. Returns a transducer when no collection is provided." {:added "1.0" :static true} @@ -2805,7 +2805,7 @@ (defn remove "Returns a lazy sequence of the items in coll for which - (pred item) returns false. pred must be free of side-effects. + (pred item) returns logical false. pred must be free of side-effects. Returns a transducer when no collection is provided." {:added "1.0" :static true} @@ -2867,7 +2867,7 @@ (defn take-while "Returns a lazy sequence of successive items from coll while - (pred item) returns true. pred must be free of side-effects. + (pred item) returns logical true. pred must be free of side-effects. Returns a transducer when no collection is provided." {:added "1.0" :static true} @@ -6814,7 +6814,7 @@ (defn filterv "Returns a vector of the items in coll for which - (pred item) returns true. pred must be free of side-effects." + (pred item) returns logical true. pred must be free of side-effects." {:added "1.4" :static true} [pred coll] From a543624897cf68b906f6a4fcd6ee0391b8cc6577 Mon Sep 17 00:00:00 2001 From: Andy Fingerhut Date: Fri, 1 Jan 2016 02:26:23 -0800 Subject: [PATCH 206/246] CLJ-1873: Add .cljc files to doc strings of require and *data-readers* Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 9750923b..b0c803c4 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -5946,9 +5946,11 @@ 'require loads a lib by loading its root resource. The root resource path is derived from the lib name in the following manner: Consider a lib named by the symbol 'x.y.z; it has the root directory - /x/y/, and its root resource is /x/y/z.clj. The root - resource should contain code to create the lib's namespace (usually by using - the ns macro) and load any additional lib resources. + /x/y/, and its root resource is /x/y/z.clj, or + /x/y/z.cljc if /x/y/z.clj does not exist. The + root resource should contain code to create the lib's + namespace (usually by using the ns macro) and load any additional + lib resources. Libspecs @@ -7650,8 +7652,8 @@ "Map from reader tag symbols to data reader Vars. When Clojure starts, it searches for files named 'data_readers.clj' - at the root of the classpath. Each such file must contain a literal - map of symbols, like this: + and 'data_readers.cljc' at the root of the classpath. Each such file + must contain a literal map of symbols, like this: {foo/bar my.project.foo/bar foo/baz my.project/baz} @@ -7672,7 +7674,7 @@ Reader tags without namespace qualifiers are reserved for Clojure. Default reader tags are defined in clojure.core/default-data-readers but may be overridden in - data_readers.clj or by rebinding this Var." + data_readers.clj, data_readers.cljc, or by rebinding this Var." {}) (def ^{:added "1.5" :dynamic true} *default-data-reader-fn* From ee1b606ad066ac8df2efd4a6b8d0d365c206f5bf Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 18 Jan 2016 17:51:01 -0600 Subject: [PATCH 207/246] CLJ-1159 Improve docstring of clojure.java.io/delete-file Signed-off-by: Stuart Halloway --- src/clj/clojure/java/io.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/java/io.clj b/src/clj/clojure/java/io.clj index d9e67f2e..72a30ed7 100644 --- a/src/clj/clojure/java/io.clj +++ b/src/clj/clojure/java/io.clj @@ -428,7 +428,7 @@ (reduce file (file parent child) more))) (defn delete-file - "Delete file f. Raise an exception if it fails unless silently is true." + "Delete file f. If silently is nil or false, raise an exception on failure, else return the value of silently." {:added "1.2"} [f & [silently]] (or (.delete (file f)) From c9dba73a43ca7e294b3db5e6a73c997759851689 Mon Sep 17 00:00:00 2001 From: Steve Miner Date: Wed, 5 Oct 2016 17:36:23 -0400 Subject: [PATCH 208/246] deftype docstring typo Signed-off-by: Stuart Halloway --- src/clj/clojure/core_deftype.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj index 8795ee5d..73a4787f 100644 --- a/src/clj/clojure/core_deftype.clj +++ b/src/clj/clojure/core_deftype.clj @@ -425,8 +425,8 @@ Options are expressed as sequential keywords and arguments (in any order). Supported options: - :load-ns - if true, importing the record class will cause the - namespace in which the record was defined to be loaded. + :load-ns - if true, importing the type class will cause the + namespace in which the type was defined to be loaded. Defaults to false. Each spec consists of a protocol or interface name followed by zero From a43d912acfe30c5e78f46d0bee0a91697a1d9aea Mon Sep 17 00:00:00 2001 From: Ruslan Al-Fakikh Date: Mon, 25 Apr 2016 17:04:54 +0300 Subject: [PATCH 209/246] CLJ-1918 fixed docstring Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index b0c803c4..5dcb9abe 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -3255,7 +3255,7 @@ "Blocks the current thread (indefinitely!) until all actions dispatched thus far, from this thread or agent, to the agent(s) have occurred. Will block on failed agents. Will never return if - a failed agent is restarted with :clear-actions true." + a failed agent is restarted with :clear-actions true or shutdown-agents was called." {:added "1.0" :static true} [& agents] From 32b2759a4d3508926ca2ec0f91413e6892b44d47 Mon Sep 17 00:00:00 2001 From: Andy Fingerhut Date: Fri, 1 Jan 2016 02:58:35 -0800 Subject: [PATCH 210/246] CLJ-1837: Clarify doc strings of index-of and last-index-of Signed-off-by: Stuart Halloway --- src/clj/clojure/string.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/string.clj b/src/clj/clojure/string.clj index 910403ee..35e0650f 100644 --- a/src/clj/clojure/string.clj +++ b/src/clj/clojure/string.clj @@ -317,7 +317,7 @@ Design notes for clojure.string: (defn index-of "Return index of value (string or char) in s, optionally searching - forward from from-index or nil if not found." + forward from from-index. Return nil if value not found." {:added "1.8"} ([^CharSequence s value] (let [result ^long @@ -338,7 +338,7 @@ Design notes for clojure.string: (defn last-index-of "Return last index of value (string or char) in s, optionally - searching backward from from-index or nil if not found." + searching backward from from-index. Return nil if value not found." {:added "1.8"} ([^CharSequence s value] (let [result ^long From 4e3795c1f4b9dabb162fa2340242fc8eb908ff9c Mon Sep 17 00:00:00 2001 From: Yen-Chin Lee Date: Tue, 20 Oct 2015 22:36:17 +0800 Subject: [PATCH 211/246] CLJ-1826: drop-last docstring refers to 'coll' args refer to 's' Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 5dcb9abe..ff148450 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -2915,8 +2915,8 @@ "Return a lazy sequence of all but the last n (default 1) items in coll" {:added "1.0" :static true} - ([s] (drop-last 1 s)) - ([n s] (map (fn [x _] x) s (drop n s)))) + ([coll] (drop-last 1 coll)) + ([n coll] (map (fn [x _] x) coll (drop n coll)))) (defn take-last "Returns a seq of the last n items in coll. Depending on the type From e19157c4809622fcaac1d8ccca8e3f6a67b3d848 Mon Sep 17 00:00:00 2001 From: Matthew Boston Date: Mon, 30 Nov 2015 12:09:14 -0700 Subject: [PATCH 212/246] CLJ-1859: Update parameter name to reflect docstring Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index ff148450..0b7d15c4 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -859,9 +859,9 @@ (defn zero? "Returns true if num is zero, else false" { - :inline (fn [x] `(. clojure.lang.Numbers (isZero ~x))) + :inline (fn [num] `(. clojure.lang.Numbers (isZero ~num))) :added "1.0"} - [x] (. clojure.lang.Numbers (isZero x))) + [num] (. clojure.lang.Numbers (isZero num))) (defn count "Returns the number of items in the collection. (count nil) returns @@ -1239,16 +1239,16 @@ (defn pos? "Returns true if num is greater than zero, else false" { - :inline (fn [x] `(. clojure.lang.Numbers (isPos ~x))) + :inline (fn [num] `(. clojure.lang.Numbers (isPos ~num))) :added "1.0"} - [x] (. clojure.lang.Numbers (isPos x))) + [num] (. clojure.lang.Numbers (isPos num))) (defn neg? "Returns true if num is less than zero, else false" { - :inline (fn [x] `(. clojure.lang.Numbers (isNeg ~x))) + :inline (fn [num] `(. clojure.lang.Numbers (isNeg ~num))) :added "1.0"} - [x] (. clojure.lang.Numbers (isNeg x))) + [num] (. clojure.lang.Numbers (isNeg num))) (defn quot "quot[ient] of dividing numerator by denominator." From 12e976ca3b07d7434ad4571a6bbeb05ef45d49b4 Mon Sep 17 00:00:00 2001 From: Nicola Mometto Date: Thu, 7 Sep 2017 13:43:48 -0500 Subject: [PATCH 213/246] CLJ-1074: add ##Inf/##-Inf/##NaN symbols Signed-off-by: Stuart Halloway --- src/clj/clojure/core_print.clj | 14 ++++++++++++++ src/jvm/clojure/lang/EdnReader.java | 22 +++++++++++++++++++++- src/jvm/clojure/lang/LispReader.java | 21 +++++++++++++++++++++ test/clojure/test_clojure/printer.clj | 9 +++++++++ test/clojure/test_clojure/reader.cljc | 12 +++++++++++- 5 files changed, 76 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core_print.clj b/src/clj/clojure/core_print.clj index f17e2f7a..1b2b7a57 100644 --- a/src/clj/clojure/core_print.clj +++ b/src/clj/clojure/core_print.clj @@ -128,6 +128,20 @@ (defmethod print-method Number [o, ^Writer w] (.write w (str o))) +(defmethod print-method Double [o, ^Writer w] + (cond + (= Double/POSITIVE_INFINITY o) (.write w "##Inf") + (= Double/NEGATIVE_INFINITY o) (.write w "##-Inf") + (.isNaN ^Double o) (.write w "##NaN") + :else (.write w (str o)))) + +(defmethod print-method Float [o, ^Writer w] + (cond + (= Float/POSITIVE_INFINITY o) (.write w "##Inf") + (= Float/NEGATIVE_INFINITY o) (.write w "##-Inf") + (.isNaN ^Float o) (.write w "##NaN") + :else (.write w (str o)))) + (defmethod print-dup Number [o, ^Writer w] (print-ctor o (fn [o w] diff --git a/src/jvm/clojure/lang/EdnReader.java b/src/jvm/clojure/lang/EdnReader.java index c5c3665e..e7449697 100644 --- a/src/jvm/clojure/lang/EdnReader.java +++ b/src/jvm/clojure/lang/EdnReader.java @@ -49,6 +49,7 @@ public class EdnReader{ macros['#'] = new DispatchReader(); + dispatchMacros['#'] = new SymbolicValueReader(); dispatchMacros['^'] = new MetaReader(); //dispatchMacros['"'] = new RegexReader(); dispatchMacros['{'] = new SetReader(); @@ -705,6 +706,26 @@ public Object invoke(Object reader, Object leftangle, Object opts) { } } + +public static class SymbolicValueReader extends AFn{ + + static IPersistentMap specials = PersistentHashMap.create(Symbol.intern("Inf"), Double.POSITIVE_INFINITY, + Symbol.intern("-Inf"), Double.NEGATIVE_INFINITY, + Symbol.intern("NaN"), Double.NaN); + + public Object invoke(Object reader, Object quote, Object opts) { + PushbackReader r = (PushbackReader) reader; + Object o = read(r, true, null, true, opts); + + if (!(o instanceof Symbol)) + throw Util.runtimeException("Invalid token: ##" + o); + if (!(specials.containsKey(o))) + throw Util.runtimeException("Unknown symbolic value: ##" + o); + + return specials.valAt(o); + } +} + public static List readDelimitedList(char delim, PushbackReader r, boolean isRecursive, Object opts) { final int firstline = (r instanceof LineNumberingPushbackReader) ? @@ -785,4 +806,3 @@ private Object readTagged(PushbackReader reader, Symbol tag, IPersistentMap opts } } - diff --git a/src/jvm/clojure/lang/LispReader.java b/src/jvm/clojure/lang/LispReader.java index 588dcd63..1a9b1789 100644 --- a/src/jvm/clojure/lang/LispReader.java +++ b/src/jvm/clojure/lang/LispReader.java @@ -107,6 +107,7 @@ public class LispReader{ dispatchMacros['^'] = new MetaReader(); + dispatchMacros['#'] = new SymbolicValueReader(); dispatchMacros['\''] = new VarReader(); dispatchMacros['"'] = new RegexReader(); dispatchMacros['('] = new FnReader(); @@ -728,6 +729,26 @@ public Object invoke(Object reader, Object colon, Object opts, Object pendingFor } } + +public static class SymbolicValueReader extends AFn{ + + static IPersistentMap specials = PersistentHashMap.create(Symbol.intern("Inf"), Double.POSITIVE_INFINITY, + Symbol.intern("-Inf"), Double.NEGATIVE_INFINITY, + Symbol.intern("NaN"), Double.NaN); + + public Object invoke(Object reader, Object quote, Object opts, Object pendingForms) { + PushbackReader r = (PushbackReader) reader; + Object o = read(r, true, null, true, opts, ensurePending(pendingForms)); + + if (!(o instanceof Symbol)) + throw Util.runtimeException("Invalid token: ##" + o); + if (!(specials.containsKey(o))) + throw Util.runtimeException("Unknown symbolic value: ##" + o); + + return specials.valAt(o); + } +} + public static class WrappingReader extends AFn{ final Symbol sym; diff --git a/test/clojure/test_clojure/printer.clj b/test/clojure/test_clojure/printer.clj index dc156187..3d9cc65f 100644 --- a/test/clojure/test_clojure/printer.clj +++ b/test/clojure/test_clojure/printer.clj @@ -140,3 +140,12 @@ (let [date-map (bean (java.util.Date. 0))] (is (= (binding [*print-namespace-maps* true] (pr-str date-map)) (binding [*print-namespace-maps* false] (pr-str date-map)))))) + +(deftest print-symbol-values + (are [s v] (= s (pr-str v)) + "##Inf" Double/POSITIVE_INFINITY + "##-Inf" Double/NEGATIVE_INFINITY + "##NaN" Double/NaN + "##Inf" Float/POSITIVE_INFINITY + "##-Inf" Float/NEGATIVE_INFINITY + "##NaN" Float/NaN)) diff --git a/test/clojure/test_clojure/reader.cljc b/test/clojure/test_clojure/reader.cljc index 2e646733..45083090 100644 --- a/test/clojure/test_clojure/reader.cljc +++ b/test/clojure/test_clojure/reader.cljc @@ -213,6 +213,10 @@ (is (instance? Double -1.0)) (is (instance? Double -1.)) + (is (= Double/POSITIVE_INFINITY ##Inf)) + (is (= Double/NEGATIVE_INFINITY ##-Inf)) + (is (and (instance? Double ##NaN) (.isNaN ##NaN))) + ; Read BigDecimal (is (instance? BigDecimal 9223372036854775808M)) (is (instance? BigDecimal -9223372036854775809M)) @@ -744,4 +748,10 @@ (deftest namespaced-map-edn (is (= {1 1, :a/b 2, :b/c 3, :d 4} (edn/read-string "#:a{1 1, :b 2, :b/c 3, :_/d 4}") - (edn/read-string "#:a {1 1, :b 2, :b/c 3, :_/d 4}")))) \ No newline at end of file + (edn/read-string "#:a {1 1, :b 2, :b/c 3, :_/d 4}")))) + +(deftest invalid-symbol-value + (is (thrown-with-msg? Exception #"Invalid token" (read-string "##5"))) + (is (thrown-with-msg? Exception #"Invalid token" (edn/read-string "##5"))) + (is (thrown-with-msg? Exception #"Unknown symbolic value" (read-string "##Foo"))) + (is (thrown-with-msg? Exception #"Unknown symbolic value" (edn/read-string "##Foo")))) From 7dbda4fb3caa3f46d4089cbbb766eb3b1f31c252 Mon Sep 17 00:00:00 2001 From: Chad Taylor Date: Sun, 9 Feb 2014 23:10:36 -0600 Subject: [PATCH 214/246] CLJ-1358 - fix doc to expand special cases Signed-off-by: Stuart Halloway --- src/clj/clojure/repl.clj | 2 +- test/clojure/test_clojure/repl.clj | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/repl.clj b/src/clj/clojure/repl.clj index 08523822..c796df3e 100644 --- a/src/clj/clojure/repl.clj +++ b/src/clj/clojure/repl.clj @@ -135,7 +135,7 @@ itself (not its value) is returned. The reader macro #'x expands to (var x)."}}) {:added "1.0"} [name] (if-let [special-name ('{& fn catch try finally try} name)] - (#'print-doc (#'special-doc special-name)) + `(#'print-doc (#'special-doc '~special-name)) (cond (special-doc-map name) `(#'print-doc (#'special-doc '~name)) (keyword? name) `(#'print-doc {:spec '~name :doc '~(spec/describe name)}) diff --git a/test/clojure/test_clojure/repl.clj b/test/clojure/test_clojure/repl.clj index 17bd0842..c7a0c41b 100644 --- a/test/clojure/test_clojure/repl.clj +++ b/test/clojure/test_clojure/repl.clj @@ -8,7 +8,9 @@ (deftest test-doc (testing "with namespaces" (is (= "clojure.pprint" - (second (str/split-lines (with-out-str (doc clojure.pprint)))))))) + (second (str/split-lines (with-out-str (doc clojure.pprint))))))) + (testing "with special cases" + (is (= (with-out-str (doc catch)) (with-out-str (doc try)))))) (deftest test-source (is (= "(defn foo [])" (source-fn 'clojure.test-clojure.repl.example/foo))) From 9fdbd8cd56524911d120e4631cc53c572ebdd33d Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Wed, 6 Sep 2017 12:29:45 -0500 Subject: [PATCH 215/246] CLJ-1454 New atom fns to return [old new] Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 17 +++++++ src/jvm/clojure/lang/Atom.java | 72 ++++++++++++++++++++++++++++- src/jvm/clojure/lang/IAtom2.java | 23 +++++++++ test/clojure/test_clojure/atoms.clj | 24 ++++++++++ 4 files changed, 135 insertions(+), 1 deletion(-) create mode 100644 src/jvm/clojure/lang/IAtom2.java diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 0b7d15c4..421fdc5d 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -2351,6 +2351,17 @@ ([^clojure.lang.IAtom atom f x y] (.swap atom f x y)) ([^clojure.lang.IAtom atom f x y & args] (.swap atom f x y args))) +(defn swap-vals! + "Atomically swaps the value of atom to be: + (apply f current-value-of-atom args). Note that f may be called + multiple times, and thus should be free of side effects. + Returns [old new], the value of the atom before and after the swap." + {:added "1.9"} + (^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f] (.swapVals atom f)) + (^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f x] (.swapVals atom f x)) + (^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f x y] (.swapVals atom f x y)) + (^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f x y & args] (.swapVals atom f x y args))) + (defn compare-and-set! "Atomically sets the value of atom to newval if and only if the current value of the atom is identical to oldval. Returns true if @@ -2366,6 +2377,12 @@ :static true} [^clojure.lang.IAtom atom newval] (.reset atom newval)) +(defn reset-vals! + "Sets the value of atom to newval. Returns [old new], the value of the + atom before and after the reset." + {:added "1.9"} + ^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom newval] (.resetVals atom newval)) + (defn set-validator! "Sets the validator-fn for a var/ref/agent/atom. validator-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended diff --git a/src/jvm/clojure/lang/Atom.java b/src/jvm/clojure/lang/Atom.java index a964c494..127611c5 100644 --- a/src/jvm/clojure/lang/Atom.java +++ b/src/jvm/clojure/lang/Atom.java @@ -14,7 +14,7 @@ import java.util.concurrent.atomic.AtomicReference; -final public class Atom extends ARef implements IAtom{ +final public class Atom extends ARef implements IAtom2{ final AtomicReference state; public Atom(Object state){ @@ -86,6 +86,62 @@ public Object swap(IFn f, Object x, Object y, ISeq args) { } } +public IPersistentVector swapVals(IFn f) { + for(; ;) + { + Object oldv = deref(); + Object newv = f.invoke(oldv); + validate(newv); + if(state.compareAndSet(oldv, newv)) + { + notifyWatches(oldv, newv); + return LazilyPersistentVector.createOwning(oldv, newv); + } + } +} + +public IPersistentVector swapVals(IFn f, Object arg) { + for(; ;) + { + Object oldv = deref(); + Object newv = f.invoke(oldv, arg); + validate(newv); + if(state.compareAndSet(oldv, newv)) + { + notifyWatches(oldv, newv); + return LazilyPersistentVector.createOwning(oldv, newv); + } + } +} + +public IPersistentVector swapVals(IFn f, Object arg1, Object arg2) { + for(; ;) + { + Object oldv = deref(); + Object newv = f.invoke(oldv, arg1, arg2); + validate(newv); + if(state.compareAndSet(oldv, newv)) + { + notifyWatches(oldv, newv); + return LazilyPersistentVector.createOwning(oldv, newv); + } + } +} + +public IPersistentVector swapVals(IFn f, Object x, Object y, ISeq args) { + for(; ;) + { + Object oldv = deref(); + Object newv = f.applyTo(RT.listStar(oldv, x, y, args)); + validate(newv); + if(state.compareAndSet(oldv, newv)) + { + notifyWatches(oldv, newv); + return LazilyPersistentVector.createOwning(oldv, newv); + } + } +} + public boolean compareAndSet(Object oldv, Object newv){ validate(newv); boolean ret = state.compareAndSet(oldv, newv); @@ -101,4 +157,18 @@ public Object reset(Object newval){ notifyWatches(oldval, newval); return newval; } + +public IPersistentVector resetVals(Object newv){ + validate(newv); + for(; ;) + { + Object oldv = deref(); + if(state.compareAndSet(oldv, newv)) + { + notifyWatches(oldv, newv); + return LazilyPersistentVector.createOwning(oldv, newv); + } + } +} + } diff --git a/src/jvm/clojure/lang/IAtom2.java b/src/jvm/clojure/lang/IAtom2.java new file mode 100644 index 00000000..ab7c0f4b --- /dev/null +++ b/src/jvm/clojure/lang/IAtom2.java @@ -0,0 +1,23 @@ +/** + * Copyright (c) Rich Hickey. 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. + **/ + +package clojure.lang; + +public interface IAtom2 extends IAtom { +IPersistentVector swapVals(IFn f); + +IPersistentVector swapVals(IFn f, Object arg); + +IPersistentVector swapVals(IFn f, Object arg1, Object arg2); + +IPersistentVector swapVals(IFn f, Object x, Object y, ISeq args); + +IPersistentVector resetVals(Object newv); +} diff --git a/test/clojure/test_clojure/atoms.clj b/test/clojure/test_clojure/atoms.clj index 672a1487..f9ecadcc 100644 --- a/test/clojure/test_clojure/atoms.clj +++ b/test/clojure/test_clojure/atoms.clj @@ -18,3 +18,27 @@ ; swap! reset! ; compare-and-set! +(deftest swap-vals-returns-old-value + (let [a (atom 0)] + (is (= [0 1] (swap-vals! a inc))) + (is (= [1 2] (swap-vals! a inc))) + (is (= 2 @a)))) + +(deftest deref-swap-arities + (binding [*warn-on-reflection* true] + (let [a (atom 0)] + (is (= [0 1] (swap-vals! a + 1))) + (is (= [1 3] (swap-vals! a + 1 1))) + (is (= [3 6] (swap-vals! a + 1 1 1))) + (is (= [6 10] (swap-vals! a + 1 1 1 1))) + (is (= 10 @a))))) + +(deftest deref-reset-returns-old-value + (let [a (atom 0)] + (is (= [0 :b] (reset-vals! a :b))) + (is (= [:b 45M] (reset-vals! a 45M))) + (is (= 45M @a)))) + +(deftest reset-on-deref-reset-equality + (let [a (atom :usual-value)] + (is (= :usual-value (reset! a (first (reset-vals! a :almost-never-seen-value))))))) From 31ec81ad3c98cc02be32258ee48a94cce129c00c Mon Sep 17 00:00:00 2001 From: Johan Mena Date: Wed, 6 May 2015 09:59:14 -0500 Subject: [PATCH 216/246] CLJ-1705 - update test to desired behavior Signed-off-by: Stuart Halloway --- test/clojure/test_clojure/vectors.clj | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/clojure/test_clojure/vectors.clj b/test/clojure/test_clojure/vectors.clj index 232b2c93..0bea3ff4 100644 --- a/test/clojure/test_clojure/vectors.clj +++ b/test/clojure/test_clojure/vectors.clj @@ -322,10 +322,11 @@ (vector-of :double) (vector-of :char)) (testing "with invalid type argument" - (are [x] (thrown? NullPointerException x) + (are [x] (thrown? IllegalArgumentException x) (vector-of nil) (vector-of Float/TYPE) (vector-of 'int) + (vector-of :integer) (vector-of "")))) (testing "vector-like (vector-of :type x1 x2 x3 … xn)" (are [vec gvec] (and (instance? clojure.core.Vec gvec) From b0b084b10e4ed91188bba409ae80f1159fa1cfd5 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Wed, 6 May 2015 10:00:07 -0500 Subject: [PATCH 217/246] CLJ-1705 - vector-of throws IllegalArgEx if type not appropriate Signed-off-by: Stuart Halloway --- src/clj/clojure/gvec.clj | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/clj/clojure/gvec.clj b/src/clj/clojure/gvec.clj index b60f9a48..3c400737 100644 --- a/src/clj/clojure/gvec.clj +++ b/src/clj/clojure/gvec.clj @@ -475,7 +475,13 @@ :char (mk-am char) :boolean (mk-am boolean)}) -(defn vector-of +(defmacro ^:private ams-check [t] + `(let [am# (ams ~t)] + (if am# + am# + (throw (IllegalArgumentException. (str "Unrecognized type " ~t)))))) + +(defn vector-of "Creates a new vector of a single primitive type t, where t is one of :int :long :float :double :byte :short :char or :boolean. The resulting vector complies with the interface of vectors in general, @@ -485,28 +491,28 @@ {:added "1.2" :arglists '([t] [t & elements])} ([t] - (let [am ^clojure.core.ArrayManager (ams t)] + (let [^clojure.core.ArrayManager am (ams-check t)] (Vec. am 0 5 EMPTY-NODE (.array am 0) nil))) ([t x1] - (let [am ^clojure.core.ArrayManager (ams t) + (let [^clojure.core.ArrayManager am (ams-check t) arr (.array am 1)] (.aset am arr 0 x1) (Vec. am 1 5 EMPTY-NODE arr nil))) ([t x1 x2] - (let [am ^clojure.core.ArrayManager (ams t) + (let [^clojure.core.ArrayManager am (ams-check t) arr (.array am 2)] (.aset am arr 0 x1) (.aset am arr 1 x2) (Vec. am 2 5 EMPTY-NODE arr nil))) ([t x1 x2 x3] - (let [am ^clojure.core.ArrayManager (ams t) + (let [^clojure.core.ArrayManager am (ams-check t) arr (.array am 3)] (.aset am arr 0 x1) (.aset am arr 1 x2) (.aset am arr 2 x3) (Vec. am 3 5 EMPTY-NODE arr nil))) ([t x1 x2 x3 x4] - (let [am ^clojure.core.ArrayManager (ams t) + (let [^clojure.core.ArrayManager am (ams-check t) arr (.array am 4)] (.aset am arr 0 x1) (.aset am arr 1 x2) From 4cf6ca7b900c64bfd2c6a33b6b130eef6696b130 Mon Sep 17 00:00:00 2001 From: Chouser Date: Tue, 20 Jun 2017 12:19:29 -0400 Subject: [PATCH 218/246] CLJ-2184 propagate metadata in doto forms Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 421fdc5d..d8e35873 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -3831,9 +3831,11 @@ (let [gx (gensym)] `(let [~gx ~x] ~@(map (fn [f] - (if (seq? f) - `(~(first f) ~gx ~@(next f)) - `(~f ~gx))) + (with-meta + (if (seq? f) + `(~(first f) ~gx ~@(next f)) + `(~f ~gx)) + (meta f))) forms) ~gx))) From 861d48ea761418fcb59dc4eb1c63bd29c2f35231 Mon Sep 17 00:00:00 2001 From: Michael Blume Date: Fri, 23 Jun 2017 15:36:13 -0700 Subject: [PATCH 219/246] CLJ-2188 Mark slurp as returning String Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index d8e35873..71b75256 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -6857,7 +6857,8 @@ (defn slurp "Opens a reader on f and reads all its contents, returning a string. See clojure.java.io/reader for a complete list of supported arguments." - {:added "1.0"} + {:added "1.0" + :tag String} ([f & opts] (let [opts (normalize-slurp-opts opts) sw (java.io.StringWriter.)] From 6ab6d5001ecdc71e2eda4a4608f353a30ee99e96 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Thu, 7 Sep 2017 16:26:47 -0500 Subject: [PATCH 220/246] [maven-release-plugin] prepare release clojure-1.9.0-alpha20 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 3b52bbdb..a4991ad8 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-alpha20 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-alpha20 From 43540be97668ed453cad74e18f434c3e8bd5d638 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Thu, 7 Sep 2017 16:26:47 -0500 Subject: [PATCH 221/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index a4991ad8..3b52bbdb 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha20 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-alpha20 + HEAD From ecd15907082d31511f1ed0a249bc48fa532311f4 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 8 Sep 2017 12:51:00 -0500 Subject: [PATCH 222/246] CLJ-2077 conditionally load clojure.instant Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 71b75256..0ad5dd67 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -6688,7 +6688,15 @@ (load "core_deftype") (load "core/protocols") (load "gvec") -(load "instant") + +(defmacro ^:private when-class [class-name & body] + `(try + (Class/forName ^String ~class-name) + ~@body + (catch ClassNotFoundException _#))) + +(when-class "java.sql.Timestamp" + (load "instant")) (defprotocol Inst (inst-ms* [inst])) @@ -6698,10 +6706,8 @@ (inst-ms* [inst] (.getTime ^java.util.Date inst))) ;; conditionally extend to Instant on Java 8+ -(try - (Class/forName "java.time.Instant") - (load "core_instant18") - (catch ClassNotFoundException cnfe)) +(when-class "java.time.Instant" + (load "core_instant18")) (defn inst-ms "Return the number of milliseconds since January 1, 1970, 00:00:00 GMT" @@ -7665,8 +7671,10 @@ (def ^{:added "1.4"} default-data-readers "Default map of data reader functions provided by Clojure. May be overridden by binding *data-readers*." - {'inst #'clojure.instant/read-instant-date - 'uuid #'clojure.uuid/default-uuid-reader}) + (merge + {'uuid #'clojure.uuid/default-uuid-reader} + (when-class "java.sql.Timestamp" + {'inst #'clojure.instant/read-instant-date}))) (def ^{:added "1.4" :dynamic true} *data-readers* "Map from reader tag symbols to data reader Vars. From 396fb64b421c3b02bf1ffc4f87e7ea5bffa51e61 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 18 Sep 2017 10:27:49 -0500 Subject: [PATCH 223/246] Change log updates for 1.9.0-beta1 Signed-off-by: Stuart Halloway --- changes.md | 174 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 174 insertions(+) diff --git a/changes.md b/changes.md index 61b2eaf8..61a57dd7 100644 --- a/changes.md +++ b/changes.md @@ -1,5 +1,179 @@ +# Changes to Clojure in Version 1.9 + +## 1 New and Improved Features + +### 1.1 spec + +spec is a new core library for describing, validating, and testing the structure of data and functions. + +For more information, see: + +* [About spec](https://clojure.org/about/spec) +* [spec Guide](https://clojure.org/guides/spec) + +Note that spec is in alpha state and API compatibility is not guaranteed. Also, spec and the specs for the Clojure core API are distributed as external libraries that must be included to use Clojure. + +### 1.2 Support for working with maps with qualified keys + +Several enhancements have been made to add support for working with maps with qualified keys: + +* Map namespace syntax - specify the default namespace context for the keys (or symbols) in a map once - `#:car{:make "Jeep" :model "Wrangler"}`. For more information see https://clojure.org/reference/reader#_maps ([CLJ-1910](http://dev.clojure.org/jira/browse/CLJ-1910)) +* Destructuring support - namespaced map keys can now specified once as a namespace for :keys or :syms. For more information see https://clojure.org/reference/special_forms#_map_binding_destructuring ([CLJ-1919](http://dev.clojure.org/jira/browse/CLJ-1919)) +* `*print-namespace-maps*` - by default maps will not print with the map namespace syntax except in the clojure.main repl. This dynamic var is a flag to allow you to control whether the namespace map syntax is used. + +### 1.3 New predicates + +Specs rely heavily on predicates and many new type and value oriented predicates have been added to clojure.core: + +* `boolean?` +* `int?` `pos-int?` `neg-int?` `nat-int?` +* `double?` `bigdec?` +* `ident?` `simple-ident?` `qualified-ident?` +* `simple-symbol?` `qualified-symbol?` +* `simple-keyword?` `qualified-keyword?` +* `bytes?` (for `byte[]`) +* `indexed?` +* `uuid?` `uri?` +* `seqable?` +* `any?` + +### 1.4 More support for instants + +More support has been added for the notion of instants in time: + +* Added a new protocol `Inst` for instant types +* `Inst` is extended for `java.util.Date` +* `Inst` is optionally extended for `java.time.Instant` in Java 1.8+ +* New functions that work for instants: `inst?`, `inst-ms` + +### 1.5 Other new core functions + +These are some other new functions in clojure.core: + +* `bounded-count` - a count that avoids realizing the entire collection beyond a bound +* `swap-vals!` and `reset-vals!` - new atom functions that return both the old and new values ([CLJ-1454](http://dev.clojure.org/jira/browse/CLJ-1454)) +* `halt-when` - new transducer that ends transduction when pred is satisfied + +### 1.6 Other reader enhancements + +* Can now bind `*reader-resolver*` to an impl of LispReader$Resolver to control the reader’s use of namespace interactions when resolving autoresolved keywords and maps. +* Add new ## reader macro for symbolic values, and read/print support for double vals ##Inf, ##-Inf, ##NaN ([CLJ-1074](http://dev.clojure.org/jira/browse/CLJ-1074)) + +## 2 Enhancements + +### 2.1 Spec syntax checking + +If a macro has a spec defined via fdef, that spec will be checked at compile time. Specs have been defined for many clojure.core macros and errors will be reported for these based on the specs at compile time. + +### 2.2 Documentation + +* `doc` will now report specs for functions with specs defined using `fdef` +* `doc` can now be invoked with a fully-qualified keyword representing a spec name + +### 2.3 Performance + +* Improved update-in performance +* Optimized seq & destructuring +* [CLJ-2210](http://dev.clojure.org/jira/browse/CLJ-2210) + Cache class derivation in compiler to improve compiler performance +* [CLJ-2188](http://dev.clojure.org/jira/browse/CLJ-2188) + `slurp` - mark return type as String +* [CLJ-2070](http://dev.clojure.org/jira/browse/CLJ-2070) + `clojure.core/delay` - improve performance +* [CLJ-1917](http://dev.clojure.org/jira/browse/CLJ-1917) + Reducing seq over string should call String/length outside of loop +* [CLJ-1901](http://dev.clojure.org/jira/browse/CLJ-1901) + `amap` - should call alength only once +* [CLJ-1224](http://dev.clojure.org/jira/browse/CLJ-1935) + Record instances now cache hasheq and hashCode like maps +* [CLJ-99](http://dev.clojure.org/jira/browse/CLJ-99) + `min-key` and `max-key` - evaluate k on each arg at most once + +### 2.4 Other enhancements + +* Added Var serialization for identity, not value +* `into` now has a 0-arity (returns `[]`) and 1-arity (returns the coll that's passed) +* [CLJ-2184](http://dev.clojure.org/jira/browse/CLJ-2184) + Propagate meta in doto forms to improve error reporting +* [CLJ-1744](http://dev.clojure.org/jira/browse/CLJ-1744) + Clear unused locals, which can prevent memory leaks in some cases +* [CLJ-1673](http://dev.clojure.org/jira/browse/CLJ-1673) + `clojure.repl/dir-fn` now works on namespace aliases +* [CLJ-1423](http://dev.clojure.org/jira/browse/CLJ-1423) + Allow vars to be invoked with infinite arglists (also, faster) + +## 3 Fixes + +### 3.1 Security + +* [CLJ-2204](http://dev.clojure.org/jira/browse/CLJ-2204) + Disable serialization of proxy classes to avoid potential issue when deserializing + +### 3.2 Docs + +* [CLJ-2170](http://dev.clojure.org/jira/browse/CLJ-2170) + fix improperly located docstrings +* [CLJ-2156](http://dev.clojure.org/jira/browse/CLJ-2156) + `clojure.java.io/copy` - doc char[] support +* [CLJ-2104](http://dev.clojure.org/jira/browse/CLJ-2104) + `clojure.pprint` docstring - fix typo +* [CLJ-2051](http://dev.clojure.org/jira/browse/CLJ-2051) + `clojure.instant/validated` docstring - fix typo +* [CLJ-2039](http://dev.clojure.org/jira/browse/CLJ-2039) + `deftype` - fix typo in docstring +* [CLJ-2028](http://dev.clojure.org/jira/browse/CLJ-2028) + `filter`, `filterv`, `remove`, `take-while` - fix docstrings +* [CLJ-1918](http://dev.clojure.org/jira/browse/CLJ-1918) + `await` - improve docstring re `shutdown-agents` +* [CLJ-1873](http://dev.clojure.org/jira/browse/CLJ-1873) + `require`, `*data-readers*` - add .cljc files to docstrings +* [CLJ-1859](http://dev.clojure.org/jira/browse/CLJ-1859) + `zero?`, `pos?`, `neg?` - fix docstrings +* [CLJ-1837](http://dev.clojure.org/jira/browse/CLJ-1837) + `index-of`, `last-index-of` - clarify docstrings +* [CLJ-1826](http://dev.clojure.org/jira/browse/CLJ-1826) + `drop-last` - fix docstring +* [CLJ-1159](http://dev.clojure.org/jira/browse/CLJ-1159) + `clojure.java.io/delete-file` - improve docstring + +### 3.3 Other fixes + +* `clojure.core/Throwable->map` formerly returned `StackTraceElement`s which were later handled by the printer. Now the StackTraceElements are converted to data such that the return value is pure Clojure data, as intended. +* [CLJ-2091](http://dev.clojure.org/jira/browse/CLJ-2091) + `clojure.lang.APersistentVector#hashCode` is not thread-safe +* [CLJ-2077](http://dev.clojure.org/jira/browse/CLJ-2077) + Clojure can't be loaded from the boot classpath under java 9 +* [CLJ-2048](http://dev.clojure.org/jira/browse/CLJ-2048) + Specify type to avoid ClassCastException when stack trace is elided by JVM +* [CLJ-1914](http://dev.clojure.org/jira/browse/CLJ-1914) + Fixed race condition in concurrent `range` realization +* [CLJ-1887](http://dev.clojure.org/jira/browse/CLJ-1887) + `IPersistentVector.length()` - implement missing method +* [CLJ-1870](http://dev.clojure.org/jira/browse/CLJ-1870) + Fixed reloading a `defmulti` removes metadata on the var +* [CLJ-1860](http://dev.clojure.org/jira/browse/CLJ-1860) + Make -0.0 hash consistent with 0.0 +* [CLJ-1841](http://dev.clojure.org/jira/browse/CLJ-1841) + `bean` - iterator was broken +* [CLJ-1793](http://dev.clojure.org/jira/browse/CLJ-1793) + Clear 'this' before calls in tail position +* [CLJ-1790](http://dev.clojure.org/jira/browse/CLJ-1790) + Fixed error extending protocols to Java arrays +* [CLJ-1714](http://dev.clojure.org/jira/browse/CLJ-1714) + using a class in a type hint shouldn’t load the class +* [CLJ-1705](http://dev.clojure.org/jira/browse/CLJ-1705) + `vector-of` - fix NullPointerException if given unrecognized type +* [CLJ-1398](http://dev.clojure.org/jira/browse/CLJ-1398) + `clojure.java.javadoc/javadoc` - update doc urls +* [CLJ-1371](http://dev.clojure.org/jira/browse/CLJ-1371) + `Numbers.divide(Object, Object)` - add checks for NaN +* [CLJ-1358](http://dev.clojure.org/jira/browse/CLJ-1358) + `doc` - does not expand special cases properly (try, catch) +* [CLJ-1242](http://dev.clojure.org/jira/browse/CLJ-1242) + equals doesn't throw on sorted collections + # Changes to Clojure in Version 1.8 ## 1 New and Improved Features From 528a7c672675caba37aaf9d967d6ead03d401b71 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Mon, 18 Sep 2017 12:13:32 -0500 Subject: [PATCH 224/246] [maven-release-plugin] prepare release clojure-1.9.0-beta1 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 3b52bbdb..2ae7e8fe 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-beta1 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-beta1 From bdb32612536a9a00f0da5085de47f164010165c1 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Mon, 18 Sep 2017 12:13:32 -0500 Subject: [PATCH 225/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 2ae7e8fe..3b52bbdb 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-beta1 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-beta1 + HEAD From e29a3e694a1a2df3f705f84dcd8a7be2d7aa7a08 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Marczyk?= Date: Wed, 4 Oct 2017 22:04:45 +0200 Subject: [PATCH 226/246] CLJ-2247: restore last match semantics of {min,max}-key The CLJ-99 patch (d10a9d36ef91e1f329528890d6fc70471d78485d) makes two changes to the behaviour of {min,max}-key: 1. it ensures that the key function is only called once on each argument; 2. it causes both functions to return the first match, whereas previously they returned the last one. This preserves 1. and reverts 2. Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 4 ++-- test/clojure/test_clojure/other_functions.clj | 5 ++++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 0ad5dd67..6b024999 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -4944,7 +4944,7 @@ (if more (let [w (first more) kw (k w)] - (if (> kw kv) + (if (>= kw kv) (recur w kw (next more)) (recur v kv (next more)))) v))))) @@ -4962,7 +4962,7 @@ (if more (let [w (first more) kw (k w)] - (if (< kw kv) + (if (<= kw kv) (recur w kw (next more)) (recur v kv (next more)))) v))))) diff --git a/test/clojure/test_clojure/other_functions.clj b/test/clojure/test_clojure/other_functions.clj index 94ce9d70..958df5ec 100644 --- a/test/clojure/test_clojure/other_functions.clj +++ b/test/clojure/test_clojure/other_functions.clj @@ -335,7 +335,10 @@ count ["longest" "a" "xy" "foo" "bar"] "a" "longest" - [5 10 15 20 25] 25 5 #(if (neg? %) (- %) %) [-2 -1 0 1 2 3 4] 0 4 - {nil 1 false -1 true 0} [true true false nil] false nil)) + {nil 1 false -1 true 0} [true true false nil] false nil) + (are [f k coll expected] (= expected (apply f k coll)) + min-key :x [{:x 1000} {:x 1001} {:x 1002} {:x 1000 :second true}] {:x 1000 :second true} + max-key :x [{:x 1000} {:x 999} {:x 998} {:x 1000 :second true}] {:x 1000 :second true})) ; Printing From 5481362e470e717f42661a66748b53c07bc6eeec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Marczyk?= Date: Thu, 5 Oct 2017 09:52:02 +0200 Subject: [PATCH 227/246] CLJ-2247: document "last match" semantics of {min,max}-key Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 6b024999..89b20a9b 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -4932,7 +4932,9 @@ (^String [^String s start end] (. s (substring start end)))) (defn max-key - "Returns the x for which (k x), a number, is greatest." + "Returns the x for which (k x), a number, is greatest. + + If there are multiple such xs, the last one is returned." {:added "1.0" :static true} ([k x] x) @@ -4950,7 +4952,9 @@ v))))) (defn min-key - "Returns the x for which (k x), a number, is least." + "Returns the x for which (k x), a number, is least. + + If there are multiple such xs, the last one is returned." {:added "1.0" :static true} ([k x] x) From 9a478cf9debc3c562f7623e8978337f28245075a Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 6 Oct 2017 14:12:11 -0500 Subject: [PATCH 228/246] update spec.alpha version and remove unneeded dep exclusions Signed-off-by: Stuart Halloway --- pom.xml | 18 +----------------- 1 file changed, 1 insertion(+), 17 deletions(-) diff --git a/pom.xml b/pom.xml index 3b52bbdb..8202e2c2 100644 --- a/pom.xml +++ b/pom.xml @@ -41,28 +41,12 @@ org.clojure spec.alpha - 0.1.123 - - - org.clojure - clojure - - + 0.1.134 org.clojure core.specs.alpha 0.1.24 - - - org.clojure - clojure - - - org.clojure - spec.alpha - - org.codehaus.jsr166-mirror From 128017179e811c09d4785421b1cb6479b0f6aa39 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Fri, 6 Oct 2017 16:12:14 -0400 Subject: [PATCH 229/246] CLJ-700 expand RT.getFrom() .contains() .find() to handle transient types --- src/jvm/clojure/lang/ATransientMap.java | 13 ++++++++- .../clojure/lang/ITransientAssociative2.java | 16 +++++++++++ src/jvm/clojure/lang/PersistentVector.java | 14 +++++++++- src/jvm/clojure/lang/RT.java | 20 +++++++++++++- test/clojure/test_clojure/transients.clj | 27 +++++++++++++++++++ 5 files changed, 87 insertions(+), 3 deletions(-) create mode 100644 src/jvm/clojure/lang/ITransientAssociative2.java diff --git a/src/jvm/clojure/lang/ATransientMap.java b/src/jvm/clojure/lang/ATransientMap.java index 59199a87..8cfcf9bd 100644 --- a/src/jvm/clojure/lang/ATransientMap.java +++ b/src/jvm/clojure/lang/ATransientMap.java @@ -14,7 +14,7 @@ import clojure.lang.PersistentHashMap.INode; -public abstract class ATransientMap extends AFn implements ITransientMap { +public abstract class ATransientMap extends AFn implements ITransientMap, ITransientAssociative2 { abstract void ensureEditable(); abstract ITransientMap doAssoc(Object key, Object val); abstract ITransientMap doWithout(Object key); @@ -79,6 +79,17 @@ public final Object valAt(Object key, Object notFound) { return doValAt(key, notFound); } + private static final Object NOT_FOUND = new Object(); + public final boolean containsKey(Object key){ + return valAt(key, NOT_FOUND) != NOT_FOUND; + } + public final IMapEntry entryAt(Object key){ + Object v = valAt(key, NOT_FOUND); + if(v != NOT_FOUND) + return MapEntry.create(key, v); + return null; + } + public final int count() { ensureEditable(); return doCount(); diff --git a/src/jvm/clojure/lang/ITransientAssociative2.java b/src/jvm/clojure/lang/ITransientAssociative2.java new file mode 100644 index 00000000..6affcf96 --- /dev/null +++ b/src/jvm/clojure/lang/ITransientAssociative2.java @@ -0,0 +1,16 @@ +/** + * Copyright (c) Rich Hickey. 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. + **/ + +package clojure.lang; + +public interface ITransientAssociative2 extends ITransientAssociative { + boolean containsKey(Object key); + IMapEntry entryAt(Object key); +} diff --git a/src/jvm/clojure/lang/PersistentVector.java b/src/jvm/clojure/lang/PersistentVector.java index 3f6de59a..459dfb57 100644 --- a/src/jvm/clojure/lang/PersistentVector.java +++ b/src/jvm/clojure/lang/PersistentVector.java @@ -515,7 +515,7 @@ else if(subidx == 0) } } -static final class TransientVector extends AFn implements ITransientVector, Counted{ +static final class TransientVector extends AFn implements ITransientVector, ITransientAssociative2, Counted{ volatile int cnt; volatile int shift; volatile Node root; @@ -678,6 +678,18 @@ public Object valAt(Object key, Object notFound){ return notFound; } + private static final Object NOT_FOUND = new Object(); + public final boolean containsKey(Object key){ + return valAt(key, NOT_FOUND) != NOT_FOUND; + } + + public final IMapEntry entryAt(Object key){ + Object v = valAt(key, NOT_FOUND); + if(v != NOT_FOUND) + return MapEntry.create(key, v); + return null; + } + public Object invoke(Object arg1) { //note - relies on ensureEditable in nth if(Util.isInteger(arg1)) diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index 3c835e3f..0c1253ae 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -771,6 +771,10 @@ else if(key instanceof Number && (coll instanceof String || coll.getClass().isAr return nth(coll, n); return null; } + else if(coll instanceof ITransientSet) { + ITransientSet set = (ITransientSet) coll; + return set.get(key); + } return null; } @@ -800,6 +804,12 @@ else if(key instanceof Number && (coll instanceof String || coll.getClass().isAr int n = ((Number) key).intValue(); return n >= 0 && n < count(coll) ? nth(coll, n) : notFound; } + else if(coll instanceof ITransientSet) { + ITransientSet set = (ITransientSet) coll; + if(set.contains(key)) + return set.get(key); + return notFound; + } return notFound; } @@ -829,6 +839,10 @@ else if(key instanceof Number && (coll instanceof String || coll.getClass().isAr int n = ((Number) key).intValue(); return n >= 0 && n < count(coll); } + else if(coll instanceof ITransientSet) + return ((ITransientSet)coll).contains(key) ? T : F; + else if(coll instanceof ITransientAssociative2) + return (((ITransientAssociative2)coll).containsKey(key)) ? T : F; throw new IllegalArgumentException("contains? not supported on type: " + coll.getClass().getName()); } @@ -837,12 +851,16 @@ static public Object find(Object coll, Object key){ return null; else if(coll instanceof Associative) return ((Associative) coll).entryAt(key); - else { + else if(coll instanceof Map) { Map m = (Map) coll; if(m.containsKey(key)) return MapEntry.create(key, m.get(key)); return null; } + else if(coll instanceof ITransientAssociative2) { + return ((ITransientAssociative2) coll).entryAt(key); + } + throw new IllegalArgumentException("find not supported on type: " + coll.getClass().getName()); } //takes a seq of key,val,key,val diff --git a/test/clojure/test_clojure/transients.clj b/test/clojure/test_clojure/transients.clj index dcc956e3..f64ba926 100644 --- a/test/clojure/test_clojure/transients.clj +++ b/test/clojure/test_clojure/transients.clj @@ -53,3 +53,30 @@ t2 @(future (conj! t 4)) p (persistent! t2)] (is (= [1 2 3 4] p)))) + +(deftest transient-lookups + (let [tv (transient [1 2 3])] + (is (= 1 (get tv 0))) + (is (= :foo (get tv 4 :foo))) + (is (= true (contains? tv 0))) + (is (= [0 1] (find tv 0))) + (is (= nil (find tv -1)))) + (let [ts (transient #{1 2})] + (is (= true (contains? ts 1))) + (is (= false (contains? ts 99))) + (is (= 1 (get ts 1))) + (is (= nil (get ts 99)))) + (let [tam (transient (array-map :a 1 :b 2))] + (is (= true (contains? tam :a))) + (is (= false (contains? tam :x))) + (is (= 1 (get tam :a))) + (is (= nil (get tam :x))) + (is (= [:a 1] (find tam :a))) + (is (= nil (find tam :x)))) + (let [thm (transient (hash-map :a 1 :b 2))] + (is (= true (contains? thm :a))) + (is (= false (contains? thm :x))) + (is (= 1 (get thm :a))) + (is (= nil (get thm :x))) + (is (= [:a 1] (find thm :a))) + (is (= nil (find thm :x))))) From dab54cb872eb94a36d009ab7c87ce72945e64317 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?David=20B=C3=BCrgin?= Date: Tue, 19 Sep 2017 18:54:25 +0200 Subject: [PATCH 230/246] Update Guava API URL for clojure.java.javadoc Signed-off-by: Stuart Halloway --- src/clj/clojure/java/javadoc.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/clj/clojure/java/javadoc.clj b/src/clj/clojure/java/javadoc.clj index 4eea1ec2..863de75c 100644 --- a/src/clj/clojure/java/javadoc.clj +++ b/src/clj/clojure/java/javadoc.clj @@ -27,7 +27,7 @@ (def ^:dynamic *remote-javadocs* (ref (sorted-map - "com.google.common." "http://docs.guava-libraries.googlecode.com/git/javadoc/" + "com.google.common." "http://google.github.io/guava/releases/23.0/api/docs/" "java." *core-java-api* "javax." *core-java-api* "org.ietf.jgss." *core-java-api* From e064eb850e80be7a7c24e87d386cccf58b4eb89c Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 6 Oct 2017 14:32:07 -0500 Subject: [PATCH 231/246] update changelog for 1.9.0-beta2 Signed-off-by: Stuart Halloway --- changes.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/changes.md b/changes.md index 61a57dd7..72b04075 100644 --- a/changes.md +++ b/changes.md @@ -173,6 +173,8 @@ If a macro has a spec defined via fdef, that spec will be checked at compile tim `doc` - does not expand special cases properly (try, catch) * [CLJ-1242](http://dev.clojure.org/jira/browse/CLJ-1242) equals doesn't throw on sorted collections +* [CLJ-700](http://dev.clojure.org/jira/browse/CLJ-700) + `contains?`, `get`, and `find` broken for transient collections # Changes to Clojure in Version 1.8 From 640c77f9095998c1064dc9b6c5e81601cd1513ba Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Fri, 6 Oct 2017 15:48:59 -0500 Subject: [PATCH 232/246] [maven-release-plugin] prepare release clojure-1.9.0-beta2 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 8202e2c2..02bc36e7 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-beta2 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-beta2 From a8f1c6436a8bfe181b0a00cf9e44845dcbbb63ee Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Fri, 6 Oct 2017 15:48:59 -0500 Subject: [PATCH 233/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 02bc36e7..8202e2c2 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-beta2 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-beta2 + HEAD From 3d9b356306db77946bdf4809baeb660f94cec846 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Tue, 24 Oct 2017 08:43:41 -0500 Subject: [PATCH 234/246] Add clojure.spec.skip-macros system property to disable spec macro checking Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/RT.java | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index 0c1253ae..f4bb9a5b 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -300,7 +300,7 @@ static public void addURL(Object url) throws MalformedURLException{ } public static boolean checkSpecAsserts = Boolean.getBoolean("clojure.spec.check-asserts"); - +public static boolean instrumentMacros = ! Boolean.getBoolean("clojure.spec.skip-macros"); static volatile boolean CHECK_SPECS = false; static{ @@ -339,7 +339,7 @@ public Object invoke(Object arg1) { throw Util.sneakyThrow(e); } - CHECK_SPECS = true; + CHECK_SPECS = RT.instrumentMacros; } static public Keyword keyword(String ns, String name){ From bfaa0c67152736637a2c2593a93ddbb2971b2d66 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Wed, 25 Oct 2017 14:51:40 -0500 Subject: [PATCH 235/246] [maven-release-plugin] prepare release clojure-1.9.0-beta3 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 8202e2c2..4b7bb08e 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-beta3 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-beta3 From 08e1c941eb584f556745ca57fae1e0b313458c2c Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Wed, 25 Oct 2017 14:51:40 -0500 Subject: [PATCH 236/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 4b7bb08e..8202e2c2 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-beta3 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-beta3 + HEAD From b98ba848d04867c5542d50e46429d9c1f2472719 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 30 Oct 2017 10:23:30 -0500 Subject: [PATCH 237/246] CLJ-2259 Remove unnecessary bigdec? predicate added in 1.9 Signed-off-by: Stuart Halloway --- changes.md | 2 +- pom.xml | 2 +- src/clj/clojure/core.clj | 5 ---- test/clojure/test_clojure/predicates.clj | 34 ++++++++++++------------ 4 files changed, 19 insertions(+), 24 deletions(-) diff --git a/changes.md b/changes.md index 72b04075..d387eb5e 100644 --- a/changes.md +++ b/changes.md @@ -29,7 +29,7 @@ Specs rely heavily on predicates and many new type and value oriented predicates * `boolean?` * `int?` `pos-int?` `neg-int?` `nat-int?` -* `double?` `bigdec?` +* `double?` * `ident?` `simple-ident?` `qualified-ident?` * `simple-symbol?` `qualified-symbol?` * `simple-keyword?` `qualified-keyword?` diff --git a/pom.xml b/pom.xml index 8202e2c2..5ea5de98 100644 --- a/pom.xml +++ b/pom.xml @@ -41,7 +41,7 @@ org.clojure spec.alpha - 0.1.134 + 0.1.143 org.clojure diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 89b20a9b..5fe3b1bc 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -1420,11 +1420,6 @@ {:added "1.9"} [x] (instance? Double x)) -(defn bigdec? - "Return true if x is a BigDecimal" - {:added "1.9"} - [x] (instance? java.math.BigDecimal x)) - ;; (defn complement diff --git a/test/clojure/test_clojure/predicates.clj b/test/clojure/test_clojure/predicates.clj index 90681962..7efdc6fe 100644 --- a/test/clojure/test_clojure/predicates.clj +++ b/test/clojure/test_clojure/predicates.clj @@ -147,23 +147,23 @@ barray (byte-array 0) uri (java.net.URI. "http://clojure.org")] [' - [identity int? pos-int? neg-int? nat-int? double? boolean? indexed? seqable? ident? uuid? bigdec? inst? uri? bytes?] - [0 true false false true false false false false false false false false false false] - [1 true true false true false false false false false false false false false false] - [-1 true false true false false false false false false false false false false false] - [1.0 false false false false true false false false false false false false false false] - [true false false false false false true false false false false false false false false] - [[] false false false false false false true true false false false false false false] - [nil false false false false false false false true false false false false false false] - [{} false false false false false false false true false false false false false false] - [:foo false false false false false false false false true false false false false false] - ['foo false false false false false false false false true false false false false false] - [0.0M false false false false false false false false false false true false false false] - [0N false false false false false false false false false false false false false false] - [uuid false false false false false false false false false true false false false false] - [uri false false false false false false false false false false false false true false] - [now false false false false false false false false false false false true false false] - [barray false false false false false false false true false false false false false true]])) + [identity int? pos-int? neg-int? nat-int? double? boolean? indexed? seqable? ident? uuid? decimal? inst? uri? bytes?] + [0 true false false true false false false false false false false false false false] + [1 true true false true false false false false false false false false false false] + [-1 true false true false false false false false false false false false false false] + [1.0 false false false false true false false false false false false false false false] + [true false false false false false true false false false false false false false false] + [[] false false false false false false true true false false false false false false] + [nil false false false false false false false true false false false false false false] + [{} false false false false false false false true false false false false false false] + [:foo false false false false false false false false true false false false false false] + ['foo false false false false false false false false true false false false false false] + [0.0M false false false false false false false false false false true false false false] + [0N false false false false false false false false false false false false false false] + [uuid false false false false false false false false false true false false false false] + [uri false false false false false false false false false false false false true false] + [now false false false false false false false false false false false true false false] + [barray false false false false false false false true false false false false false true]])) (deftest test-preds (let [[preds & rows] pred-val-table] From e7ff2d6c1d27abedf4bd1c5de3557b7bad720763 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 31 Oct 2017 09:05:00 -0500 Subject: [PATCH 238/246] [maven-release-plugin] prepare release clojure-1.9.0-beta4 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 5ea5de98..4865d02e 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-beta4 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-beta4 From 44f6aad12dd6f47c8ab717f7753299ef2a766ce8 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 31 Oct 2017 09:05:00 -0500 Subject: [PATCH 239/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 4865d02e..5ea5de98 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-beta4 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-beta4 + HEAD From e749d85ccc404577d679950788e8820ccb027e73 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 7 Nov 2017 08:36:15 -0600 Subject: [PATCH 240/246] [maven-release-plugin] prepare release clojure-1.9.0-RC1 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index 5ea5de98..d87634b1 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-RC1 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-RC1 From a19c36927598677c32099dabd0fdb9d3097df259 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Tue, 7 Nov 2017 08:36:15 -0600 Subject: [PATCH 241/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index d87634b1..5ea5de98 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-RC1 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-RC1 + HEAD From 7ae47e64c5144464bbd591cad8c5094bd52e3195 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 27 Nov 2017 13:56:22 -0600 Subject: [PATCH 242/246] Local build with deps included Signed-off-by: Stuart Halloway --- build.xml | 7 +++++++ pom.xml | 41 +++++++++++++++++++++++++++++++++++++++++ readme.txt | 29 ++++++++++++++++------------- 3 files changed, 64 insertions(+), 13 deletions(-) diff --git a/build.xml b/build.xml index 07628534..35f4b28f 100644 --- a/build.xml +++ b/build.xml @@ -194,4 +194,11 @@ + + + + + + + diff --git a/pom.xml b/pom.xml index 5ea5de98..d5997042 100644 --- a/pom.xml +++ b/pom.xml @@ -315,5 +315,46 @@ + + local + + + org.clojure + test.check + 0.9.0 + + + org.clojure + clojure + + + + + + + + org.apache.maven.plugins + maven-shade-plugin + 3.1.0 + + + package + + shade + + + + + clojure.main + + + clojure.jar + + + + + + + diff --git a/readme.txt b/readme.txt index 4871d0f1..70ee0758 100644 --- a/readme.txt +++ b/readme.txt @@ -7,29 +7,32 @@ * the terms of this license. * You must not remove this notice, or any other, from this software. -Docs: http://clojure.org +Docs: https://clojure.org Feedback: http://groups.google.com/group/clojure -Getting Started: http://dev.clojure.org/display/doc/Getting+Started +Getting Started: https://clojure.org/guides/getting_started -To run: java -cp clojure-${VERSION}.jar clojure.main - -To build locally with Ant: +To build and run locally with Ant: One-time setup: ./antsetup.sh - To build: ant + To build: ant local + To run: java -jar clojure.jar -Maven 2 build instructions: +To build locally with Maven: - To build: mvn package - The built JARs will be in target/ + To build (output JARs in target/): + mvn package - To build without testing: mvn package -Dmaven.test.skip=true + To build without testing: + mvn package -Dmaven.test.skip=true - To build and install in local Maven repository: mvn install + To build and install in local Maven repository: + mvn install - To build a ZIP distribution: mvn package -Pdistribution - The built .zip will be in target/ + To build a standalone jar with dependencies included: + mvn -Plocal -Dmaven.test.skip=true package + To run with the standalone jar: + java -jar clojure.jar -------------------------------------------------------------------------- This program uses the ASM bytecode engineering library which is distributed From d7e04247af8cbfa34fe4795ebd0ee25de2e83dca Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Mon, 27 Nov 2017 15:22:08 -0600 Subject: [PATCH 243/246] [maven-release-plugin] prepare release clojure-1.9.0-RC2 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index d5997042..d22d69fc 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0-RC2 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0-RC2 From 0592567e000e0f986834abe661a0a15d3a57178c Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Mon, 27 Nov 2017 15:22:08 -0600 Subject: [PATCH 244/246] [maven-release-plugin] prepare for next development iteration --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index d22d69fc..d5997042 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-RC2 + 1.9.0-master-SNAPSHOT http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-RC2 + HEAD From 841fa60b41bc74367fb16ec65d025ea5bde7a617 Mon Sep 17 00:00:00 2001 From: "Hudson @ build.clojure.org" Date: Fri, 8 Dec 2017 07:59:39 -0600 Subject: [PATCH 245/246] [maven-release-plugin] prepare release clojure-1.9.0 --- pom.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pom.xml b/pom.xml index d5997042..680a7642 100644 --- a/pom.xml +++ b/pom.xml @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-master-SNAPSHOT + 1.9.0 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - HEAD + clojure-1.9.0 From c08643d04b5022f01b413444a88c9a4dfe299590 Mon Sep 17 00:00:00 2001 From: Misha Vakulich Date: Wed, 16 Aug 2023 23:04:35 +0300 Subject: [PATCH 246/246] fix deployment server --- pom.xml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/pom.xml b/pom.xml index ae750214..f6d5d34c 100644 --- a/pom.xml +++ b/pom.xml @@ -236,18 +236,19 @@ + - sonatype-nexus-staging +