testing_map_spec.clj

;; helpers for finding fn arity at runtime via reflection
;; via http://stackoverflow.com/a/20312211
(defn provided
  [cond fun x]
  (if cond
    (fun x)
    x))

(defn append
  [xs x]
  (conj (vec xs) x))

(defn arity-of-method
  [method]
  (->> method .getParameterTypes alength))

(defn arities
  [fun]
  (let [all-declared-methods (.getDeclaredMethods (class fun))
        methods-named (fn [name]
                        (filter #(= (.getName %) name) all-declared-methods))
        methods-named-invoke (methods-named "invoke")
        methods-named-do-invoke (methods-named "doInvoke")
        is-rest-fn (seq methods-named-do-invoke)]
    (->> methods-named-invoke
         (map arity-of-method)
         sort
         (provided is-rest-fn
                   (fn [v] (append v :rest))))))

(defn works-for-arity? [f arity]
  (let [arities (arities f)]
    (or (= [:rest] arities)
        (some (partial = arity)
              arities))))





(s/def ::fn-that-takes-any
  (s/fspec
    :args (s/+ ::s/any)
    :ret ::s/any))

(s/def ::fn-that-takes-fn-with-same-arity-as-rest-of-args
  (s/fspec
    :args (s/cat :function ::fn-that-takes-any
                 :coll (s/+ ::s/any))
    :ret coll?
    :gen (fn [] (gen/return (fn [f & args] [])))
    :fn (fn [{:keys [args]}]
          (works-for-arity? (:function args)
                            (count (:coll args))))))

;; takes over a minute:
;; (s/exercise ::fn-that-takes-fn-with-same-arity-as-rest-of-args)
(s/valid? ::fn-that-takes-fn-with-same-arity-as-rest-of-args
          map)
;; => true

(s/fdef map
  :args (s/cat :function ::fn-that-takes-any
               :coll (s/+ ::any))
  :ret coll?
  :gen (fn [] (gen/return (fn [f & args] [])))
  :fn (fn [{:keys [args]}]
        (works-for-arity? (:function args)
                          (count (:coll args)))))


;;(s/instrument #'map)
;; fails