alvinalexander.com | career | drupal | java | mac | mysql | perl | scala | uml | unix  

Java example source code file (test.clj)

This example Java source code file (test.clj) is included in the alvinalexander.com "Java Source Code Warehouse" project. The intent of this project is to help you "Learn Java by Example" TM.

Learn more about this Java project at its project page.

Java - Java tags/keywords

api, checks, copyright, given, license, like, public, returns, specification-based, the, throwable, unwraps, values, you

The test.clj Java example source code

;   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]))

(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 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)
      (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)
          (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))
            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
        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 (:result result)]
    (cond
     (true? ret) :pass
     (::s/args ret) :no-argspec
     (::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 {: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))))

(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}))

;; duped from spec to avoid introducing public API
(defn- collectionize
  [x]
  (if (symbol? x)
    (list x)
    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- sym->test-map
  [s]
  (let [v (resolve s)]
    {:s s
     :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]
     (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.

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 test result maps 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

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]
     (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]
     (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))



Other Java examples (source code examples)

Here is a short list of links related to this Java test.clj source code file:

... this post is sponsored by my books ...

#1 New Release!

FP Best Seller

 

new blog posts

 

Copyright 1998-2021 Alvin Alexander, alvinalexander.com
All Rights Reserved.

A percentage of advertising revenue from
pages under the /java/jwarehouse URI on this website is
paid back to open source projects.