├── .gitignore ├── LICENSE ├── README.md ├── project.clj ├── src └── clojure │ ├── core │ └── specs │ │ └── alpha.clj │ ├── future.clj │ ├── future_core_instant18.clj │ ├── future_impl.clj │ └── spec │ ├── alpha.clj │ ├── gen │ └── alpha.clj │ └── test │ └── alpha.clj ├── test └── clojure │ └── test_clojure │ └── future.clj ├── test18 └── clojure │ └── test_clojure │ └── spec.clj └── test19 └── clojure └── test_clojure └── spec.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | .hg/ 12 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # clojure-future-spec 2 | 3 | A backport of `clojure.spec` for Clojure 1.8. 4 | 5 | > **NEW!** `clojure-future-spec` is now safe to use from both 1.8 and 1.9+ environments. It’ll add nothing but won’t raise any conflicts either 6 | 7 | ## Setup 8 | 9 | For 1.8 projects, add this to your project.clj: 10 | 11 | ```clj 12 | :dependencies [ 13 | [org.clojure/clojure "1.8.0"] 14 | [clojure-future-spec "1.9.0"] 15 | [org.clojure/test.check "0.9.0"] ;; only if you need generators 16 | ] 17 | ``` 18 | 19 | ## Usage 20 | 21 | There’re four main namespaces: 22 | 23 | ### clojure.spec.alpha 24 | 25 | Exact copy of clojure.spec.alpha from corresponding Clojure Spec alpha: 26 | 27 | ```clj 28 | (require '[clojure.spec.alpha :as spec]) 29 | ``` 30 | 31 | ### clojure.spec.gen.alpha 32 | 33 | Exact copy of `clojure.spec.gen.alpha` from corresponding Clojure Spec alpha: 34 | 35 | ```clj 36 | (require '[clojure.spec.gen.alpha :as spec.gen]) 37 | ``` 38 | 39 | ### clojure.spec.test.alpha 40 | 41 | Exact copy of `clojure.spec.test.alpha` from corresponding Clojure Spec alpha: 42 | 43 | ```clj 44 | (require '[clojure.spec.test.alpha :as spec.test]) 45 | ``` 46 | 47 | ### clojure.future 48 | 49 | Copy of all new functions added to `clojure.core` in Clojure 1.9 (like `boolean?`, `int?`, `seqable?` etc): 50 | 51 | ```clj 52 | (require '[clojure.future :refer :all]) 53 | ``` 54 | 55 | *NEW!* `clojure.future` will define nothing when evaluated in 1.9+ environment. You can now write libraries that do this: 56 | 57 | ```clj 58 | (require '[clojure.future :refer :all]) 59 | ``` 60 | 61 | and it’ll work in both 1.8 and 1.9+ without any conflicts. 62 | 63 | ## License 64 | 65 | Distributed under the Eclipse Public License either version 1.0 or (at 66 | your option) any later version. 67 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject clojure-future-spec "1.9.0" 2 | :description "Backport of clojure.spec for Clojure 1.8" 3 | :url "https://github.com/tonsky/clojure-future-spec" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.8.0"]] 7 | :test-paths ["test" "test18"] 8 | 9 | :profiles { 10 | :1.9 { 11 | :dependencies [[org.clojure/clojure "1.9.0" 12 | :exclusions [org.clojure/specs.alpha 13 | org.clojure/core.specs.alpha]]] 14 | :test-paths ^:replace ["test" "test19"] 15 | } 16 | } 17 | 18 | :aliases {"test-all" ["do" ["test"] ["with-profile" "1.9" "test"]]} 19 | ) 20 | 21 | 22 | -------------------------------------------------------------------------------- /src/clojure/core/specs/alpha.clj: -------------------------------------------------------------------------------- 1 | (ns ^{:skip-wiki true} clojure.core.specs.alpha 2 | (:require [clojure.spec.alpha :as s] 3 | [clojure.future :refer :all])) 4 | 5 | ;;;; destructure 6 | 7 | (s/def ::local-name (s/and simple-symbol? #(not= '& %))) 8 | 9 | (s/def ::binding-form 10 | (s/or :sym ::local-name 11 | :seq ::seq-binding-form 12 | :map ::map-binding-form)) 13 | 14 | ;; sequential destructuring 15 | 16 | (s/def ::seq-binding-form 17 | (s/and vector? 18 | (s/cat :elems (s/* ::binding-form) 19 | :rest (s/? (s/cat :amp #{'&} :form ::binding-form)) 20 | :as (s/? (s/cat :as #{:as} :sym ::local-name))))) 21 | 22 | ;; map destructuring 23 | 24 | (s/def ::keys (s/coll-of ident? :kind vector?)) 25 | (s/def ::syms (s/coll-of symbol? :kind vector?)) 26 | (s/def ::strs (s/coll-of simple-symbol? :kind vector?)) 27 | (s/def ::or (s/map-of simple-symbol? any?)) 28 | (s/def ::as ::local-name) 29 | 30 | (s/def ::map-special-binding 31 | (s/keys :opt-un [::as ::or ::keys ::syms ::strs])) 32 | 33 | (s/def ::map-binding (s/tuple ::binding-form any?)) 34 | 35 | (s/def ::ns-keys 36 | (s/tuple 37 | (s/and qualified-keyword? #(-> % name #{"keys" "syms"})) 38 | (s/coll-of simple-symbol? :kind vector?))) 39 | 40 | (s/def ::map-bindings 41 | (s/every (s/or :mb ::map-binding 42 | :nsk ::ns-keys 43 | :msb (s/tuple #{:as :or :keys :syms :strs} any?)) :into {})) 44 | 45 | (s/def ::map-binding-form (s/merge ::map-bindings ::map-special-binding)) 46 | 47 | ;; bindings 48 | 49 | (s/def ::binding (s/cat :binding ::binding-form :init-expr any?)) 50 | (s/def ::bindings (s/and vector? (s/* ::binding))) 51 | 52 | ;; let, if-let, when-let 53 | 54 | (s/fdef clojure.core/let 55 | :args (s/cat :bindings ::bindings 56 | :body (s/* any?))) 57 | 58 | (s/fdef clojure.core/if-let 59 | :args (s/cat :bindings (s/and vector? ::binding) 60 | :then any? 61 | :else (s/? any?))) 62 | 63 | (s/fdef clojure.core/when-let 64 | :args (s/cat :bindings (s/and vector? ::binding) 65 | :body (s/* any?))) 66 | 67 | ;; defn, defn-, fn 68 | 69 | (s/def ::arg-list 70 | (s/and 71 | vector? 72 | (s/cat :args (s/* ::binding-form) 73 | :varargs (s/? (s/cat :amp #{'&} :form ::binding-form))))) 74 | 75 | (s/def ::args+body 76 | (s/cat :args ::arg-list 77 | :body (s/alt :prepost+body (s/cat :prepost map? 78 | :body (s/+ any?)) 79 | :body (s/* any?)))) 80 | 81 | (s/def ::defn-args 82 | (s/cat :name simple-symbol? 83 | :docstring (s/? string?) 84 | :meta (s/? map?) 85 | :bs (s/alt :arity-1 ::args+body 86 | :arity-n (s/cat :bodies (s/+ (s/spec ::args+body)) 87 | :attr (s/? map?))))) 88 | 89 | (s/fdef clojure.core/defn 90 | :args ::defn-args 91 | :ret any?) 92 | 93 | (s/fdef clojure.core/defn- 94 | :args ::defn-args 95 | :ret any?) 96 | 97 | (s/fdef clojure.core/fn 98 | :args (s/cat :name (s/? simple-symbol?) 99 | :bs (s/alt :arity-1 ::args+body 100 | :arity-n (s/+ (s/spec ::args+body)))) 101 | :ret any?) 102 | 103 | ;;;; ns 104 | 105 | (s/def ::exclude (s/coll-of simple-symbol?)) 106 | (s/def ::only (s/coll-of simple-symbol?)) 107 | (s/def ::rename (s/map-of simple-symbol? simple-symbol?)) 108 | (s/def ::filters (s/keys* :opt-un [::exclude ::only ::rename])) 109 | 110 | (s/def ::ns-refer-clojure 111 | (s/spec (s/cat :clause #{:refer-clojure} 112 | :filters ::filters))) 113 | 114 | (s/def ::refer (s/or :all #{:all} 115 | :syms (s/coll-of simple-symbol?))) 116 | 117 | (s/def ::prefix-list 118 | (s/spec 119 | (s/cat :prefix simple-symbol? 120 | :libspecs (s/+ ::libspec)))) 121 | 122 | (s/def ::libspec 123 | (s/alt :lib simple-symbol? 124 | :lib+opts (s/spec (s/cat :lib simple-symbol? 125 | :options (s/keys* :opt-un [::as ::refer]))))) 126 | 127 | (s/def ::ns-require 128 | (s/spec (s/cat :clause #{:require} 129 | :body (s/+ (s/alt :libspec ::libspec 130 | :prefix-list ::prefix-list 131 | :flag #{:reload :reload-all :verbose}))))) 132 | 133 | (s/def ::package-list 134 | (s/spec 135 | (s/cat :package simple-symbol? 136 | :classes (s/* simple-symbol?)))) 137 | 138 | (s/def ::import-list 139 | (s/* (s/alt :class simple-symbol? 140 | :package-list ::package-list))) 141 | 142 | (s/def ::ns-import 143 | (s/spec 144 | (s/cat :clause #{:import} 145 | :classes ::import-list))) 146 | 147 | (s/def ::ns-refer 148 | (s/spec (s/cat :clause #{:refer} 149 | :lib simple-symbol? 150 | :filters ::filters))) 151 | 152 | ;; same as ::prefix-list, but with ::use-libspec instead 153 | (s/def ::use-prefix-list 154 | (s/spec 155 | (s/cat :prefix simple-symbol? 156 | :libspecs (s/+ ::use-libspec)))) 157 | 158 | ;; same as ::libspec, but also supports the ::filters options in the libspec 159 | (s/def ::use-libspec 160 | (s/alt :lib simple-symbol? 161 | :lib+opts (s/spec (s/cat :lib simple-symbol? 162 | :options (s/keys* :opt-un [::as ::refer ::exclude ::only ::rename]))))) 163 | 164 | (s/def ::ns-use 165 | (s/spec (s/cat :clause #{:use} 166 | :libs (s/+ (s/alt :libspec ::use-libspec 167 | :prefix-list ::use-prefix-list 168 | :flag #{:reload :reload-all :verbose}))))) 169 | 170 | (s/def ::ns-load 171 | (s/spec (s/cat :clause #{:load} 172 | :libs (s/* string?)))) 173 | 174 | (s/def ::name simple-symbol?) 175 | (s/def ::extends simple-symbol?) 176 | (s/def ::implements (s/coll-of simple-symbol? :kind vector?)) 177 | (s/def ::init symbol?) 178 | (s/def ::class-ident (s/or :class simple-symbol? :class-name string?)) 179 | (s/def ::signature (s/coll-of ::class-ident :kind vector?)) 180 | (s/def ::constructors (s/map-of ::signature ::signature)) 181 | (s/def ::post-init symbol?) 182 | (s/def ::method (s/and vector? 183 | (s/cat :name simple-symbol? 184 | :param-types ::signature 185 | :return-type simple-symbol?))) 186 | (s/def ::methods (s/coll-of ::method :kind vector?)) 187 | (s/def ::main boolean?) 188 | (s/def ::factory simple-symbol?) 189 | (s/def ::state simple-symbol?) 190 | (s/def ::get simple-symbol?) 191 | (s/def ::set simple-symbol?) 192 | (s/def ::expose (s/keys :opt-un [::get ::set])) 193 | (s/def ::exposes (s/map-of simple-symbol? ::expose)) 194 | (s/def ::prefix string?) 195 | (s/def ::impl-ns simple-symbol?) 196 | (s/def ::load-impl-ns boolean?) 197 | 198 | (s/def ::ns-gen-class 199 | (s/spec (s/cat :clause #{:gen-class} 200 | :options (s/keys* :opt-un [::name ::extends ::implements 201 | ::init ::constructors ::post-init 202 | ::methods ::main ::factory ::state 203 | ::exposes ::prefix ::impl-ns ::load-impl-ns])))) 204 | 205 | (s/def ::ns-clauses 206 | (s/* (s/alt :refer-clojure ::ns-refer-clojure 207 | :require ::ns-require 208 | :import ::ns-import 209 | :use ::ns-use 210 | :refer ::ns-refer 211 | :load ::ns-load 212 | :gen-class ::ns-gen-class))) 213 | 214 | (s/def ::ns-form 215 | (s/cat :name simple-symbol? 216 | :docstring (s/? string?) 217 | :attr-map (s/? map?) 218 | :clauses ::ns-clauses)) 219 | 220 | (s/fdef clojure.core/ns 221 | :args ::ns-form) 222 | 223 | (defmacro ^:private quotable 224 | "Returns a spec that accepts both the spec and a (quote ...) form of the spec" 225 | [spec] 226 | `(s/or :spec ~spec :quoted-spec (s/cat :quote #{'quote} :spec ~spec))) 227 | 228 | (s/def ::quotable-import-list 229 | (s/* (s/alt :class (quotable simple-symbol?) 230 | :package-list (quotable ::package-list)))) 231 | 232 | (s/fdef clojure.core/import 233 | :args ::quotable-import-list) 234 | 235 | (s/fdef clojure.core/refer-clojure 236 | :args (s/* (s/alt 237 | :exclude (s/cat :op (quotable #{:exclude}) :arg (quotable ::exclude)) 238 | :only (s/cat :op (quotable #{:only}) :arg (quotable ::only)) 239 | :rename (s/cat :op (quotable #{:rename}) :arg (quotable ::rename))))) 240 | -------------------------------------------------------------------------------- /src/clojure/future.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.future) 2 | 3 | (when (and (= 1 (:major *clojure-version*)) 4 | (< (:minor *clojure-version*) 9)) 5 | (load "future_impl")) -------------------------------------------------------------------------------- /src/clojure/future_core_instant18.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (in-ns 'clojure.future) 10 | 11 | (import 'java.time.Instant) 12 | 13 | (set! *warn-on-reflection* true) 14 | 15 | (extend-protocol Inst 16 | java.time.Instant 17 | (inst-ms* [inst] (.toEpochMilli ^java.time.Instant inst))) -------------------------------------------------------------------------------- /src/clojure/future_impl.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (in-ns 'clojure.future) 10 | 11 | (defn boolean? 12 | "Return true if x is a Boolean" 13 | {:added "1.9"} 14 | [x] (instance? Boolean x)) 15 | 16 | (defprotocol Inst 17 | (inst-ms* [inst])) 18 | 19 | (extend-protocol Inst 20 | java.util.Date 21 | (inst-ms* [inst] (.getTime ^java.util.Date inst))) 22 | 23 | ;; conditionally extend to Instant on Java 8+ 24 | (try 25 | (Class/forName "java.time.Instant") 26 | (load "future_core_instant18") 27 | (catch ClassNotFoundException cnfe)) 28 | 29 | (defn inst-ms 30 | "Return the number of milliseconds since January 1, 1970, 00:00:00 GMT" 31 | {:added "1.9"} 32 | [inst] 33 | (inst-ms* inst)) 34 | 35 | (defn inst? 36 | "Return true if x satisfies Inst" 37 | {:added "1.9"} 38 | [x] 39 | (satisfies? Inst x)) 40 | 41 | (defn uuid? 42 | "Return true if x is a java.util.UUID" 43 | {:added "1.9"} 44 | [x] (instance? java.util.UUID x)) 45 | 46 | (defn ident? 47 | "Return true if x is a symbol or keyword" 48 | {:added "1.9"} 49 | [x] (or (keyword? x) (symbol? x))) 50 | 51 | (defn simple-ident? 52 | "Return true if x is a symbol or keyword without a namespace" 53 | {:added "1.9"} 54 | [x] (and (ident? x) (nil? (namespace x)))) 55 | 56 | (defn qualified-ident? 57 | "Return true if x is a symbol or keyword with a namespace" 58 | {:added "1.9"} 59 | [x] (boolean (and (ident? x) (namespace x) true))) 60 | 61 | (defn simple-symbol? 62 | "Return true if x is a symbol without a namespace" 63 | {:added "1.9"} 64 | [x] (and (symbol? x) (nil? (namespace x)))) 65 | 66 | (defn qualified-symbol? 67 | "Return true if x is a symbol with a namespace" 68 | {:added "1.9"} 69 | [x] (boolean (and (symbol? x) (namespace x) true))) 70 | 71 | (defn simple-keyword? 72 | "Return true if x is a keyword without a namespace" 73 | {:added "1.9"} 74 | [x] (and (keyword? x) (nil? (namespace x)))) 75 | 76 | (defn qualified-keyword? 77 | "Return true if x is a keyword with a namespace" 78 | {:added "1.9"} 79 | [x] (boolean (and (keyword? x) (namespace x) true))) 80 | 81 | (defn uri? 82 | "Return true if x is a java.net.URI" 83 | {:added "1.9"} 84 | [x] (instance? java.net.URI x)) 85 | 86 | (defn int? 87 | "Return true if x is a fixed precision integer" 88 | {:added "1.9"} 89 | [x] (or (instance? Long x) 90 | (instance? Integer x) 91 | (instance? Short x) 92 | (instance? Byte x))) 93 | 94 | (defn pos-int? 95 | "Return true if x is a positive fixed precision integer" 96 | {:added "1.9"} 97 | [x] (and (int? x) 98 | (pos? x))) 99 | 100 | (defn neg-int? 101 | "Return true if x is a negative fixed precision integer" 102 | {:added "1.9"} 103 | [x] (and (int? x) 104 | (neg? x))) 105 | 106 | (defn nat-int? 107 | "Return true if x is a non-negative fixed precision integer" 108 | {:added "1.9"} 109 | [x] (and (int? x) 110 | (not (neg? x)))) 111 | 112 | (defn double? 113 | "Return true if x is a Double" 114 | {:added "1.9"} 115 | [x] (instance? Double x)) 116 | 117 | (defn bytes? 118 | "Return true if x is a byte array" 119 | {:added "1.9"} 120 | [x] (if (nil? x) 121 | false 122 | (-> x class .getComponentType (= Byte/TYPE)))) 123 | 124 | (defn seqable? 125 | "Return true if the seq function is supported for x" 126 | {:added "1.9"} 127 | [x] 128 | (or (instance? clojure.lang.ISeq x) 129 | (instance? clojure.lang.Seqable x) 130 | (nil? x) 131 | (instance? Iterable x) 132 | (.. x getClass isArray) 133 | (instance? CharSequence x) 134 | (instance? java.util.Map x))) 135 | 136 | (defn indexed? 137 | "Return true if coll implements Indexed, indicating efficient lookup by index" 138 | {:added "1.9"} 139 | [coll] (instance? clojure.lang.Indexed coll)) 140 | 141 | (defn bounded-count 142 | "If coll is counted? returns its count, else will count at most the first n 143 | elements of coll using its seq" 144 | {:added "1.9"} 145 | [n coll] 146 | (if (counted? coll) 147 | (count coll) 148 | (loop [i 0 s (seq coll)] 149 | (if (and s (< i n)) 150 | (recur (inc i) (next s)) 151 | i)))) 152 | 153 | (defn StackTraceElement->vec 154 | "Constructs a data representation for a StackTraceElement" 155 | {:added "1.9"} 156 | [^StackTraceElement o] 157 | [(symbol (.getClassName o)) (symbol (.getMethodName o)) (.getFileName o) (.getLineNumber o)]) 158 | 159 | (defn any? 160 | "Returns true given any argument." 161 | {:tag Boolean 162 | :added "1.9"} 163 | [x] true) 164 | 165 | (defn halt-when 166 | "Returns a transducer that ends transduction when pred returns true 167 | for an input. When retf is supplied it must be a fn of 2 arguments - 168 | it will be passed the (completed) result so far and the input that 169 | triggered the predicate, and its return value (if it does not throw 170 | an exception) will be the return value of the transducer. If retf 171 | is not supplied, the input that triggered the predicate will be 172 | returned. If the predicate never returns true the transduction is 173 | unaffected." 174 | {:added "1.9"} 175 | ([pred] (halt-when pred nil)) 176 | ([pred retf] 177 | (fn [rf] 178 | (fn 179 | ([] (rf)) 180 | ([result] 181 | (if (and (map? result) (contains? result ::halt)) 182 | (::halt result) 183 | (rf result))) 184 | ([result input] 185 | (if (pred input) 186 | (reduced {::halt (if retf (retf (rf result) input) input)}) 187 | (rf result input))))))) 188 | 189 | (defn swap-vals! 190 | "Atomically swaps the value of atom to be: 191 | (apply f current-value-of-atom args). Note that f may be called 192 | multiple times, and thus should be free of side effects. 193 | Returns [old new], the value of the atom before and after the swap." 194 | {:added "1.9"} 195 | (^clojure.lang.IPersistentVector [^clojure.lang.IAtom atom f] 196 | (loop [oldval @atom] 197 | (let [newval (f oldval)] 198 | (if (.compareAndSet atom oldval newval) 199 | [oldval newval] 200 | (recur @atom))))) 201 | (^clojure.lang.IPersistentVector [^clojure.lang.IAtom atom f x] 202 | (loop [oldval @atom] 203 | (let [newval (f oldval x)] 204 | (if (.compareAndSet atom oldval newval) 205 | [oldval newval] 206 | (recur @atom))))) 207 | (^clojure.lang.IPersistentVector [^clojure.lang.IAtom atom f x y] 208 | (loop [oldval @atom] 209 | (let [newval (f oldval x y)] 210 | (if (.compareAndSet atom oldval newval) 211 | [oldval newval] 212 | (recur @atom))))) 213 | (^clojure.lang.IPersistentVector [^clojure.lang.IAtom atom f x y & args] 214 | (loop [oldval @atom] 215 | (let [newval (apply f oldval x y args)] 216 | (if (.compareAndSet atom oldval newval) 217 | [oldval newval] 218 | (recur @atom)))))) 219 | 220 | (defn reset-vals! 221 | "Sets the value of atom to newval. Returns [old new], the value of the 222 | atom before and after the reset." 223 | {:added "1.9"} 224 | (^clojure.lang.IPersistentVector [^clojure.lang.IAtom atom newval] 225 | (loop [oldval @atom] 226 | (if (.compareAndSet atom oldval newval) 227 | [oldval newval] 228 | (recur @atom))))) 229 | -------------------------------------------------------------------------------- /src/clojure/spec/alpha.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.spec.alpha 10 | (:refer-clojure :exclude [+ * and assert or cat def keys merge]) 11 | (:require [clojure.walk :as walk] 12 | [clojure.spec.gen.alpha :as gen] 13 | [clojure.string :as str] 14 | [clojure.future :refer :all])) 15 | 16 | (alias 'c 'clojure.core) 17 | 18 | (set! *warn-on-reflection* true) 19 | 20 | (def ^:dynamic *recursion-limit* 21 | "A soft limit on how many times a branching spec (or/alt/*/opt-keys/multi-spec) 22 | can be recursed through during generation. After this a 23 | non-recursive branch will be chosen." 24 | 4) 25 | 26 | (def ^:dynamic *fspec-iterations* 27 | "The number of times an anonymous fn specified by fspec will be (generatively) tested during conform" 28 | 21) 29 | 30 | (def ^:dynamic *coll-check-limit* 31 | "The number of elements validated in a collection spec'ed with 'every'" 32 | 101) 33 | 34 | (def ^:dynamic *coll-error-limit* 35 | "The number of errors reported by explain in a collection spec'ed with 'every'" 36 | 20) 37 | 38 | (defprotocol Spec 39 | (conform* [spec x]) 40 | (unform* [spec y]) 41 | (explain* [spec path via in x]) 42 | (gen* [spec overrides path rmap]) 43 | (with-gen* [spec gfn]) 44 | (describe* [spec])) 45 | 46 | (defonce ^:private registry-ref (atom {})) 47 | 48 | (defn- deep-resolve [reg k] 49 | (loop [spec k] 50 | (if (ident? spec) 51 | (recur (get reg spec)) 52 | spec))) 53 | 54 | (defn- reg-resolve 55 | "returns the spec/regex at end of alias chain starting with k, nil if not found, k if k not ident" 56 | [k] 57 | (if (ident? k) 58 | (let [reg @registry-ref 59 | spec (get reg k)] 60 | (if-not (ident? spec) 61 | spec 62 | (deep-resolve reg spec))) 63 | k)) 64 | 65 | (defn- reg-resolve! 66 | "returns the spec/regex at end of alias chain starting with k, throws if not found, k if k not ident" 67 | [k] 68 | (if (ident? k) 69 | (c/or (reg-resolve k) 70 | (throw (Exception. (str "Unable to resolve spec: " k)))) 71 | k)) 72 | 73 | (defn spec? 74 | "returns x if x is a spec object, else logical false" 75 | [x] 76 | (when (instance? clojure.spec.alpha.Spec x) 77 | x)) 78 | 79 | (defn regex? 80 | "returns x if x is a (clojure.spec) regex op, else logical false" 81 | [x] 82 | (c/and (::op x) x)) 83 | 84 | (defn- with-name [spec name] 85 | (cond 86 | (ident? spec) spec 87 | (regex? spec) (assoc spec ::name name) 88 | 89 | (instance? clojure.lang.IObj spec) 90 | (with-meta spec (assoc (meta spec) ::name name)))) 91 | 92 | (defn- spec-name [spec] 93 | (cond 94 | (ident? spec) spec 95 | 96 | (regex? spec) (::name spec) 97 | 98 | (instance? clojure.lang.IObj spec) 99 | (-> (meta spec) ::name))) 100 | 101 | (declare spec-impl) 102 | (declare regex-spec-impl) 103 | 104 | (defn- maybe-spec 105 | "spec-or-k must be a spec, regex or resolvable kw/sym, else returns nil." 106 | [spec-or-k] 107 | (let [s (c/or (c/and (ident? spec-or-k) (reg-resolve spec-or-k)) 108 | (spec? spec-or-k) 109 | (regex? spec-or-k) 110 | nil)] 111 | (if (regex? s) 112 | (with-name (regex-spec-impl s nil) (spec-name s)) 113 | s))) 114 | 115 | (defn- the-spec 116 | "spec-or-k must be a spec, regex or kw/sym, else returns nil. Throws if unresolvable kw/sym" 117 | [spec-or-k] 118 | (c/or (maybe-spec spec-or-k) 119 | (when (ident? spec-or-k) 120 | (throw (Exception. (str "Unable to resolve spec: " spec-or-k)))))) 121 | 122 | (defprotocol Specize 123 | (specize* [_] [_ form])) 124 | 125 | (extend-protocol Specize 126 | clojure.lang.Keyword 127 | (specize* ([k] (specize* (reg-resolve! k))) 128 | ([k _] (specize* (reg-resolve! k)))) 129 | 130 | clojure.lang.Symbol 131 | (specize* ([s] (specize* (reg-resolve! s))) 132 | ([s _] (specize* (reg-resolve! s)))) 133 | 134 | Object 135 | (specize* ([o] (spec-impl ::unknown o nil nil)) 136 | ([o form] (spec-impl form o nil nil)))) 137 | 138 | (defn- specize 139 | ([s] (c/or (spec? s) (specize* s))) 140 | ([s form] (c/or (spec? s) (specize* s form)))) 141 | 142 | (defn invalid? 143 | "tests the validity of a conform return value" 144 | [ret] 145 | (identical? ::invalid ret)) 146 | 147 | (defn conform 148 | "Given a spec and a value, returns :clojure.spec.alpha/invalid 149 | if value does not match spec, else the (possibly destructured) value." 150 | [spec x] 151 | (conform* (specize spec) x)) 152 | 153 | (defn unform 154 | "Given a spec and a value created by or compliant with a call to 155 | 'conform' with the same spec, returns a value with all conform 156 | destructuring undone." 157 | [spec x] 158 | (unform* (specize spec) x)) 159 | 160 | (defn form 161 | "returns the spec as data" 162 | [spec] 163 | ;;TODO - incorporate gens 164 | (describe* (specize spec))) 165 | 166 | (defn abbrev [form] 167 | (cond 168 | (seq? form) 169 | (walk/postwalk (fn [form] 170 | (cond 171 | (c/and (symbol? form) (namespace form)) 172 | (-> form name symbol) 173 | 174 | (c/and (seq? form) (= 'fn (first form)) (= '[%] (second form))) 175 | (last form) 176 | 177 | :else form)) 178 | form) 179 | 180 | (c/and (symbol? form) (namespace form)) 181 | (-> form name symbol) 182 | 183 | :else form)) 184 | 185 | (defn describe 186 | "returns an abbreviated description of the spec as data" 187 | [spec] 188 | (abbrev (form spec))) 189 | 190 | (defn with-gen 191 | "Takes a spec and a no-arg, generator-returning fn and returns a version of that spec that uses that generator" 192 | [spec gen-fn] 193 | (let [spec (reg-resolve spec)] 194 | (if (regex? spec) 195 | (assoc spec ::gfn gen-fn) 196 | (with-gen* (specize spec) gen-fn)))) 197 | 198 | (defn explain-data* [spec path via in x] 199 | (let [probs (explain* (specize spec) path via in x)] 200 | (when-not (empty? probs) 201 | {::problems probs 202 | ::spec spec 203 | ::value x}))) 204 | 205 | (defn explain-data 206 | "Given a spec and a value x which ought to conform, returns nil if x 207 | conforms, else a map with at least the key ::problems whose value is 208 | a collection of problem-maps, where problem-map has at least :path :pred and :val 209 | keys describing the predicate and the value that failed at that 210 | path." 211 | [spec x] 212 | (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) [] x)) 213 | 214 | (defn explain-printer 215 | "Default printer for explain-data. nil indicates a successful validation." 216 | [ed] 217 | (if ed 218 | (let [problems (sort-by #(- (count (:path %))) (::problems ed))] 219 | ;;(prn {:ed ed}) 220 | (doseq [{:keys [path pred val reason via in] :as prob} problems] 221 | (when-not (empty? in) 222 | (print "In:" (pr-str in) "")) 223 | (print "val: ") 224 | (pr val) 225 | (print " fails") 226 | (when-not (empty? via) 227 | (print " spec:" (pr-str (last via)))) 228 | (when-not (empty? path) 229 | (print " at:" (pr-str path))) 230 | (print " predicate: ") 231 | (pr (abbrev pred)) 232 | (when reason (print ", " reason)) 233 | (doseq [[k v] prob] 234 | (when-not (#{:path :pred :val :reason :via :in} k) 235 | (print "\n\t" (pr-str k) " ") 236 | (pr v))) 237 | (newline))) 238 | (println "Success!"))) 239 | 240 | (def ^:dynamic *explain-out* explain-printer) 241 | 242 | (defn explain-out 243 | "Prints explanation data (per 'explain-data') to *out* using the printer in *explain-out*, 244 | by default explain-printer." 245 | [ed] 246 | (*explain-out* ed)) 247 | 248 | (defn explain 249 | "Given a spec and a value that fails to conform, prints an explanation to *out*." 250 | [spec x] 251 | (explain-out (explain-data spec x))) 252 | 253 | (defn explain-str 254 | "Given a spec and a value that fails to conform, returns an explanation as a string." 255 | [spec x] 256 | (with-out-str (explain spec x))) 257 | 258 | (declare valid?) 259 | 260 | (defn- gensub 261 | [spec overrides path rmap form] 262 | ;;(prn {:spec spec :over overrides :path path :form form}) 263 | (let [spec (specize spec)] 264 | (if-let [g (c/or (when-let [gfn (c/or (get overrides (c/or (spec-name spec) spec)) 265 | (get overrides path))] 266 | (gfn)) 267 | (gen* spec overrides path rmap))] 268 | (gen/such-that #(valid? spec %) g 100) 269 | (let [abbr (abbrev form)] 270 | (throw (ex-info (str "Unable to construct gen at: " path " for: " abbr) 271 | {::path path ::form form ::failure :no-gen})))))) 272 | 273 | (defn gen 274 | "Given a spec, returns the generator for it, or throws if none can 275 | be constructed. Optionally an overrides map can be provided which 276 | should map spec names or paths (vectors of keywords) to no-arg 277 | generator-creating fns. These will be used instead of the generators at those 278 | names/paths. Note that parent generator (in the spec or overrides 279 | map) will supersede those of any subtrees. A generator for a regex 280 | op must always return a sequential collection (i.e. a generator for 281 | s/? should return either an empty sequence/vector or a 282 | sequence/vector with one item in it)" 283 | ([spec] (gen spec nil)) 284 | ([spec overrides] (gensub spec overrides [] {::recursion-limit *recursion-limit*} spec))) 285 | 286 | (defn- ->sym 287 | "Returns a symbol from a symbol or var" 288 | [x] 289 | (if (var? x) 290 | (let [^clojure.lang.Var v x] 291 | (symbol (str (.name (.ns v))) 292 | (str (.sym v)))) 293 | x)) 294 | 295 | (defn- unfn [expr] 296 | (if (c/and (seq? expr) 297 | (symbol? (first expr)) 298 | (= "fn*" (name (first expr)))) 299 | (let [[[s] & form] (rest expr)] 300 | (conj (walk/postwalk-replace {s '%} form) '[%] 'fn)) 301 | expr)) 302 | 303 | (defn- res [form] 304 | (cond 305 | (keyword? form) form 306 | (symbol? form) (c/or (-> form resolve ->sym) form) 307 | (sequential? form) (walk/postwalk #(if (symbol? %) (res %) %) (unfn form)) 308 | :else form)) 309 | 310 | (defn ^:skip-wiki def-impl 311 | "Do not call this directly, use 'def'" 312 | [k form spec] 313 | (c/assert (c/and (ident? k) (namespace k)) "k must be namespaced keyword or resolvable symbol") 314 | (let [spec (if (c/or (spec? spec) (regex? spec) (get @registry-ref spec)) 315 | spec 316 | (spec-impl form spec nil nil))] 317 | (swap! registry-ref assoc k (with-name spec k)) 318 | k)) 319 | 320 | (defn- ns-qualify 321 | "Qualify symbol s by resolving it or using the current *ns*." 322 | [s] 323 | (if-let [ns-sym (some-> s namespace symbol)] 324 | (c/or (some-> (get (ns-aliases *ns*) ns-sym) str (symbol (name s))) 325 | s) 326 | (symbol (str (.name *ns*)) (str s)))) 327 | 328 | (defmacro def 329 | "Given a namespace-qualified keyword or resolvable symbol k, and a 330 | spec, spec-name, predicate or regex-op makes an entry in the 331 | registry mapping k to the spec" 332 | [k spec-form] 333 | (let [k (if (symbol? k) (ns-qualify k) k)] 334 | `(def-impl '~k '~(res spec-form) ~spec-form))) 335 | 336 | (defn registry 337 | "returns the registry map, prefer 'get-spec' to lookup a spec by name" 338 | [] 339 | @registry-ref) 340 | 341 | (defn get-spec 342 | "Returns spec registered for keyword/symbol/var k, or nil." 343 | [k] 344 | (get (registry) (if (keyword? k) k (->sym k)))) 345 | 346 | (defmacro spec 347 | "Takes a single predicate form, e.g. can be the name of a predicate, 348 | like even?, or a fn literal like #(< % 42). Note that it is not 349 | generally necessary to wrap predicates in spec when using the rest 350 | of the spec macros, only to attach a unique generator 351 | 352 | Can also be passed the result of one of the regex ops - 353 | cat, alt, *, +, ?, in which case it will return a regex-conforming 354 | spec, useful when nesting an independent regex. 355 | --- 356 | 357 | Optionally takes :gen generator-fn, which must be a fn of no args that 358 | returns a test.check generator. 359 | 360 | Returns a spec." 361 | [form & {:keys [gen]}] 362 | (when form 363 | `(spec-impl '~(res form) ~form ~gen nil))) 364 | 365 | (defmacro multi-spec 366 | "Takes the name of a spec/predicate-returning multimethod and a 367 | tag-restoring keyword or fn (retag). Returns a spec that when 368 | conforming or explaining data will pass it to the multimethod to get 369 | an appropriate spec. You can e.g. use multi-spec to dynamically and 370 | extensibly associate specs with 'tagged' data (i.e. data where one 371 | of the fields indicates the shape of the rest of the structure). 372 | 373 | (defmulti mspec :tag) 374 | 375 | The methods should ignore their argument and return a predicate/spec: 376 | (defmethod mspec :int [_] (s/keys :req-un [::tag ::i])) 377 | 378 | retag is used during generation to retag generated values with 379 | matching tags. retag can either be a keyword, at which key the 380 | dispatch-tag will be assoc'ed, or a fn of generated value and 381 | dispatch-tag that should return an appropriately retagged value. 382 | 383 | Note that because the tags themselves comprise an open set, 384 | the tag key spec cannot enumerate the values, but can e.g. 385 | test for keyword?. 386 | 387 | Note also that the dispatch values of the multimethod will be 388 | included in the path, i.e. in reporting and gen overrides, even 389 | though those values are not evident in the spec. 390 | " 391 | [mm retag] 392 | `(multi-spec-impl '~(res mm) (var ~mm) ~retag)) 393 | 394 | (defmacro keys 395 | "Creates and returns a map validating spec. :req and :opt are both 396 | vectors of namespaced-qualified keywords. The validator will ensure 397 | the :req keys are present. The :opt keys serve as documentation and 398 | may be used by the generator. 399 | 400 | The :req key vector supports 'and' and 'or' for key groups: 401 | 402 | (s/keys :req [::x ::y (or ::secret (and ::user ::pwd))] :opt [::z]) 403 | 404 | There are also -un versions of :req and :opt. These allow 405 | you to connect unqualified keys to specs. In each case, fully 406 | qualfied keywords are passed, which name the specs, but unqualified 407 | keys (with the same name component) are expected and checked at 408 | conform-time, and generated during gen: 409 | 410 | (s/keys :req-un [:my.ns/x :my.ns/y]) 411 | 412 | The above says keys :x and :y are required, and will be validated 413 | and generated by specs (if they exist) named :my.ns/x :my.ns/y 414 | respectively. 415 | 416 | In addition, the values of *all* namespace-qualified keys will be validated 417 | (and possibly destructured) by any registered specs. Note: there is 418 | no support for inline value specification, by design. 419 | 420 | Optionally takes :gen generator-fn, which must be a fn of no args that 421 | returns a test.check generator." 422 | [& {:keys [req req-un opt opt-un gen]}] 423 | (let [unk #(-> % name keyword) 424 | req-keys (filterv keyword? (flatten req)) 425 | req-un-specs (filterv keyword? (flatten req-un)) 426 | _ (c/assert (every? #(c/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un)) 427 | "all keys must be namespace-qualified keywords") 428 | req-specs (into req-keys req-un-specs) 429 | req-keys (into req-keys (map unk req-un-specs)) 430 | opt-keys (into (vec opt) (map unk opt-un)) 431 | opt-specs (into (vec opt) opt-un) 432 | gx (gensym) 433 | parse-req (fn [rk f] 434 | (map (fn [x] 435 | (if (keyword? x) 436 | `(contains? ~gx ~(f x)) 437 | (walk/postwalk 438 | (fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y)) 439 | x))) 440 | rk)) 441 | pred-exprs [`(map? ~gx)] 442 | pred-exprs (into pred-exprs (parse-req req identity)) 443 | pred-exprs (into pred-exprs (parse-req req-un unk)) 444 | keys-pred `(fn* [~gx] (c/and ~@pred-exprs)) 445 | pred-exprs (mapv (fn [e] `(fn* [~gx] ~e)) pred-exprs) 446 | pred-forms (walk/postwalk res pred-exprs)] 447 | ;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen) 448 | `(map-spec-impl {:req '~req :opt '~opt :req-un '~req-un :opt-un '~opt-un 449 | :req-keys '~req-keys :req-specs '~req-specs 450 | :opt-keys '~opt-keys :opt-specs '~opt-specs 451 | :pred-forms '~pred-forms 452 | :pred-exprs ~pred-exprs 453 | :keys-pred ~keys-pred 454 | :gfn ~gen}))) 455 | 456 | (defmacro or 457 | "Takes key+pred pairs, e.g. 458 | 459 | (s/or :even even? :small #(< % 42)) 460 | 461 | Returns a destructuring spec that returns a map entry containing the 462 | key of the first matching pred and the corresponding value. Thus the 463 | 'key' and 'val' functions can be used to refer generically to the 464 | components of the tagged return." 465 | [& key-pred-forms] 466 | (let [pairs (partition 2 key-pred-forms) 467 | keys (mapv first pairs) 468 | pred-forms (mapv second pairs) 469 | pf (mapv res pred-forms)] 470 | (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords") 471 | `(or-spec-impl ~keys '~pf ~pred-forms nil))) 472 | 473 | (defmacro and 474 | "Takes predicate/spec-forms, e.g. 475 | 476 | (s/and even? #(< % 42)) 477 | 478 | Returns a spec that returns the conformed value. Successive 479 | conformed values propagate through rest of predicates." 480 | [& pred-forms] 481 | `(and-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) 482 | 483 | (defmacro merge 484 | "Takes map-validating specs (e.g. 'keys' specs) and 485 | returns a spec that returns a conformed map satisfying all of the 486 | specs. Unlike 'and', merge can generate maps satisfying the 487 | union of the predicates." 488 | [& pred-forms] 489 | `(merge-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) 490 | 491 | (defn- res-kind 492 | [opts] 493 | (let [{kind :kind :as mopts} opts] 494 | (->> 495 | (if kind 496 | (assoc mopts :kind `~(res kind)) 497 | mopts) 498 | (mapcat identity)))) 499 | 500 | (defmacro every 501 | "takes a pred and validates collection elements against that pred. 502 | 503 | Note that 'every' does not do exhaustive checking, rather it samples 504 | *coll-check-limit* elements. Nor (as a result) does it do any 505 | conforming of elements. 'explain' will report at most *coll-error-limit* 506 | problems. Thus 'every' should be suitable for potentially large 507 | collections. 508 | 509 | Takes several kwargs options that further constrain the collection: 510 | 511 | :kind - a pred/spec that the collection type must satisfy, e.g. vector? 512 | (default nil) Note that if :kind is specified and :into is 513 | not, this pred must generate in order for every to generate. 514 | :count - specifies coll has exactly this count (default nil) 515 | :min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil) 516 | :distinct - all the elements are distinct (default nil) 517 | 518 | And additional args that control gen 519 | 520 | :gen-max - the maximum coll size to generate (default 20) 521 | :into - one of [], (), {}, #{} - the default collection to generate into 522 | (default: empty coll as generated by :kind pred if supplied, else []) 523 | 524 | Optionally takes :gen generator-fn, which must be a fn of no args that 525 | returns a test.check generator 526 | 527 | See also - coll-of, every-kv 528 | " 529 | [pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}] 530 | (let [desc (::describe opts) 531 | nopts (-> opts 532 | (dissoc :gen ::describe) 533 | (assoc ::kind-form `'~(res (:kind opts)) 534 | ::describe (c/or desc `'(every ~(res pred) ~@(res-kind opts))))) 535 | gx (gensym) 536 | cpreds (cond-> [(list (c/or kind `coll?) gx)] 537 | count (conj `(= ~count (bounded-count ~count ~gx))) 538 | 539 | (c/or min-count max-count) 540 | (conj `(<= (c/or ~min-count 0) 541 | (bounded-count (if ~max-count (inc ~max-count) ~min-count) ~gx) 542 | (c/or ~max-count Integer/MAX_VALUE))) 543 | 544 | distinct 545 | (conj `(c/or (empty? ~gx) (apply distinct? ~gx))))] 546 | `(every-impl '~pred ~pred ~(assoc nopts ::cpred `(fn* [~gx] (c/and ~@cpreds))) ~gen))) 547 | 548 | (defmacro every-kv 549 | "like 'every' but takes separate key and val preds and works on associative collections. 550 | 551 | Same options as 'every', :into defaults to {} 552 | 553 | See also - map-of" 554 | 555 | [kpred vpred & opts] 556 | (let [desc `(every-kv ~(res kpred) ~(res vpred) ~@(res-kind opts))] 557 | `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :into {} ::describe '~desc ~@opts))) 558 | 559 | (defmacro coll-of 560 | "Returns a spec for a collection of items satisfying pred. Unlike 561 | 'every', coll-of will exhaustively conform every value. 562 | 563 | Same options as 'every'. conform will produce a collection 564 | corresponding to :into if supplied, else will match the input collection, 565 | avoiding rebuilding when possible. 566 | 567 | See also - every, map-of" 568 | [pred & opts] 569 | (let [desc `(coll-of ~(res pred) ~@(res-kind opts))] 570 | `(every ~pred ::conform-all true ::describe '~desc ~@opts))) 571 | 572 | (defmacro map-of 573 | "Returns a spec for a map whose keys satisfy kpred and vals satisfy 574 | vpred. Unlike 'every-kv', map-of will exhaustively conform every 575 | value. 576 | 577 | Same options as 'every', :kind defaults to map?, with the addition of: 578 | 579 | :conform-keys - conform keys as well as values (default false) 580 | 581 | See also - every-kv" 582 | [kpred vpred & opts] 583 | (let [desc `(map-of ~(res kpred) ~(res vpred) ~@(res-kind opts))] 584 | `(every-kv ~kpred ~vpred ::conform-all true :kind map? ::describe '~desc ~@opts))) 585 | 586 | 587 | (defmacro * 588 | "Returns a regex op that matches zero or more values matching 589 | pred. Produces a vector of matches iff there is at least one match" 590 | [pred-form] 591 | `(rep-impl '~(res pred-form) ~pred-form)) 592 | 593 | (defmacro + 594 | "Returns a regex op that matches one or more values matching 595 | pred. Produces a vector of matches" 596 | [pred-form] 597 | `(rep+impl '~(res pred-form) ~pred-form)) 598 | 599 | (defmacro ? 600 | "Returns a regex op that matches zero or one value matching 601 | pred. Produces a single value (not a collection) if matched." 602 | [pred-form] 603 | `(maybe-impl ~pred-form '~(res pred-form))) 604 | 605 | (defmacro alt 606 | "Takes key+pred pairs, e.g. 607 | 608 | (s/alt :even even? :small #(< % 42)) 609 | 610 | Returns a regex op that returns a map entry containing the key of the 611 | first matching pred and the corresponding value. Thus the 612 | 'key' and 'val' functions can be used to refer generically to the 613 | components of the tagged return" 614 | [& key-pred-forms] 615 | (let [pairs (partition 2 key-pred-forms) 616 | keys (mapv first pairs) 617 | pred-forms (mapv second pairs) 618 | pf (mapv res pred-forms)] 619 | (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords") 620 | `(alt-impl ~keys ~pred-forms '~pf))) 621 | 622 | (defmacro cat 623 | "Takes key+pred pairs, e.g. 624 | 625 | (s/cat :e even? :o odd?) 626 | 627 | Returns a regex op that matches (all) values in sequence, returning a map 628 | containing the keys of each pred and the corresponding value." 629 | [& key-pred-forms] 630 | (let [pairs (partition 2 key-pred-forms) 631 | keys (mapv first pairs) 632 | pred-forms (mapv second pairs) 633 | pf (mapv res pred-forms)] 634 | ;;(prn key-pred-forms) 635 | (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords") 636 | `(cat-impl ~keys ~pred-forms '~pf))) 637 | 638 | (defmacro & 639 | "takes a regex op re, and predicates. Returns a regex-op that consumes 640 | input as per re but subjects the resulting value to the 641 | conjunction of the predicates, and any conforming they might perform." 642 | [re & preds] 643 | (let [pv (vec preds)] 644 | `(amp-impl ~re ~pv '~(mapv res pv)))) 645 | 646 | (defmacro conformer 647 | "takes a predicate function with the semantics of conform i.e. it should return either a 648 | (possibly converted) value or :clojure.spec.alpha/invalid, and returns a 649 | spec that uses it as a predicate/conformer. Optionally takes a 650 | second fn that does unform of result of first" 651 | ([f] `(spec-impl '(conformer ~(res f)) ~f nil true)) 652 | ([f unf] `(spec-impl '(conformer ~(res f) ~(res unf)) ~f nil true ~unf))) 653 | 654 | (defmacro fspec 655 | "takes :args :ret and (optional) :fn kwargs whose values are preds 656 | and returns a spec whose conform/explain take a fn and validates it 657 | using generative testing. The conformed value is always the fn itself. 658 | 659 | See 'fdef' for a single operation that creates an fspec and 660 | registers it, as well as a full description of :args, :ret and :fn 661 | 662 | fspecs can generate functions that validate the arguments and 663 | fabricate a return value compliant with the :ret spec, ignoring 664 | the :fn spec if present. 665 | 666 | Optionally takes :gen generator-fn, which must be a fn of no args 667 | that returns a test.check generator." 668 | 669 | [& {:keys [args ret fn gen] :or {ret `any?}}] 670 | `(fspec-impl (spec ~args) '~(res args) 671 | (spec ~ret) '~(res ret) 672 | (spec ~fn) '~(res fn) ~gen)) 673 | 674 | (defmacro tuple 675 | "takes one or more preds and returns a spec for a tuple, a vector 676 | where each element conforms to the corresponding pred. Each element 677 | will be referred to in paths using its ordinal." 678 | [& preds] 679 | (c/assert (not (empty? preds))) 680 | `(tuple-impl '~(mapv res preds) ~(vec preds))) 681 | 682 | (defn- macroexpand-check 683 | [v args] 684 | (let [fn-spec (get-spec v)] 685 | (when-let [arg-spec (:args fn-spec)] 686 | (when (invalid? (conform arg-spec args)) 687 | (let [ed (assoc (explain-data* arg-spec [:args] 688 | (if-let [name (spec-name arg-spec)] [name] []) [] args) 689 | ::args args)] 690 | (throw (ex-info 691 | (str 692 | "Call to " (->sym v) " did not conform to spec:\n" 693 | (with-out-str (explain-out ed))) 694 | ed))))))) 695 | 696 | (defmacro fdef 697 | "Takes a symbol naming a function, and one or more of the following: 698 | 699 | :args A regex spec for the function arguments as they were a list to be 700 | passed to apply - in this way, a single spec can handle functions with 701 | multiple arities 702 | :ret A spec for the function's return value 703 | :fn A spec of the relationship between args and ret - the 704 | value passed is {:args conformed-args :ret conformed-ret} and is 705 | expected to contain predicates that relate those values 706 | 707 | Qualifies fn-sym with resolve, or using *ns* if no resolution found. 708 | Registers an fspec in the global registry, where it can be retrieved 709 | by calling get-spec with the var or fully-qualified symbol. 710 | 711 | Once registered, function specs are included in doc, checked by 712 | instrument, tested by the runner clojure.spec.test.alpha/check, and (if 713 | a macro) used to explain errors during macroexpansion. 714 | 715 | Note that :fn specs require the presence of :args and :ret specs to 716 | conform values, and so :fn specs will be ignored if :args or :ret 717 | are missing. 718 | 719 | Returns the qualified fn-sym. 720 | 721 | For example, to register function specs for the symbol function: 722 | 723 | (s/fdef clojure.core/symbol 724 | :args (s/alt :separate (s/cat :ns string? :n string?) 725 | :str string? 726 | :sym symbol?) 727 | :ret symbol?)" 728 | [fn-sym & specs] 729 | `(clojure.spec.alpha/def ~fn-sym (clojure.spec.alpha/fspec ~@specs))) 730 | 731 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 732 | (defn- recur-limit? [rmap id path k] 733 | (c/and (> (get rmap id) (::recursion-limit rmap)) 734 | (contains? (set path) k))) 735 | 736 | (defn- inck [m k] 737 | (assoc m k (inc (c/or (get m k) 0)))) 738 | 739 | (defn- dt 740 | ([pred x form] (dt pred x form nil)) 741 | ([pred x form cpred?] 742 | (if pred 743 | (if-let [spec (the-spec pred)] 744 | (conform spec x) 745 | (if (ifn? pred) 746 | (if cpred? 747 | (pred x) 748 | (if (pred x) x ::invalid)) 749 | (throw (Exception. (str (pr-str form) " is not a fn, expected predicate fn"))))) 750 | x))) 751 | 752 | (defn valid? 753 | "Helper function that returns true when x is valid for spec." 754 | ([spec x] 755 | (let [spec (specize spec)] 756 | (not (invalid? (conform* spec x))))) 757 | ([spec x form] 758 | (let [spec (specize spec form)] 759 | (not (invalid? (conform* spec x)))))) 760 | 761 | (defn- pvalid? 762 | "internal helper function that returns true when x is valid for spec." 763 | ([pred x] 764 | (not (invalid? (dt pred x ::unknown)))) 765 | ([pred x form] 766 | (not (invalid? (dt pred x form))))) 767 | 768 | (defn- explain-1 [form pred path via in v] 769 | ;;(prn {:form form :pred pred :path path :in in :v v}) 770 | (let [pred (maybe-spec pred)] 771 | (if (spec? pred) 772 | (explain* pred path (if-let [name (spec-name pred)] (conj via name) via) in v) 773 | [{:path path :pred form :val v :via via :in in}]))) 774 | 775 | (defn ^:skip-wiki map-spec-impl 776 | "Do not call this directly, use 'spec' with a map argument" 777 | [{:keys [req-un opt-un keys-pred pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn] 778 | :as argm}] 779 | (let [k->s (zipmap (concat req-keys opt-keys) (concat req-specs opt-specs)) 780 | keys->specnames #(c/or (k->s %) %) 781 | id (java.util.UUID/randomUUID)] 782 | (reify 783 | Specize 784 | (specize* [s] s) 785 | (specize* [s _] s) 786 | 787 | Spec 788 | (conform* [_ m] 789 | (if (keys-pred m) 790 | (let [reg (registry)] 791 | (loop [ret m, [[k v] & ks :as keys] (seq m)] 792 | (if keys 793 | (let [sname (keys->specnames k)] 794 | (if-let [s (get reg sname)] 795 | (let [cv (conform s v)] 796 | (if (invalid? cv) 797 | ::invalid 798 | (recur (if (identical? cv v) ret (assoc ret k cv)) 799 | ks))) 800 | (recur ret ks))) 801 | ret))) 802 | ::invalid)) 803 | (unform* [_ m] 804 | (let [reg (registry)] 805 | (loop [ret m, [k & ks :as keys] (c/keys m)] 806 | (if keys 807 | (if (contains? reg (keys->specnames k)) 808 | (let [cv (get m k) 809 | v (unform (keys->specnames k) cv)] 810 | (recur (if (identical? cv v) ret (assoc ret k v)) 811 | ks)) 812 | (recur ret ks)) 813 | ret)))) 814 | (explain* [_ path via in x] 815 | (if-not (map? x) 816 | [{:path path :pred 'map? :val x :via via :in in}] 817 | (let [reg (registry)] 818 | (apply concat 819 | (when-let [probs (->> (map (fn [pred form] (when-not (pred x) form)) 820 | pred-exprs pred-forms) 821 | (keep identity) 822 | seq)] 823 | (map 824 | #(identity {:path path :pred % :val x :via via :in in}) 825 | probs)) 826 | (map (fn [[k v]] 827 | (when-not (c/or (not (contains? reg (keys->specnames k))) 828 | (pvalid? (keys->specnames k) v k)) 829 | (explain-1 (keys->specnames k) (keys->specnames k) (conj path k) via (conj in k) v))) 830 | (seq x)))))) 831 | (gen* [_ overrides path rmap] 832 | (if gfn 833 | (gfn) 834 | (let [rmap (inck rmap id) 835 | gen (fn [k s] (gensub s overrides (conj path k) rmap k)) 836 | ogen (fn [k s] 837 | (when-not (recur-limit? rmap id path k) 838 | [k (gen/delay (gensub s overrides (conj path k) rmap k))])) 839 | req-gens (map gen req-keys req-specs) 840 | opt-gens (remove nil? (map ogen opt-keys opt-specs))] 841 | (when (every? identity (concat req-gens opt-gens)) 842 | (let [reqs (zipmap req-keys req-gens) 843 | opts (into {} opt-gens)] 844 | (gen/bind (gen/choose 0 (count opts)) 845 | #(let [args (concat (seq reqs) (when (seq opts) (shuffle (seq opts))))] 846 | (->> args 847 | (take (c/+ % (count reqs))) 848 | (apply concat) 849 | (apply gen/hash-map))))))))) 850 | (with-gen* [_ gfn] (map-spec-impl (assoc argm :gfn gfn))) 851 | (describe* [_] (cons `keys 852 | (cond-> [] 853 | req (conj :req req) 854 | opt (conj :opt opt) 855 | req-un (conj :req-un req-un) 856 | opt-un (conj :opt-un opt-un))))))) 857 | 858 | 859 | 860 | 861 | (defn ^:skip-wiki spec-impl 862 | "Do not call this directly, use 'spec'" 863 | ([form pred gfn cpred?] (spec-impl form pred gfn cpred? nil)) 864 | ([form pred gfn cpred? unc] 865 | (cond 866 | (spec? pred) (cond-> pred gfn (with-gen gfn)) 867 | (regex? pred) (regex-spec-impl pred gfn) 868 | (ident? pred) (cond-> (the-spec pred) gfn (with-gen gfn)) 869 | :else 870 | (reify 871 | Specize 872 | (specize* [s] s) 873 | (specize* [s _] s) 874 | 875 | Spec 876 | (conform* [_ x] (let [ret (pred x)] 877 | (if cpred? 878 | ret 879 | (if ret x ::invalid)))) 880 | (unform* [_ x] (if cpred? 881 | (if unc 882 | (unc x) 883 | (throw (IllegalStateException. "no unform fn for conformer"))) 884 | x)) 885 | (explain* [_ path via in x] 886 | (when (invalid? (dt pred x form cpred?)) 887 | [{:path path :pred form :val x :via via :in in}])) 888 | (gen* [_ _ _ _] (if gfn 889 | (gfn) 890 | (gen/gen-for-pred pred))) 891 | (with-gen* [_ gfn] (spec-impl form pred gfn cpred? unc)) 892 | (describe* [_] form))))) 893 | 894 | (defn ^:skip-wiki multi-spec-impl 895 | "Do not call this directly, use 'multi-spec'" 896 | ([form mmvar retag] (multi-spec-impl form mmvar retag nil)) 897 | ([form mmvar retag gfn] 898 | (let [id (java.util.UUID/randomUUID) 899 | predx #(let [^clojure.lang.MultiFn mm @mmvar] 900 | (c/and (.getMethod mm ((.dispatchFn mm) %)) 901 | (mm %))) 902 | dval #((.dispatchFn ^clojure.lang.MultiFn @mmvar) %) 903 | tag (if (keyword? retag) 904 | #(assoc %1 retag %2) 905 | retag)] 906 | (reify 907 | Specize 908 | (specize* [s] s) 909 | (specize* [s _] s) 910 | 911 | Spec 912 | (conform* [_ x] (if-let [pred (predx x)] 913 | (dt pred x form) 914 | ::invalid)) 915 | (unform* [_ x] (if-let [pred (predx x)] 916 | (unform pred x) 917 | (throw (IllegalStateException. (str "No method of: " form " for dispatch value: " (dval x)))))) 918 | (explain* [_ path via in x] 919 | (let [dv (dval x) 920 | path (conj path dv)] 921 | (if-let [pred (predx x)] 922 | (explain-1 form pred path via in x) 923 | [{:path path :pred form :val x :reason "no method" :via via :in in}]))) 924 | (gen* [_ overrides path rmap] 925 | (if gfn 926 | (gfn) 927 | (let [gen (fn [[k f]] 928 | (let [p (f nil)] 929 | (let [rmap (inck rmap id)] 930 | (when-not (recur-limit? rmap id path k) 931 | (gen/delay 932 | (gen/fmap 933 | #(tag % k) 934 | (gensub p overrides (conj path k) rmap (list 'method form k)))))))) 935 | gs (->> (methods @mmvar) 936 | (remove (fn [[k]] (invalid? k))) 937 | (map gen) 938 | (remove nil?))] 939 | (when (every? identity gs) 940 | (gen/one-of gs))))) 941 | (with-gen* [_ gfn] (multi-spec-impl form mmvar retag gfn)) 942 | (describe* [_] `(multi-spec ~form ~retag)))))) 943 | 944 | (defn ^:skip-wiki tuple-impl 945 | "Do not call this directly, use 'tuple'" 946 | ([forms preds] (tuple-impl forms preds nil)) 947 | ([forms preds gfn] 948 | (let [specs (delay (mapv specize preds forms)) 949 | cnt (count preds)] 950 | (reify 951 | Specize 952 | (specize* [s] s) 953 | (specize* [s _] s) 954 | 955 | Spec 956 | (conform* [_ x] 957 | (let [specs @specs] 958 | (if-not (c/and (vector? x) 959 | (= (count x) cnt)) 960 | ::invalid 961 | (loop [ret x, i 0] 962 | (if (= i cnt) 963 | ret 964 | (let [v (x i) 965 | cv (conform* (specs i) v)] 966 | (if (invalid? cv) 967 | ::invalid 968 | (recur (if (identical? cv v) ret (assoc ret i cv)) 969 | (inc i))))))))) 970 | (unform* [_ x] 971 | (c/assert (c/and (vector? x) 972 | (= (count x) (count preds)))) 973 | (loop [ret x, i 0] 974 | (if (= i (count x)) 975 | ret 976 | (let [cv (x i) 977 | v (unform (preds i) cv)] 978 | (recur (if (identical? cv v) ret (assoc ret i v)) 979 | (inc i)))))) 980 | (explain* [_ path via in x] 981 | (cond 982 | (not (vector? x)) 983 | [{:path path :pred 'vector? :val x :via via :in in}] 984 | 985 | (not= (count x) (count preds)) 986 | [{:path path :pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}] 987 | 988 | :else 989 | (apply concat 990 | (map (fn [i form pred] 991 | (let [v (x i)] 992 | (when-not (pvalid? pred v) 993 | (explain-1 form pred (conj path i) via (conj in i) v)))) 994 | (range (count preds)) forms preds)))) 995 | (gen* [_ overrides path rmap] 996 | (if gfn 997 | (gfn) 998 | (let [gen (fn [i p f] 999 | (gensub p overrides (conj path i) rmap f)) 1000 | gs (map gen (range (count preds)) preds forms)] 1001 | (when (every? identity gs) 1002 | (apply gen/tuple gs))))) 1003 | (with-gen* [_ gfn] (tuple-impl forms preds gfn)) 1004 | (describe* [_] `(tuple ~@forms)))))) 1005 | 1006 | (defn- tagged-ret [tag ret] 1007 | (clojure.lang.MapEntry. tag ret)) 1008 | 1009 | (defn ^:skip-wiki or-spec-impl 1010 | "Do not call this directly, use 'or'" 1011 | [keys forms preds gfn] 1012 | (let [id (java.util.UUID/randomUUID) 1013 | kps (zipmap keys preds) 1014 | specs (delay (mapv specize preds forms)) 1015 | cform (case (count preds) 1016 | 2 (fn [x] 1017 | (let [specs @specs 1018 | ret (conform* (specs 0) x)] 1019 | (if (invalid? ret) 1020 | (let [ret (conform* (specs 1) x)] 1021 | (if (invalid? ret) 1022 | ::invalid 1023 | (tagged-ret (keys 1) ret))) 1024 | (tagged-ret (keys 0) ret)))) 1025 | 3 (fn [x] 1026 | (let [specs @specs 1027 | ret (conform* (specs 0) x)] 1028 | (if (invalid? ret) 1029 | (let [ret (conform* (specs 1) x)] 1030 | (if (invalid? ret) 1031 | (let [ret (conform* (specs 2) x)] 1032 | (if (invalid? ret) 1033 | ::invalid 1034 | (tagged-ret (keys 2) ret))) 1035 | (tagged-ret (keys 1) ret))) 1036 | (tagged-ret (keys 0) ret)))) 1037 | (fn [x] 1038 | (let [specs @specs] 1039 | (loop [i 0] 1040 | (if (< i (count specs)) 1041 | (let [spec (specs i)] 1042 | (let [ret (conform* spec x)] 1043 | (if (invalid? ret) 1044 | (recur (inc i)) 1045 | (tagged-ret (keys i) ret)))) 1046 | ::invalid)))))] 1047 | (reify 1048 | Specize 1049 | (specize* [s] s) 1050 | (specize* [s _] s) 1051 | 1052 | Spec 1053 | (conform* [_ x] (cform x)) 1054 | (unform* [_ [k x]] (unform (kps k) x)) 1055 | (explain* [this path via in x] 1056 | (when-not (pvalid? this x) 1057 | (apply concat 1058 | (map (fn [k form pred] 1059 | (when-not (pvalid? pred x) 1060 | (explain-1 form pred (conj path k) via in x))) 1061 | keys forms preds)))) 1062 | (gen* [_ overrides path rmap] 1063 | (if gfn 1064 | (gfn) 1065 | (let [gen (fn [k p f] 1066 | (let [rmap (inck rmap id)] 1067 | (when-not (recur-limit? rmap id path k) 1068 | (gen/delay 1069 | (gensub p overrides (conj path k) rmap f))))) 1070 | gs (remove nil? (map gen keys preds forms))] 1071 | (when-not (empty? gs) 1072 | (gen/one-of gs))))) 1073 | (with-gen* [_ gfn] (or-spec-impl keys forms preds gfn)) 1074 | (describe* [_] `(or ~@(mapcat vector keys forms)))))) 1075 | 1076 | (defn- and-preds [x preds forms] 1077 | (loop [ret x 1078 | [pred & preds] preds 1079 | [form & forms] forms] 1080 | (if pred 1081 | (let [nret (dt pred ret form)] 1082 | (if (invalid? nret) 1083 | ::invalid 1084 | ;;propagate conformed values 1085 | (recur nret preds forms))) 1086 | ret))) 1087 | 1088 | (defn- explain-pred-list 1089 | [forms preds path via in x] 1090 | (loop [ret x 1091 | [form & forms] forms 1092 | [pred & preds] preds] 1093 | (when pred 1094 | (let [nret (dt pred ret form)] 1095 | (if (invalid? nret) 1096 | (explain-1 form pred path via in ret) 1097 | (recur nret forms preds)))))) 1098 | 1099 | (defn ^:skip-wiki and-spec-impl 1100 | "Do not call this directly, use 'and'" 1101 | [forms preds gfn] 1102 | (let [specs (delay (mapv specize preds forms)) 1103 | cform 1104 | (case (count preds) 1105 | 2 (fn [x] 1106 | (let [specs @specs 1107 | ret (conform* (specs 0) x)] 1108 | (if (invalid? ret) 1109 | ::invalid 1110 | (conform* (specs 1) ret)))) 1111 | 3 (fn [x] 1112 | (let [specs @specs 1113 | ret (conform* (specs 0) x)] 1114 | (if (invalid? ret) 1115 | ::invalid 1116 | (let [ret (conform* (specs 1) ret)] 1117 | (if (invalid? ret) 1118 | ::invalid 1119 | (conform* (specs 2) ret)))))) 1120 | (fn [x] 1121 | (let [specs @specs] 1122 | (loop [ret x i 0] 1123 | (if (< i (count specs)) 1124 | (let [nret (conform* (specs i) ret)] 1125 | (if (invalid? nret) 1126 | ::invalid 1127 | ;;propagate conformed values 1128 | (recur nret (inc i)))) 1129 | ret)))))] 1130 | (reify 1131 | Specize 1132 | (specize* [s] s) 1133 | (specize* [s _] s) 1134 | 1135 | Spec 1136 | (conform* [_ x] (cform x)) 1137 | (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) 1138 | (explain* [_ path via in x] (explain-pred-list forms preds path via in x)) 1139 | (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms)))) 1140 | (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) 1141 | (describe* [_] `(and ~@forms))))) 1142 | 1143 | (defn ^:skip-wiki merge-spec-impl 1144 | "Do not call this directly, use 'merge'" 1145 | [forms preds gfn] 1146 | (reify 1147 | Specize 1148 | (specize* [s] s) 1149 | (specize* [s _] s) 1150 | 1151 | Spec 1152 | (conform* [_ x] (let [ms (map #(dt %1 x %2) preds forms)] 1153 | (if (some invalid? ms) 1154 | ::invalid 1155 | (apply c/merge ms)))) 1156 | (unform* [_ x] (apply c/merge (map #(unform % x) (reverse preds)))) 1157 | (explain* [_ path via in x] 1158 | (apply concat 1159 | (map #(explain-1 %1 %2 path via in x) 1160 | forms preds))) 1161 | (gen* [_ overrides path rmap] 1162 | (if gfn 1163 | (gfn) 1164 | (gen/fmap 1165 | #(apply c/merge %) 1166 | (apply gen/tuple (map #(gensub %1 overrides path rmap %2) 1167 | preds forms))))) 1168 | (with-gen* [_ gfn] (merge-spec-impl forms preds gfn)) 1169 | (describe* [_] `(merge ~@forms)))) 1170 | 1171 | (defn- coll-prob [x kfn kform distinct count min-count max-count 1172 | path via in] 1173 | (let [pred (c/or kfn coll?) 1174 | kform (c/or kform `coll?)] 1175 | (cond 1176 | (not (pvalid? pred x)) 1177 | (explain-1 kform pred path via in x) 1178 | 1179 | (c/and count (not= count (bounded-count count x))) 1180 | [{:path path :pred `(= ~count (c/count ~'%)) :val x :via via :in in}] 1181 | 1182 | (c/and (c/or min-count max-count) 1183 | (not (<= (c/or min-count 0) 1184 | (bounded-count (if max-count (inc max-count) min-count) x) 1185 | (c/or max-count Integer/MAX_VALUE)))) 1186 | [{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}] 1187 | 1188 | (c/and distinct (not (empty? x)) (not (apply distinct? x))) 1189 | [{:path path :pred 'distinct? :val x :via via :in in}]))) 1190 | 1191 | (def ^:private empty-coll {`vector? [], `set? #{}, `list? (), `map? {}}) 1192 | 1193 | (defn ^:skip-wiki every-impl 1194 | "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'" 1195 | ([form pred opts] (every-impl form pred opts nil)) 1196 | ([form pred {conform-into :into 1197 | describe-form ::describe 1198 | :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn ::cpred 1199 | conform-keys ::conform-all] 1200 | :or {gen-max 20} 1201 | :as opts} 1202 | gfn] 1203 | (let [gen-into (if conform-into (empty conform-into) (get empty-coll kind-form)) 1204 | spec (delay (specize pred)) 1205 | check? #(valid? @spec %) 1206 | kfn (c/or kfn (fn [i v] i)) 1207 | addcv (fn [ret i v cv] (conj ret cv)) 1208 | cfns (fn [x] 1209 | ;;returns a tuple of [init add complete] fns 1210 | (cond 1211 | (c/and (vector? x) (c/or (not conform-into) (vector? conform-into))) 1212 | [identity 1213 | (fn [ret i v cv] 1214 | (if (identical? v cv) 1215 | ret 1216 | (assoc ret i cv))) 1217 | identity] 1218 | 1219 | (c/and (map? x) (c/or (c/and kind (not conform-into)) (map? conform-into))) 1220 | [(if conform-keys empty identity) 1221 | (fn [ret i v cv] 1222 | (if (c/and (identical? v cv) (not conform-keys)) 1223 | ret 1224 | (assoc ret (nth (if conform-keys cv v) 0) (nth cv 1)))) 1225 | identity] 1226 | 1227 | (c/or (list? conform-into) (seq? conform-into) (c/and (not conform-into) (c/or (list? x) (seq? x)))) 1228 | [(constantly ()) addcv reverse] 1229 | 1230 | :else [#(empty (c/or conform-into %)) addcv identity]))] 1231 | (reify 1232 | Specize 1233 | (specize* [s] s) 1234 | (specize* [s _] s) 1235 | 1236 | Spec 1237 | (conform* [_ x] 1238 | (let [spec @spec] 1239 | (cond 1240 | (not (cpred x)) ::invalid 1241 | 1242 | conform-all 1243 | (let [[init add complete] (cfns x)] 1244 | (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)] 1245 | (if vseq 1246 | (let [cv (conform* spec v)] 1247 | (if (invalid? cv) 1248 | ::invalid 1249 | (recur (add ret i v cv) (inc i) vs))) 1250 | (complete ret)))) 1251 | 1252 | 1253 | :else 1254 | (if (indexed? x) 1255 | (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))] 1256 | (loop [i 0] 1257 | (if (>= i (c/count x)) 1258 | x 1259 | (if (valid? spec (nth x i)) 1260 | (recur (c/+ i step)) 1261 | ::invalid)))) 1262 | (let [limit *coll-check-limit*] 1263 | (loop [i 0 [v & vs :as vseq] (seq x)] 1264 | (cond 1265 | (c/or (nil? vseq) (= i limit)) x 1266 | (valid? spec v) (recur (inc i) vs) 1267 | :else ::invalid))))))) 1268 | (unform* [_ x] 1269 | (if conform-all 1270 | (let [spec @spec 1271 | [init add complete] (cfns x)] 1272 | (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)] 1273 | (if (>= i (c/count x)) 1274 | (complete ret) 1275 | (recur (add ret i v (unform* spec v)) (inc i) vs)))) 1276 | x)) 1277 | (explain* [_ path via in x] 1278 | (c/or (coll-prob x kind kind-form distinct count min-count max-count 1279 | path via in) 1280 | (apply concat 1281 | ((if conform-all identity (partial take *coll-error-limit*)) 1282 | (keep identity 1283 | (map (fn [i v] 1284 | (let [k (kfn i v)] 1285 | (when-not (check? v) 1286 | (let [prob (explain-1 form pred path via (conj in k) v)] 1287 | prob)))) 1288 | (range) x)))))) 1289 | (gen* [_ overrides path rmap] 1290 | (if gfn 1291 | (gfn) 1292 | (let [pgen (gensub pred overrides path rmap form)] 1293 | (gen/bind 1294 | (cond 1295 | gen-into (gen/return gen-into) 1296 | kind (gen/fmap #(if (empty? %) % (empty %)) 1297 | (gensub kind overrides path rmap form)) 1298 | :else (gen/return [])) 1299 | (fn [init] 1300 | (gen/fmap 1301 | #(if (vector? init) % (into init %)) 1302 | (cond 1303 | distinct 1304 | (if count 1305 | (gen/vector-distinct pgen {:num-elements count :max-tries 100}) 1306 | (gen/vector-distinct pgen {:min-elements (c/or min-count 0) 1307 | :max-elements (c/or max-count (max gen-max (c/* 2 (c/or min-count 0)))) 1308 | :max-tries 100})) 1309 | 1310 | count 1311 | (gen/vector pgen count) 1312 | 1313 | (c/or min-count max-count) 1314 | (gen/vector pgen (c/or min-count 0) (c/or max-count (max gen-max (c/* 2 (c/or min-count 0))))) 1315 | 1316 | :else 1317 | (gen/vector pgen 0 gen-max)))))))) 1318 | 1319 | (with-gen* [_ gfn] (every-impl form pred opts gfn)) 1320 | (describe* [_] (c/or describe-form `(every ~(res form) ~@(mapcat identity opts)))))))) 1321 | 1322 | ;;;;;;;;;;;;;;;;;;;;;;; regex ;;;;;;;;;;;;;;;;;;; 1323 | ;;See: 1324 | ;; http://matt.might.net/articles/implementation-of-regular-expression-matching-in-scheme-with-derivatives/ 1325 | ;; http://www.ccs.neu.edu/home/turon/re-deriv.pdf 1326 | 1327 | ;;ctors 1328 | (defn- accept [x] {::op ::accept :ret x}) 1329 | 1330 | (defn- accept? [{:keys [::op]}] 1331 | (= ::accept op)) 1332 | 1333 | (defn- pcat* [{[p1 & pr :as ps] :ps, [k1 & kr :as ks] :ks, [f1 & fr :as forms] :forms, ret :ret, rep+ :rep+}] 1334 | (when (every? identity ps) 1335 | (if (accept? p1) 1336 | (let [rp (:ret p1) 1337 | ret (conj ret (if ks {k1 rp} rp))] 1338 | (if pr 1339 | (pcat* {:ps pr :ks kr :forms fr :ret ret}) 1340 | (accept ret))) 1341 | {::op ::pcat, :ps ps, :ret ret, :ks ks, :forms forms :rep+ rep+}))) 1342 | 1343 | (defn- pcat [& ps] (pcat* {:ps ps :ret []})) 1344 | 1345 | (defn ^:skip-wiki cat-impl 1346 | "Do not call this directly, use 'cat'" 1347 | [ks ps forms] 1348 | (pcat* {:ks ks, :ps ps, :forms forms, :ret {}})) 1349 | 1350 | (defn- rep* [p1 p2 ret splice form] 1351 | (when p1 1352 | (let [r {::op ::rep, :p2 p2, :splice splice, :forms form :id (java.util.UUID/randomUUID)}] 1353 | (if (accept? p1) 1354 | (assoc r :p1 p2 :ret (conj ret (:ret p1))) 1355 | (assoc r :p1 p1, :ret ret))))) 1356 | 1357 | (defn ^:skip-wiki rep-impl 1358 | "Do not call this directly, use '*'" 1359 | [form p] (rep* p p [] false form)) 1360 | 1361 | (defn ^:skip-wiki rep+impl 1362 | "Do not call this directly, use '+'" 1363 | [form p] 1364 | (pcat* {:ps [p (rep* p p [] true form)] :forms `[~form (* ~form)] :ret [] :rep+ form})) 1365 | 1366 | (defn ^:skip-wiki amp-impl 1367 | "Do not call this directly, use '&'" 1368 | [re preds pred-forms] 1369 | {::op ::amp :p1 re :ps preds :forms pred-forms}) 1370 | 1371 | (defn- filter-alt [ps ks forms f] 1372 | (if (c/or ks forms) 1373 | (let [pks (->> (map vector ps 1374 | (c/or (seq ks) (repeat nil)) 1375 | (c/or (seq forms) (repeat nil))) 1376 | (filter #(-> % first f)))] 1377 | [(seq (map first pks)) (when ks (seq (map second pks))) (when forms (seq (map #(nth % 2) pks)))]) 1378 | [(seq (filter f ps)) ks forms])) 1379 | 1380 | (defn- alt* [ps ks forms] 1381 | (let [[[p1 & pr :as ps] [k1 :as ks] forms] (filter-alt ps ks forms identity)] 1382 | (when ps 1383 | (let [ret {::op ::alt, :ps ps, :ks ks :forms forms}] 1384 | (if (nil? pr) 1385 | (if k1 1386 | (if (accept? p1) 1387 | (accept (tagged-ret k1 (:ret p1))) 1388 | ret) 1389 | p1) 1390 | ret))))) 1391 | 1392 | (defn- alts [& ps] (alt* ps nil nil)) 1393 | (defn- alt2 [p1 p2] (if (c/and p1 p2) (alts p1 p2) (c/or p1 p2))) 1394 | 1395 | (defn ^:skip-wiki alt-impl 1396 | "Do not call this directly, use 'alt'" 1397 | [ks ps forms] (assoc (alt* ps ks forms) :id (java.util.UUID/randomUUID))) 1398 | 1399 | (defn ^:skip-wiki maybe-impl 1400 | "Do not call this directly, use '?'" 1401 | [p form] (assoc (alt* [p (accept ::nil)] nil [form ::nil]) :maybe form)) 1402 | 1403 | (defn- noret? [p1 pret] 1404 | (c/or (= pret ::nil) 1405 | (c/and (#{::rep ::pcat} (::op (reg-resolve! p1))) ;;hrm, shouldn't know these 1406 | (empty? pret)) 1407 | nil)) 1408 | 1409 | (declare preturn) 1410 | 1411 | (defn- accept-nil? [p] 1412 | (let [{:keys [::op ps p1 p2 forms] :as p} (reg-resolve! p)] 1413 | (case op 1414 | ::accept true 1415 | nil nil 1416 | ::amp (c/and (accept-nil? p1) 1417 | (c/or (noret? p1 (preturn p1)) 1418 | (let [ret (-> (preturn p1) (and-preds ps (next forms)))] 1419 | (not (invalid? ret))))) 1420 | ::rep (c/or (identical? p1 p2) (accept-nil? p1)) 1421 | ::pcat (every? accept-nil? ps) 1422 | ::alt (c/some accept-nil? ps)))) 1423 | 1424 | (declare add-ret) 1425 | 1426 | (defn- preturn [p] 1427 | (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms] :as p} (reg-resolve! p)] 1428 | (case op 1429 | ::accept ret 1430 | nil nil 1431 | ::amp (let [pret (preturn p1)] 1432 | (if (noret? p1 pret) 1433 | ::nil 1434 | (and-preds pret ps forms))) 1435 | ::rep (add-ret p1 ret k) 1436 | ::pcat (add-ret p0 ret k) 1437 | ::alt (let [[[p0] [k0]] (filter-alt ps ks forms accept-nil?) 1438 | r (if (nil? p0) ::nil (preturn p0))] 1439 | (if k0 (tagged-ret k0 r) r))))) 1440 | 1441 | (defn- op-unform [p x] 1442 | ;;(prn {:p p :x x}) 1443 | (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms rep+ maybe] :as p} (reg-resolve! p) 1444 | kps (zipmap ks ps)] 1445 | (case op 1446 | ::accept [ret] 1447 | nil [(unform p x)] 1448 | ::amp (let [px (reduce #(unform %2 %1) x (reverse ps))] 1449 | (op-unform p1 px)) 1450 | ::rep (mapcat #(op-unform p1 %) x) 1451 | ::pcat (if rep+ 1452 | (mapcat #(op-unform p0 %) x) 1453 | (mapcat (fn [k] 1454 | (when (contains? x k) 1455 | (op-unform (kps k) (get x k)))) 1456 | ks)) 1457 | ::alt (if maybe 1458 | [(unform p0 x)] 1459 | (let [[k v] x] 1460 | (op-unform (kps k) v)))))) 1461 | 1462 | (defn- add-ret [p r k] 1463 | (let [{:keys [::op ps splice] :as p} (reg-resolve! p) 1464 | prop #(let [ret (preturn p)] 1465 | (if (empty? ret) r ((if splice into conj) r (if k {k ret} ret))))] 1466 | (case op 1467 | nil r 1468 | (::alt ::accept ::amp) 1469 | (let [ret (preturn p)] 1470 | ;;(prn {:ret ret}) 1471 | (if (= ret ::nil) r (conj r (if k {k ret} ret)))) 1472 | 1473 | (::rep ::pcat) (prop)))) 1474 | 1475 | (defn- deriv 1476 | [p x] 1477 | (let [{[p0 & pr :as ps] :ps, [k0 & kr :as ks] :ks, :keys [::op p1 p2 ret splice forms] :as p} (reg-resolve! p)] 1478 | (when p 1479 | (case op 1480 | ::accept nil 1481 | nil (let [ret (dt p x p)] 1482 | (when-not (invalid? ret) (accept ret))) 1483 | ::amp (when-let [p1 (deriv p1 x)] 1484 | (if (= ::accept (::op p1)) 1485 | (let [ret (-> (preturn p1) (and-preds ps (next forms)))] 1486 | (when-not (invalid? ret) 1487 | (accept ret))) 1488 | (amp-impl p1 ps forms))) 1489 | ::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret}) 1490 | (when (accept-nil? p0) (deriv (pcat* {:ps pr, :ks kr, :forms (next forms), :ret (add-ret p0 ret k0)}) x))) 1491 | ::alt (alt* (map #(deriv % x) ps) ks forms) 1492 | ::rep (alt2 (rep* (deriv p1 x) p2 ret splice forms) 1493 | (when (accept-nil? p1) (deriv (rep* p2 p2 (add-ret p1 ret nil) splice forms) x))))))) 1494 | 1495 | (defn- op-describe [p] 1496 | (let [{:keys [::op ps ks forms splice p1 rep+ maybe] :as p} (reg-resolve! p)] 1497 | ;;(prn {:op op :ks ks :forms forms :p p}) 1498 | (when p 1499 | (case op 1500 | ::accept nil 1501 | nil p 1502 | ::amp (list* 'clojure.spec.alpha/& (op-describe p1) forms) 1503 | ::pcat (if rep+ 1504 | (list `+ rep+) 1505 | (cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) forms))) 1506 | ::alt (if maybe 1507 | (list `? maybe) 1508 | (cons `alt (mapcat vector ks forms))) 1509 | ::rep (list (if splice `+ `*) forms))))) 1510 | 1511 | (defn- op-explain [form p path via in input] 1512 | ;;(prn {:form form :p p :path path :input input}) 1513 | (let [[x :as input] input 1514 | {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve! p) 1515 | via (if-let [name (spec-name p)] (conj via name) via) 1516 | insufficient (fn [path form] 1517 | [{:path path 1518 | :reason "Insufficient input" 1519 | :pred form 1520 | :val () 1521 | :via via 1522 | :in in}])] 1523 | (when p 1524 | (case op 1525 | ::accept nil 1526 | nil (if (empty? input) 1527 | (insufficient path form) 1528 | (explain-1 form p path via in x)) 1529 | ::amp (if (empty? input) 1530 | (if (accept-nil? p1) 1531 | (explain-pred-list forms ps path via in (preturn p1)) 1532 | (insufficient path (op-describe p1))) 1533 | (if-let [p1 (deriv p1 x)] 1534 | (explain-pred-list forms ps path via in (preturn p1)) 1535 | (op-explain (op-describe p1) p1 path via in input))) 1536 | ::pcat (let [pkfs (map vector 1537 | ps 1538 | (c/or (seq ks) (repeat nil)) 1539 | (c/or (seq forms) (repeat nil))) 1540 | [pred k form] (if (= 1 (count pkfs)) 1541 | (first pkfs) 1542 | (first (remove (fn [[p]] (accept-nil? p)) pkfs))) 1543 | path (if k (conj path k) path) 1544 | form (c/or form (op-describe pred))] 1545 | (if (c/and (empty? input) (not pred)) 1546 | (insufficient path form) 1547 | (op-explain form pred path via in input))) 1548 | ::alt (if (empty? input) 1549 | (insufficient path (op-describe p)) 1550 | (apply concat 1551 | (map (fn [k form pred] 1552 | (op-explain (c/or form (op-describe pred)) 1553 | pred 1554 | (if k (conj path k) path) 1555 | via 1556 | in 1557 | input)) 1558 | (c/or (seq ks) (repeat nil)) 1559 | (c/or (seq forms) (repeat nil)) 1560 | ps))) 1561 | ::rep (op-explain (if (identical? p1 p2) 1562 | forms 1563 | (op-describe p1)) 1564 | p1 path via in input))))) 1565 | 1566 | (defn- re-gen [p overrides path rmap f] 1567 | ;;(prn {:op op :ks ks :forms forms}) 1568 | (let [origp p 1569 | {:keys [::op ps ks p1 p2 forms splice ret id ::gfn] :as p} (reg-resolve! p) 1570 | rmap (if id (inck rmap id) rmap) 1571 | ggens (fn [ps ks forms] 1572 | (let [gen (fn [p k f] 1573 | ;;(prn {:k k :path path :rmap rmap :op op :id id}) 1574 | (when-not (c/and rmap id k (recur-limit? rmap id path k)) 1575 | (if id 1576 | (gen/delay (re-gen p overrides (if k (conj path k) path) rmap (c/or f p))) 1577 | (re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))))] 1578 | (map gen ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)))))] 1579 | (c/or (when-let [gfn (c/or (get overrides (spec-name origp)) 1580 | (get overrides (spec-name p) ) 1581 | (get overrides path))] 1582 | (case op 1583 | (:accept nil) (gen/fmap vector (gfn)) 1584 | (gfn))) 1585 | (when gfn 1586 | (gfn)) 1587 | (when p 1588 | (case op 1589 | ::accept (if (= ret ::nil) 1590 | (gen/return []) 1591 | (gen/return [ret])) 1592 | nil (when-let [g (gensub p overrides path rmap f)] 1593 | (gen/fmap vector g)) 1594 | ::amp (re-gen p1 overrides path rmap (op-describe p1)) 1595 | ::pcat (let [gens (ggens ps ks forms)] 1596 | (when (every? identity gens) 1597 | (apply gen/cat gens))) 1598 | ::alt (let [gens (remove nil? (ggens ps ks forms))] 1599 | (when-not (empty? gens) 1600 | (gen/one-of gens))) 1601 | ::rep (if (recur-limit? rmap id [id] id) 1602 | (gen/return []) 1603 | (when-let [g (re-gen p2 overrides path rmap forms)] 1604 | (gen/fmap #(apply concat %) 1605 | (gen/vector g))))))))) 1606 | 1607 | (defn- re-conform [p [x & xs :as data]] 1608 | ;;(prn {:p p :x x :xs xs}) 1609 | (if (empty? data) 1610 | (if (accept-nil? p) 1611 | (let [ret (preturn p)] 1612 | (if (= ret ::nil) 1613 | nil 1614 | ret)) 1615 | ::invalid) 1616 | (if-let [dp (deriv p x)] 1617 | (recur dp xs) 1618 | ::invalid))) 1619 | 1620 | (defn- re-explain [path via in re input] 1621 | (loop [p re [x & xs :as data] input i 0] 1622 | ;;(prn {:p p :x x :xs xs :re re}) (prn) 1623 | (if (empty? data) 1624 | (if (accept-nil? p) 1625 | nil ;;success 1626 | (op-explain (op-describe p) p path via in nil)) 1627 | (if-let [dp (deriv p x)] 1628 | (recur dp xs (inc i)) 1629 | (if (accept? p) 1630 | (if (= (::op p) ::pcat) 1631 | (op-explain (op-describe p) p path via (conj in i) (seq data)) 1632 | [{:path path 1633 | :reason "Extra input" 1634 | :pred (op-describe re) 1635 | :val data 1636 | :via via 1637 | :in (conj in i)}]) 1638 | (c/or (op-explain (op-describe p) p path via (conj in i) (seq data)) 1639 | [{:path path 1640 | :reason "Extra input" 1641 | :pred (op-describe p) 1642 | :val data 1643 | :via via 1644 | :in (conj in i)}])))))) 1645 | 1646 | (defn ^:skip-wiki regex-spec-impl 1647 | "Do not call this directly, use 'spec' with a regex op argument" 1648 | [re gfn] 1649 | (reify 1650 | Specize 1651 | (specize* [s] s) 1652 | (specize* [s _] s) 1653 | 1654 | Spec 1655 | (conform* [_ x] 1656 | (if (c/or (nil? x) (coll? x)) 1657 | (re-conform re (seq x)) 1658 | ::invalid)) 1659 | (unform* [_ x] (op-unform re x)) 1660 | (explain* [_ path via in x] 1661 | (if (c/or (nil? x) (coll? x)) 1662 | (re-explain path via in re (seq x)) 1663 | [{:path path :pred (op-describe re) :val x :via via :in in}])) 1664 | (gen* [_ overrides path rmap] 1665 | (if gfn 1666 | (gfn) 1667 | (re-gen re overrides path rmap (op-describe re)))) 1668 | (with-gen* [_ gfn] (regex-spec-impl re gfn)) 1669 | (describe* [_] (op-describe re)))) 1670 | 1671 | ;;;;;;;;;;;;;;;;; HOFs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1672 | 1673 | (defn- call-valid? 1674 | [f specs args] 1675 | (let [cargs (conform (:args specs) args)] 1676 | (when-not (invalid? cargs) 1677 | (let [ret (apply f args) 1678 | cret (conform (:ret specs) ret)] 1679 | (c/and (not (invalid? cret)) 1680 | (if (:fn specs) 1681 | (pvalid? (:fn specs) {:args cargs :ret cret}) 1682 | true)))))) 1683 | 1684 | (defn- validate-fn 1685 | "returns f if valid, else smallest" 1686 | [f specs iters] 1687 | (let [g (gen (:args specs)) 1688 | prop (gen/for-all* [g] #(call-valid? f specs %))] 1689 | (let [ret (gen/quick-check iters prop)] 1690 | (if-let [[smallest] (-> ret :shrunk :smallest)] 1691 | smallest 1692 | f)))) 1693 | 1694 | (defn ^:skip-wiki fspec-impl 1695 | "Do not call this directly, use 'fspec'" 1696 | [argspec aform retspec rform fnspec fform gfn] 1697 | (let [specs {:args argspec :ret retspec :fn fnspec}] 1698 | (reify 1699 | clojure.lang.ILookup 1700 | (valAt [this k] (get specs k)) 1701 | (valAt [_ k not-found] (get specs k not-found)) 1702 | 1703 | Specize 1704 | (specize* [s] s) 1705 | (specize* [s _] s) 1706 | 1707 | Spec 1708 | (conform* [this f] (if argspec 1709 | (if (ifn? f) 1710 | (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) 1711 | ::invalid) 1712 | (throw (Exception. (str "Can't conform fspec without args spec: " (pr-str (describe this))))))) 1713 | (unform* [_ f] f) 1714 | (explain* [_ path via in f] 1715 | (if (ifn? f) 1716 | (let [args (validate-fn f specs 100)] 1717 | (if (identical? f args) ;;hrm, we might not be able to reproduce 1718 | nil 1719 | (let [ret (try (apply f args) (catch Throwable t t))] 1720 | (if (instance? Throwable ret) 1721 | ;;TODO add exception data 1722 | [{:path path :pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via :in in}] 1723 | 1724 | (let [cret (dt retspec ret rform)] 1725 | (if (invalid? cret) 1726 | (explain-1 rform retspec (conj path :ret) via in ret) 1727 | (when fnspec 1728 | (let [cargs (conform argspec args)] 1729 | (explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret}))))))))) 1730 | [{:path path :pred 'ifn? :val f :via via :in in}])) 1731 | (gen* [_ overrides _ _] (if gfn 1732 | (gfn) 1733 | (gen/return 1734 | (fn [& args] 1735 | (c/assert (pvalid? argspec args) (with-out-str (explain argspec args))) 1736 | (gen/generate (gen retspec overrides)))))) 1737 | (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn)) 1738 | (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform))))) 1739 | 1740 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1741 | (clojure.spec.alpha/def ::kvs->map (conformer #(zipmap (map ::k %) (map ::v %)) #(map (fn [[k v]] {::k k ::v v}) %))) 1742 | 1743 | (defmacro keys* 1744 | "takes the same arguments as spec/keys and returns a regex op that matches sequences of key/values, 1745 | converts them into a map, and conforms that map with a corresponding 1746 | spec/keys call: 1747 | 1748 | user=> (s/conform (s/keys :req-un [::a ::c]) {:a 1 :c 2}) 1749 | {:a 1, :c 2} 1750 | user=> (s/conform (s/keys* :req-un [::a ::c]) [:a 1 :c 2]) 1751 | {:a 1, :c 2} 1752 | 1753 | the resulting regex op can be composed into a larger regex: 1754 | 1755 | user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99]) 1756 | {:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}" 1757 | [& kspecs] 1758 | `(let [mspec# (keys ~@kspecs)] 1759 | (with-gen (clojure.spec.alpha/& (* (cat ::k keyword? ::v any?)) ::kvs->map mspec#) 1760 | (fn [] (gen/fmap (fn [m#] (apply concat m#)) (gen mspec#)))))) 1761 | 1762 | (defn ^:skip-wiki nonconforming 1763 | "takes a spec and returns a spec that has the same properties except 1764 | 'conform' returns the original (not the conformed) value. Note, will specize regex ops." 1765 | [spec] 1766 | (let [spec (delay (specize spec))] 1767 | (reify 1768 | Specize 1769 | (specize* [s] s) 1770 | (specize* [s _] s) 1771 | 1772 | Spec 1773 | (conform* [_ x] (let [ret (conform* @spec x)] 1774 | (if (invalid? ret) 1775 | ::invalid 1776 | x))) 1777 | (unform* [_ x] x) 1778 | (explain* [_ path via in x] (explain* @spec path via in x)) 1779 | (gen* [_ overrides path rmap] (gen* @spec overrides path rmap)) 1780 | (with-gen* [_ gfn] (nonconforming (with-gen* @spec gfn))) 1781 | (describe* [_] `(nonconforming ~(describe* @spec)))))) 1782 | 1783 | (defn ^:skip-wiki nilable-impl 1784 | "Do not call this directly, use 'nilable'" 1785 | [form pred gfn] 1786 | (let [spec (delay (specize pred form))] 1787 | (reify 1788 | Specize 1789 | (specize* [s] s) 1790 | (specize* [s _] s) 1791 | 1792 | Spec 1793 | (conform* [_ x] (if (nil? x) nil (conform* @spec x))) 1794 | (unform* [_ x] (if (nil? x) nil (unform* @spec x))) 1795 | (explain* [_ path via in x] 1796 | (when-not (c/or (pvalid? @spec x) (nil? x)) 1797 | (conj 1798 | (explain-1 form pred (conj path ::pred) via in x) 1799 | {:path (conj path ::nil) :pred 'nil? :val x :via via :in in}))) 1800 | (gen* [_ overrides path rmap] 1801 | (if gfn 1802 | (gfn) 1803 | (gen/frequency 1804 | [[1 (gen/delay (gen/return nil))] 1805 | [9 (gen/delay (gensub pred overrides (conj path ::pred) rmap form))]]))) 1806 | (with-gen* [_ gfn] (nilable-impl form pred gfn)) 1807 | (describe* [_] `(nilable ~(res form)))))) 1808 | 1809 | (defmacro nilable 1810 | "returns a spec that accepts nil and values satisfying pred" 1811 | [pred] 1812 | (let [pf (res pred)] 1813 | `(nilable-impl '~pf ~pred nil))) 1814 | 1815 | (defn exercise 1816 | "generates a number (default 10) of values compatible with spec and maps conform over them, 1817 | returning a sequence of [val conformed-val] tuples. Optionally takes 1818 | a generator overrides map as per gen" 1819 | ([spec] (exercise spec 10)) 1820 | ([spec n] (exercise spec n nil)) 1821 | ([spec n overrides] 1822 | (map #(vector % (conform spec %)) (gen/sample (gen spec overrides) n)))) 1823 | 1824 | (defn exercise-fn 1825 | "exercises the fn named by sym (a symbol) by applying it to 1826 | n (default 10) generated samples of its args spec. When fspec is 1827 | supplied its arg spec is used, and sym-or-f can be a fn. Returns a 1828 | sequence of tuples of [args ret]. " 1829 | ([sym] (exercise-fn sym 10)) 1830 | ([sym n] (exercise-fn sym n (get-spec sym))) 1831 | ([sym-or-f n fspec] 1832 | (let [f (if (symbol? sym-or-f) (resolve sym-or-f) sym-or-f)] 1833 | (if-let [arg-spec (c/and fspec (:args fspec))] 1834 | (for [args (gen/sample (gen arg-spec) n)] 1835 | [args (apply f args)]) 1836 | (throw (Exception. "No :args spec found, can't generate")))))) 1837 | 1838 | (defn inst-in-range? 1839 | "Return true if inst at or after start and before end" 1840 | [start end inst] 1841 | (c/and (inst? inst) 1842 | (let [t (inst-ms inst)] 1843 | (c/and (<= (inst-ms start) t) (< t (inst-ms end)))))) 1844 | 1845 | (defmacro inst-in 1846 | "Returns a spec that validates insts in the range from start 1847 | (inclusive) to end (exclusive)." 1848 | [start end] 1849 | `(let [st# (inst-ms ~start) 1850 | et# (inst-ms ~end) 1851 | mkdate# (fn [d#] (java.util.Date. ^{:tag ~'long} d#))] 1852 | (spec (and inst? #(inst-in-range? ~start ~end %)) 1853 | :gen (fn [] 1854 | (gen/fmap mkdate# 1855 | (gen/large-integer* {:min st# :max et#})))))) 1856 | 1857 | (defn int-in-range? 1858 | "Return true if start <= val, val < end and val is a fixed 1859 | precision integer." 1860 | [start end val] 1861 | (c/and int? (<= start val) (< val end))) 1862 | 1863 | (defmacro int-in 1864 | "Returns a spec that validates fixed precision integers in the 1865 | range from start (inclusive) to end (exclusive)." 1866 | [start end] 1867 | `(spec (and int? #(int-in-range? ~start ~end %)) 1868 | :gen #(gen/large-integer* {:min ~start :max (dec ~end)}))) 1869 | 1870 | (defmacro double-in 1871 | "Specs a 64-bit floating point number. Options: 1872 | 1873 | :infinite? - whether +/- infinity allowed (default true) 1874 | :NaN? - whether NaN allowed (default true) 1875 | :min - minimum value (inclusive, default none) 1876 | :max - maximum value (inclusive, default none)" 1877 | [& {:keys [infinite? NaN? min max] 1878 | :or {infinite? true NaN? true} 1879 | :as m}] 1880 | `(spec (and double? 1881 | ~@(when-not infinite? '[#(not (Double/isInfinite %))]) 1882 | ~@(when-not NaN? '[#(not (Double/isNaN %))]) 1883 | ~@(when max `[#(<= % ~max)]) 1884 | ~@(when min `[#(<= ~min %)])) 1885 | :gen #(gen/double* ~m))) 1886 | 1887 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; assert ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1888 | (defonce 1889 | ^{:dynamic true 1890 | :doc "If true, compiler will enable spec asserts, which are then 1891 | subject to runtime control via check-asserts? If false, compiler 1892 | will eliminate all spec assert overhead. See 'assert'. 1893 | 1894 | Initially set to boolean value of clojure.spec.compile-asserts 1895 | system property. Defaults to true."} 1896 | *compile-asserts* 1897 | (not= "false" (System/getProperty "clojure.spec.compile-asserts"))) 1898 | 1899 | (def ^:dynamic __checkSpecAsserts (Boolean/getBoolean "clojure.spec.check-asserts")) 1900 | 1901 | (defn check-asserts? 1902 | "Returns the value set by check-asserts." 1903 | [] 1904 | __checkSpecAsserts) 1905 | 1906 | (defn check-asserts 1907 | "Enable or disable spec asserts that have been compiled 1908 | with '*compile-asserts*' true. See 'assert'. 1909 | 1910 | Initially set to boolean value of clojure.spec.check-asserts 1911 | system property. Defaults to false." 1912 | [flag] 1913 | (.bindRoot #'__checkSpecAsserts flag)) 1914 | 1915 | (defn assert* 1916 | "Do not call this directly, use 'assert'." 1917 | [spec x] 1918 | (if (valid? spec x) 1919 | x 1920 | (let [ed (c/merge (assoc (explain-data* spec [] [] [] x) 1921 | ::failure :assertion-failed))] 1922 | (throw (ex-info 1923 | (str "Spec assertion failed\n" (with-out-str (explain-out ed))) 1924 | ed))))) 1925 | 1926 | (defmacro assert 1927 | "spec-checking assert expression. Returns x if x is valid? according 1928 | to spec, else throws an ex-info with explain-data plus ::failure of 1929 | :assertion-failed. 1930 | 1931 | Can be disabled at either compile time or runtime: 1932 | 1933 | If *compile-asserts* is false at compile time, compiles to x. Defaults 1934 | to value of 'clojure.spec.compile-asserts' system property, or true if 1935 | not set. 1936 | 1937 | If (check-asserts?) is false at runtime, always returns x. Defaults to 1938 | value of 'clojure.spec.check-asserts' system property, or false if not 1939 | set. You can toggle check-asserts? with (check-asserts bool)." 1940 | [spec x] 1941 | (if *compile-asserts* 1942 | `(if __checkSpecAsserts 1943 | (assert* ~spec ~x) 1944 | ~x) 1945 | x)) 1946 | 1947 | -------------------------------------------------------------------------------- /src/clojure/spec/gen/alpha.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.spec.gen.alpha 10 | (:refer-clojure :exclude [boolean bytes cat hash-map list map not-empty set vector 11 | char double int keyword symbol string uuid delay]) 12 | (:require [clojure.future :refer :all])) 13 | 14 | (alias 'c 'clojure.core) 15 | 16 | (defn- dynaload 17 | [s] 18 | (let [ns (namespace s)] 19 | (assert ns) 20 | (require (c/symbol ns)) 21 | (let [v (resolve s)] 22 | (if v 23 | @v 24 | (throw (RuntimeException. (str "Var " s " is not on the classpath"))))))) 25 | 26 | (def ^:private quick-check-ref 27 | (c/delay (dynaload 'clojure.test.check/quick-check))) 28 | (defn quick-check 29 | [& args] 30 | (apply @quick-check-ref args)) 31 | 32 | (def ^:private for-all*-ref 33 | (c/delay (dynaload 'clojure.test.check.properties/for-all*))) 34 | (defn for-all* 35 | "Dynamically loaded clojure.test.check.properties/for-all*." 36 | [& args] 37 | (apply @for-all*-ref args)) 38 | 39 | (let [g? (c/delay (dynaload 'clojure.test.check.generators/generator?)) 40 | g (c/delay (dynaload 'clojure.test.check.generators/generate)) 41 | mkg (c/delay (dynaload 'clojure.test.check.generators/->Generator))] 42 | (defn- generator? 43 | [x] 44 | (@g? x)) 45 | (defn- generator 46 | [gfn] 47 | (@mkg gfn)) 48 | (defn generate 49 | "Generate a single value using generator." 50 | [generator] 51 | (@g generator))) 52 | 53 | (defn ^:skip-wiki delay-impl 54 | [gfnd] 55 | ;;N.B. depends on test.check impl details 56 | (generator (fn [rnd size] 57 | ((:gen @gfnd) rnd size)))) 58 | 59 | (defmacro delay 60 | "given body that returns a generator, returns a 61 | generator that delegates to that, but delays 62 | creation until used." 63 | [& body] 64 | `(delay-impl (c/delay ~@body))) 65 | 66 | (defn gen-for-name 67 | "Dynamically loads test.check generator named s." 68 | [s] 69 | (let [g (dynaload s)] 70 | (if (generator? g) 71 | g 72 | (throw (RuntimeException. (str "Var " s " is not a generator")))))) 73 | 74 | (defmacro ^:skip-wiki lazy-combinator 75 | "Implementation macro, do not call directly." 76 | [s] 77 | (let [fqn (c/symbol "clojure.test.check.generators" (name s)) 78 | doc (str "Lazy loaded version of " fqn)] 79 | `(let [g# (c/delay (dynaload '~fqn))] 80 | (defn ~s 81 | ~doc 82 | [& ~'args] 83 | (apply @g# ~'args))))) 84 | 85 | (defmacro ^:skip-wiki lazy-combinators 86 | "Implementation macro, do not call directly." 87 | [& syms] 88 | `(do 89 | ~@(c/map 90 | (fn [s] (c/list 'lazy-combinator s)) 91 | syms))) 92 | 93 | (lazy-combinators hash-map list map not-empty set vector vector-distinct fmap elements 94 | bind choose fmap one-of such-that tuple sample return 95 | large-integer* double* frequency) 96 | 97 | (defmacro ^:skip-wiki lazy-prim 98 | "Implementation macro, do not call directly." 99 | [s] 100 | (let [fqn (c/symbol "clojure.test.check.generators" (name s)) 101 | doc (str "Fn returning " fqn)] 102 | `(let [g# (c/delay (dynaload '~fqn))] 103 | (defn ~s 104 | ~doc 105 | [& ~'args] 106 | @g#)))) 107 | 108 | (defmacro ^:skip-wiki lazy-prims 109 | "Implementation macro, do not call directly." 110 | [& syms] 111 | `(do 112 | ~@(c/map 113 | (fn [s] (c/list 'lazy-prim s)) 114 | syms))) 115 | 116 | (lazy-prims any any-printable boolean bytes char char-alpha char-alphanumeric char-ascii double 117 | int keyword keyword-ns large-integer ratio simple-type simple-type-printable 118 | string string-ascii string-alphanumeric symbol symbol-ns uuid) 119 | 120 | (defn cat 121 | "Returns a generator of a sequence catenated from results of 122 | gens, each of which should generate something sequential." 123 | [& gens] 124 | (fmap #(apply concat %) 125 | (apply tuple gens))) 126 | 127 | (defn- qualified? [ident] (not (nil? (namespace ident)))) 128 | 129 | (def ^:private 130 | gen-builtins 131 | (c/delay 132 | (let [simple (simple-type-printable)] 133 | {any? (one-of [(return nil) (any-printable)]) 134 | some? (such-that some? (any-printable)) 135 | number? (one-of [(large-integer) (double)]) 136 | integer? (large-integer) 137 | int? (large-integer) 138 | pos-int? (large-integer* {:min 1}) 139 | neg-int? (large-integer* {:max -1}) 140 | nat-int? (large-integer* {:min 0}) 141 | float? (double) 142 | double? (double) 143 | boolean? (boolean) 144 | string? (string-alphanumeric) 145 | ident? (one-of [(keyword-ns) (symbol-ns)]) 146 | simple-ident? (one-of [(keyword) (symbol)]) 147 | qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)])) 148 | keyword? (keyword-ns) 149 | simple-keyword? (keyword) 150 | qualified-keyword? (such-that qualified? (keyword-ns)) 151 | symbol? (symbol-ns) 152 | simple-symbol? (symbol) 153 | qualified-symbol? (such-that qualified? (symbol-ns)) 154 | uuid? (uuid) 155 | uri? (fmap #(java.net.URI/create (str "http://" % ".com")) (uuid)) 156 | decimal? (fmap #(BigDecimal/valueOf %) 157 | (double* {:infinite? false :NaN? false})) 158 | inst? (fmap #(java.util.Date. %) 159 | (large-integer)) 160 | seqable? (one-of [(return nil) 161 | (list simple) 162 | (vector simple) 163 | (map simple simple) 164 | (set simple) 165 | (string-alphanumeric)]) 166 | indexed? (vector simple) 167 | map? (map simple simple) 168 | vector? (vector simple) 169 | list? (list simple) 170 | seq? (list simple) 171 | char? (char) 172 | set? (set simple) 173 | nil? (return nil) 174 | false? (return false) 175 | true? (return true) 176 | zero? (return 0) 177 | rational? (one-of [(large-integer) (ratio)]) 178 | coll? (one-of [(map simple simple) 179 | (list simple) 180 | (vector simple) 181 | (set simple)]) 182 | empty? (elements [nil '() [] {} #{}]) 183 | associative? (one-of [(map simple simple) (vector simple)]) 184 | sequential? (one-of [(list simple) (vector simple)]) 185 | ratio? (such-that ratio? (ratio)) 186 | bytes? (bytes)}))) 187 | 188 | (defn gen-for-pred 189 | "Given a predicate, returns a built-in generator if one exists." 190 | [pred] 191 | (if (set? pred) 192 | (elements pred) 193 | (get @gen-builtins pred))) 194 | 195 | (comment 196 | (require :reload 'clojure.spec.gen.alpha) 197 | (in-ns 'clojure.spec.gen.alpha) 198 | 199 | ;; combinators, see call to lazy-combinators above for complete list 200 | (generate (one-of [(gen-for-pred integer?) (gen-for-pred string?)])) 201 | (generate (such-that #(< 10000 %) (gen-for-pred integer?))) 202 | (let [reqs {:a (gen-for-pred number?) 203 | :b (gen-for-pred ratio?)} 204 | opts {:c (gen-for-pred string?)}] 205 | (generate (bind (choose 0 (count opts)) 206 | #(let [args (concat (seq reqs) (shuffle (seq opts)))] 207 | (->> args 208 | (take (+ % (count reqs))) 209 | (mapcat identity) 210 | (apply hash-map)))))) 211 | (generate (cat (list (gen-for-pred string?)) 212 | (list (gen-for-pred ratio?)))) 213 | 214 | ;; load your own generator 215 | (gen-for-name 'clojure.test.check.generators/int) 216 | 217 | ;; failure modes 218 | (gen-for-name 'unqualified) 219 | (gen-for-name 'clojure.core/+) 220 | (gen-for-name 'clojure.core/name-does-not-exist) 221 | (gen-for-name 'ns.does.not.exist/f) 222 | 223 | ) 224 | 225 | -------------------------------------------------------------------------------- /src/clojure/spec/test/alpha.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.spec.test.alpha 10 | (:refer-clojure :exclude [test]) 11 | (:require 12 | [clojure.pprint :as pp] 13 | [clojure.spec.alpha :as s] 14 | [clojure.spec.gen.alpha :as gen] 15 | [clojure.string :as str] 16 | [clojure.future :refer :all])) 17 | 18 | (in-ns 'clojure.spec.test.check) 19 | (in-ns 'clojure.spec.test.alpha) 20 | (alias 'stc 'clojure.spec.test.check) 21 | 22 | (defn- throwable? 23 | [x] 24 | (instance? Throwable x)) 25 | 26 | (defn ->sym 27 | [x] 28 | (@#'s/->sym x)) 29 | 30 | (defn- ->var 31 | [s-or-v] 32 | (if (var? s-or-v) 33 | s-or-v 34 | (let [v (and (symbol? s-or-v) (resolve s-or-v))] 35 | (if (var? v) 36 | v 37 | (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var"))))))) 38 | 39 | (defn- collectionize 40 | [x] 41 | (if (symbol? x) 42 | (list x) 43 | x)) 44 | 45 | (defn enumerate-namespace 46 | "Given a symbol naming an ns, or a collection of such symbols, 47 | returns the set of all symbols naming vars in those nses." 48 | [ns-sym-or-syms] 49 | (into 50 | #{} 51 | (mapcat (fn [ns-sym] 52 | (map 53 | (fn [name-sym] 54 | (symbol (name ns-sym) (name name-sym))) 55 | (keys (ns-interns ns-sym))))) 56 | (collectionize ns-sym-or-syms))) 57 | 58 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 59 | 60 | (def ^:private ^:dynamic *instrument-enabled* 61 | "if false, instrumented fns call straight through" 62 | true) 63 | 64 | (defn- fn-spec? 65 | "Fn-spec must include at least :args or :ret specs." 66 | [m] 67 | (or (:args m) (:ret m))) 68 | 69 | (defmacro with-instrument-disabled 70 | "Disables instrument's checking of calls, within a scope." 71 | [& body] 72 | `(binding [*instrument-enabled* nil] 73 | ~@body)) 74 | 75 | (defn- interpret-stack-trace-element 76 | "Given the vector-of-syms form of a stacktrace element produced 77 | by e.g. Throwable->map, returns a map form that adds some keys 78 | guessing the original Clojure names. Returns a map with 79 | 80 | :class class name symbol from stack trace 81 | :method method symbol from stack trace 82 | :file filename from stack trace 83 | :line line number from stack trace 84 | :var-scope optional Clojure var symbol scoping fn def 85 | :local-fn optional local Clojure symbol scoping fn def 86 | 87 | For non-Clojure fns, :scope and :local-fn will be absent." 88 | [[cls method file line]] 89 | (let [clojure? (contains? '#{invoke invokeStatic} method) 90 | demunge #(clojure.lang.Compiler/demunge %) 91 | degensym #(str/replace % #"--.*" "") 92 | [ns-sym name-sym local] (when clojure? 93 | (->> (str/split (str cls) #"\$" 3) 94 | (map demunge)))] 95 | (merge {:file file 96 | :line line 97 | :method method 98 | :class cls} 99 | (when (and ns-sym name-sym) 100 | {:var-scope (symbol ns-sym name-sym)}) 101 | (when local 102 | {:local-fn (symbol (degensym local))})))) 103 | 104 | (defn- stacktrace-relevant-to-instrument 105 | "Takes a coll of stack trace elements (as returned by 106 | StackTraceElement->vec) and returns a coll of maps as per 107 | interpret-stack-trace-element that are relevant to a 108 | failure in instrument." 109 | [elems] 110 | (let [plumbing? (fn [{:keys [var-scope]}] 111 | (contains? '#{clojure.spec.test.alpha/spec-checking-fn} var-scope))] 112 | (sequence (comp (map StackTraceElement->vec) 113 | (map interpret-stack-trace-element) 114 | (filter :var-scope) 115 | (drop-while plumbing?)) 116 | elems))) 117 | 118 | (defn- spec-checking-fn 119 | [v f fn-spec] 120 | (let [fn-spec (@#'s/maybe-spec fn-spec) 121 | conform! (fn [v role spec data args] 122 | (let [conformed (s/conform spec data)] 123 | (if (= ::s/invalid conformed) 124 | (let [caller (->> (.getStackTrace (Thread/currentThread)) 125 | stacktrace-relevant-to-instrument 126 | first) 127 | ed (merge (assoc (s/explain-data* spec [role] [] [] data) 128 | ::s/args args 129 | ::s/failure :instrument) 130 | (when caller 131 | {::caller (dissoc caller :class :method)}))] 132 | (throw (ex-info 133 | (str "Call to " v " did not conform to spec:\n" (with-out-str (s/explain-out ed))) 134 | ed))) 135 | conformed)))] 136 | (fn 137 | [& args] 138 | (if *instrument-enabled* 139 | (with-instrument-disabled 140 | (when (:args fn-spec) (conform! v :args (:args fn-spec) args args)) 141 | (binding [*instrument-enabled* true] 142 | (.applyTo ^clojure.lang.IFn f args))) 143 | (.applyTo ^clojure.lang.IFn f args))))) 144 | 145 | (defn- no-fspec 146 | [v spec] 147 | (ex-info (str "Fn at " v " is not spec'ed.") 148 | {:var v :spec spec ::s/failure :no-fspec})) 149 | 150 | (defonce ^:private instrumented-vars (atom {})) 151 | 152 | (defn- instrument-choose-fn 153 | "Helper for instrument." 154 | [f spec sym {over :gen :keys [stub replace]}] 155 | (if (some #{sym} stub) 156 | (-> spec (s/gen over) gen/generate) 157 | (get replace sym f))) 158 | 159 | (defn- instrument-choose-spec 160 | "Helper for instrument" 161 | [spec sym {overrides :spec}] 162 | (get overrides sym spec)) 163 | 164 | (defn- instrument-1 165 | [s opts] 166 | (when-let [v (resolve s)] 167 | (when-not (-> v meta :macro) 168 | (let [spec (s/get-spec v) 169 | {:keys [raw wrapped]} (get @instrumented-vars v) 170 | current @v 171 | to-wrap (if (= wrapped current) raw current) 172 | ospec (or (instrument-choose-spec spec s opts) 173 | (throw (no-fspec v spec))) 174 | ofn (instrument-choose-fn to-wrap ospec s opts) 175 | checked (spec-checking-fn v ofn ospec)] 176 | (alter-var-root v (constantly checked)) 177 | (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked}) 178 | (->sym v))))) 179 | 180 | (defn- unstrument-1 181 | [s] 182 | (when-let [v (resolve s)] 183 | (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] 184 | (swap! instrumented-vars dissoc v) 185 | (let [current @v] 186 | (when (= wrapped current) 187 | (alter-var-root v (constantly raw)) 188 | (->sym v)))))) 189 | 190 | (defn- opt-syms 191 | "Returns set of symbols referenced by 'instrument' opts map" 192 | [opts] 193 | (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))])) 194 | 195 | (defn- fn-spec-name? 196 | [s] 197 | (and (symbol? s) 198 | (not (some-> (resolve s) meta :macro)))) 199 | 200 | (defn instrumentable-syms 201 | "Given an opts map as per instrument, returns the set of syms 202 | that can be instrumented." 203 | ([] (instrumentable-syms nil)) 204 | ([opts] 205 | (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys") 206 | (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) 207 | (keys (:spec opts)) 208 | (:stub opts) 209 | (keys (:replace opts))]))) 210 | 211 | (defn instrument 212 | "Instruments the vars named by sym-or-syms, a symbol or collection 213 | of symbols, or all instrumentable vars if sym-or-syms is not 214 | specified. 215 | 216 | If a var has an :args fn-spec, sets the var's root binding to a 217 | fn that checks arg conformance (throwing an exception on failure) 218 | before delegating to the original fn. 219 | 220 | The opts map can be used to override registered specs, and/or to 221 | replace fn implementations entirely. Opts for symbols not included 222 | in sym-or-syms are ignored. This facilitates sharing a common 223 | options map across many different calls to instrument. 224 | 225 | The opts map may have the following keys: 226 | 227 | :spec a map from var-name symbols to override specs 228 | :stub a set of var-name symbols to be replaced by stubs 229 | :gen a map from spec names to generator overrides 230 | :replace a map from var-name symbols to replacement fns 231 | 232 | :spec overrides registered fn-specs with specs your provide. Use 233 | :spec overrides to provide specs for libraries that do not have 234 | them, or to constrain your own use of a fn to a subset of its 235 | spec'ed contract. 236 | 237 | :stub replaces a fn with a stub that checks :args, then uses the 238 | :ret spec to generate a return value. 239 | 240 | :gen overrides are used only for :stub generation. 241 | 242 | :replace replaces a fn with a fn that checks args conformance, then 243 | invokes the fn you provide, enabling arbitrary stubbing and mocking. 244 | 245 | :spec can be used in combination with :stub or :replace. 246 | 247 | Returns a collection of syms naming the vars instrumented." 248 | ([] (instrument (instrumentable-syms))) 249 | ([sym-or-syms] (instrument sym-or-syms nil)) 250 | ([sym-or-syms opts] 251 | (locking instrumented-vars 252 | (into 253 | [] 254 | (comp (filter (instrumentable-syms opts)) 255 | (distinct) 256 | (map #(instrument-1 % opts)) 257 | (remove nil?)) 258 | (collectionize sym-or-syms))))) 259 | 260 | (defn unstrument 261 | "Undoes instrument on the vars named by sym-or-syms, specified 262 | as in instrument. With no args, unstruments all instrumented vars. 263 | Returns a collection of syms naming the vars unstrumented." 264 | ([] (unstrument (map ->sym (keys @instrumented-vars)))) 265 | ([sym-or-syms] 266 | (locking instrumented-vars 267 | (into 268 | [] 269 | (comp (filter symbol?) 270 | (map unstrument-1) 271 | (remove nil?)) 272 | (collectionize sym-or-syms))))) 273 | 274 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 275 | 276 | (defn- explain-check 277 | [args spec v role] 278 | (ex-info 279 | "Specification-based check failed" 280 | (when-not (s/valid? spec v nil) 281 | (assoc (s/explain-data* spec [role] [] [] v) 282 | ::args args 283 | ::val v 284 | ::s/failure :check-failed)))) 285 | 286 | (defn- check-call 287 | "Returns true if call passes specs, otherwise *returns* an exception 288 | with explain-data + ::s/failure." 289 | [f specs args] 290 | (let [cargs (when (:args specs) (s/conform (:args specs) args))] 291 | (if (= cargs ::s/invalid) 292 | (explain-check args (:args specs) args :args) 293 | (let [ret (apply f args) 294 | cret (when (:ret specs) (s/conform (:ret specs) ret))] 295 | (if (= cret ::s/invalid) 296 | (explain-check args (:ret specs) ret :ret) 297 | (if (and (:args specs) (:ret specs) (:fn specs)) 298 | (if (s/valid? (:fn specs) {:args cargs :ret cret}) 299 | true 300 | (explain-check args (:fn specs) {:args cargs :ret cret} :fn)) 301 | true)))))) 302 | 303 | (defn- quick-check 304 | [f specs {gen :gen opts ::stc/opts}] 305 | (let [{:keys [num-tests] :or {num-tests 1000}} opts 306 | g (try (s/gen (:args specs) gen) (catch Throwable t t))] 307 | (if (throwable? g) 308 | {:result g} 309 | (let [prop (gen/for-all* [g] #(check-call f specs %))] 310 | (apply gen/quick-check num-tests prop (mapcat identity opts)))))) 311 | 312 | (defn- make-check-result 313 | "Builds spec result map." 314 | [check-sym spec test-check-ret] 315 | (merge {:spec spec 316 | ::stc/ret test-check-ret} 317 | (when check-sym 318 | {:sym check-sym}) 319 | (when-let [result (-> test-check-ret :result)] 320 | (when-not (true? result) {:failure result})) 321 | (when-let [shrunk (-> test-check-ret :shrunk)] 322 | {:failure (:result shrunk)}))) 323 | 324 | (defn- check-1 325 | [{:keys [s f v spec]} opts] 326 | (let [re-inst? (and v (seq (unstrument s)) true) 327 | f (or f (when v @v)) 328 | specd (s/spec spec)] 329 | (try 330 | (cond 331 | (or (nil? f) (some-> v meta :macro)) 332 | {:failure (ex-info "No fn to spec" {::s/failure :no-fn}) 333 | :sym s :spec spec} 334 | 335 | (:args specd) 336 | (let [tcret (quick-check f specd opts)] 337 | (make-check-result s spec tcret)) 338 | 339 | :default 340 | {:failure (ex-info "No :args spec" {::s/failure :no-args-spec}) 341 | :sym s :spec spec}) 342 | (finally 343 | (when re-inst? (instrument s)))))) 344 | 345 | (defn- sym->check-map 346 | [s] 347 | (let [v (resolve s)] 348 | {:s s 349 | :v v 350 | :spec (when v (s/get-spec v))})) 351 | 352 | (defn- validate-check-opts 353 | [opts] 354 | (assert (every? ident? (keys (:gen opts))) "check :gen expects ident keys")) 355 | 356 | (defn check-fn 357 | "Runs generative tests for fn f using spec and opts. See 358 | 'check' for options and return." 359 | ([f spec] (check-fn f spec nil)) 360 | ([f spec opts] 361 | (validate-check-opts opts) 362 | (check-1 {:f f :spec spec} opts))) 363 | 364 | (defn checkable-syms 365 | "Given an opts map as per check, returns the set of syms that 366 | can be checked." 367 | ([] (checkable-syms nil)) 368 | ([opts] 369 | (validate-check-opts opts) 370 | (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) 371 | (keys (:spec opts))]))) 372 | 373 | (defn check 374 | "Run generative tests for spec conformance on vars named by 375 | sym-or-syms, a symbol or collection of symbols. If sym-or-syms 376 | is not specified, check all checkable vars. 377 | 378 | The opts map includes the following optional keys, where stc 379 | aliases clojure.spec.test.check: 380 | 381 | ::stc/opts opts to flow through test.check/quick-check 382 | :gen map from spec names to generator overrides 383 | 384 | The ::stc/opts include :num-tests in addition to the keys 385 | documented by test.check. Generator overrides are passed to 386 | spec/gen when generating function args. 387 | 388 | Returns a lazy sequence of check result maps with the following 389 | keys 390 | 391 | :spec the spec tested 392 | :sym optional symbol naming the var tested 393 | :failure optional test failure 394 | ::stc/ret optional value returned by test.check/quick-check 395 | 396 | The value for :failure can be any exception. Exceptions thrown by 397 | spec itself will have an ::s/failure value in ex-data: 398 | 399 | :check-failed at least one checked return did not conform 400 | :no-args-spec no :args spec provided 401 | :no-fn no fn provided 402 | :no-fspec no fspec provided 403 | :no-gen unable to generate :args 404 | :instrument invalid args detected by instrument 405 | " 406 | ([] (check (checkable-syms))) 407 | ([sym-or-syms] (check sym-or-syms nil)) 408 | ([sym-or-syms opts] 409 | (->> (collectionize sym-or-syms) 410 | (filter (checkable-syms opts)) 411 | (pmap 412 | #(check-1 (sym->check-map %) opts))))) 413 | 414 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting ;;;;;;;;;;;;;;;;;;;;;;;; 415 | 416 | (defn- failure-type 417 | [x] 418 | (::s/failure (ex-data x))) 419 | 420 | (defn- unwrap-failure 421 | [x] 422 | (if (failure-type x) 423 | (ex-data x) 424 | x)) 425 | 426 | (defn- result-type 427 | "Returns the type of the check result. This can be any of the 428 | ::s/failure keywords documented in 'check', or: 429 | 430 | :check-passed all checked fn returns conformed 431 | :check-threw checked fn threw an exception" 432 | [ret] 433 | (let [failure (:failure ret)] 434 | (cond 435 | (nil? failure) :check-passed 436 | (failure-type failure) (failure-type failure) 437 | :default :check-threw))) 438 | 439 | (defn abbrev-result 440 | "Given a check result, returns an abbreviated version 441 | suitable for summary use." 442 | [x] 443 | (if (:failure x) 444 | (-> (dissoc x ::stc/ret) 445 | (update :spec s/describe) 446 | (update :failure unwrap-failure)) 447 | (dissoc x :spec ::stc/ret))) 448 | 449 | (defn summarize-results 450 | "Given a collection of check-results, e.g. from 'check', pretty 451 | prints the summary-result (default abbrev-result) of each. 452 | 453 | Returns a map with :total, the total number of results, plus a 454 | key with a count for each different :type of result." 455 | ([check-results] (summarize-results check-results abbrev-result)) 456 | ([check-results summary-result] 457 | (reduce 458 | (fn [summary result] 459 | (pp/pprint (summary-result result)) 460 | (-> summary 461 | (update :total inc) 462 | (update (result-type result) (fnil inc 0)))) 463 | {:total 0} 464 | check-results))) 465 | 466 | 467 | -------------------------------------------------------------------------------- /test/clojure/test_clojure/future.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.test-clojure.future 2 | (:require 3 | [clojure.spec.alpha :as s] 4 | [clojure.future :refer :all] 5 | [clojure.test :refer [deftest is are]])) 6 | 7 | 8 | (deftest novelty 9 | (println "--- Testing on" (clojure-version) "---") 10 | 11 | (is (true? (boolean? true)))) 12 | 13 | 14 | (deftest alpha17 15 | (is (true? (qualified-keyword? :ns/kw)))) 16 | 17 | 18 | ;; https://github.com/tonsky/clojure-future-spec/issues/2 19 | (deftest test-conform-keys 20 | (s/def ::n nat-int?) 21 | (is (= (s/conform (s/keys :req-un [::n]) {:n 6}) 22 | {:n 6}))) 23 | -------------------------------------------------------------------------------- /test18/clojure/test_clojure/spec.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.test-clojure.spec 2 | (:require [clojure.spec.alpha :as s] 3 | [clojure.spec.gen.alpha :as gen] 4 | [clojure.spec.test.alpha :as stest] 5 | [clojure.future :refer :all] 6 | [clojure.test :refer :all])) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | (defmacro result-or-ex [x] 11 | `(try 12 | ~x 13 | (catch Throwable t# 14 | (.getName (class t#))))) 15 | 16 | (def even-count? #(even? (count %))) 17 | 18 | (defn submap? 19 | "Is m1 a subset of m2?" 20 | [m1 m2] 21 | (if (and (map? m1) (map? m2)) 22 | (every? (fn [[k v]] (and (contains? m2 k) 23 | (submap? v (get m2 k)))) 24 | m1) 25 | (= m1 m2))) 26 | 27 | (deftest conform-explain 28 | (let [a (s/and #(> % 5) #(< % 10)) 29 | o (s/or :s string? :k keyword?) 30 | c (s/cat :a string? :b keyword?) 31 | either (s/alt :a string? :b keyword?) 32 | star (s/* keyword?) 33 | plus (s/+ keyword?) 34 | opt (s/? keyword?) 35 | andre (s/& (s/* keyword?) even-count?) 36 | m (s/map-of keyword? string?) 37 | mkeys (s/map-of (s/and keyword? (s/conformer name)) any?) 38 | mkeys2 (s/map-of (s/and keyword? (s/conformer name)) any? :conform-keys true) 39 | s (s/coll-of (s/spec (s/cat :tag keyword? :val any?)) :kind list?) 40 | v (s/coll-of keyword? :kind vector?) 41 | coll (s/coll-of keyword?) 42 | lrange (s/int-in 7 42) 43 | drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2) 44 | irange (s/inst-in #inst "1939" #inst "1946") 45 | ] 46 | (are [spec x conformed ed] 47 | (let [co (result-or-ex (s/conform spec x)) 48 | e (result-or-ex (::s/problems (s/explain-data spec x)))] 49 | (when (not= conformed co) (println "conform fail\n\texpect=" conformed "\n\tactual=" co)) 50 | (when (not (every? true? (map submap? ed e))) 51 | (println "explain failures\n\texpect=" ed "\n\tactual failures=" e "\n\tsubmap?=" (map submap? ed e))) 52 | (and (= conformed co) (every? true? (map submap? ed e)))) 53 | 54 | lrange 7 7 nil 55 | lrange 8 8 nil 56 | lrange 42 ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.spec.alpha/int-in-range? 7 42 %)), :val 42}] 57 | 58 | irange #inst "1938" ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.spec.alpha/inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %)), :val #inst "1938"}] 59 | irange #inst "1942" #inst "1942" nil 60 | irange #inst "1946" ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.spec.alpha/inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %)), :val #inst "1946"}] 61 | 62 | drange 3.0 ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.core/<= 3.1 %)), :val 3.0}] 63 | drange 3.1 3.1 nil 64 | drange 3.2 3.2 nil 65 | drange Double/POSITIVE_INFINITY ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.core/not (Double/isInfinite %))), :val Double/POSITIVE_INFINITY}] 66 | ;; can't use equality-based test for Double/NaN 67 | ;; drange Double/NaN ::s/invalid {[] {:pred '(clojure.core/fn [%] (clojure.core/not (Double/isNaN %))), :val Double/NaN}} 68 | 69 | keyword? :k :k nil 70 | keyword? nil ::s/invalid [{:pred ::s/unknown :val nil}] 71 | keyword? "abc" ::s/invalid [{:pred ::s/unknown :val "abc"}] 72 | 73 | a 6 6 nil 74 | a 3 ::s/invalid '[{:pred (clojure.core/fn [%] (clojure.core/> % 5)), :val 3}] 75 | a 20 ::s/invalid '[{:pred (clojure.core/fn [%] (clojure.core/< % 10)), :val 20}] 76 | a nil "java.lang.NullPointerException" "java.lang.NullPointerException" 77 | a :k "java.lang.ClassCastException" "java.lang.ClassCastException" 78 | 79 | o "a" [:s "a"] nil 80 | o :a [:k :a] nil 81 | o 'a ::s/invalid '[{:pred clojure.core/string?, :val a, :path [:s]} {:pred clojure.core/keyword?, :val a :path [:k]}] 82 | 83 | c nil ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/string?, :val (), :path [:a]}] 84 | c [] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/string?, :val (), :path [:a]}] 85 | c [:a] ::s/invalid '[{:pred clojure.core/string?, :val :a, :path [:a], :in [0]}] 86 | c ["a"] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val (), :path [:b]}] 87 | c ["s" :k] '{:a "s" :b :k} nil 88 | c ["s" :k 5] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/cat :a clojure.core/string? :b clojure.core/keyword?), :val (5)}] 89 | (s/cat) nil {} nil 90 | (s/cat) [5] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/cat), :val (5), :in [0]}] 91 | 92 | either nil ::s/invalid '[{:reason "Insufficient input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val () :via []}] 93 | either [] ::s/invalid '[{:reason "Insufficient input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val () :via []}] 94 | either [:k] [:b :k] nil 95 | either ["s"] [:a "s"] nil 96 | either [:b "s"] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val ("s") :via []}] 97 | 98 | star nil [] nil 99 | star [] [] nil 100 | star [:k] [:k] nil 101 | star [:k1 :k2] [:k1 :k2] nil 102 | star [:k1 :k2 "x"] ::s/invalid '[{:pred clojure.core/keyword?, :val "x" :via []}] 103 | star ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a" :via []}] 104 | 105 | plus nil ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val () :via []}] 106 | plus [] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val () :via []}] 107 | plus [:k] [:k] nil 108 | plus [:k1 :k2] [:k1 :k2] nil 109 | plus [:k1 :k2 "x"] ::s/invalid '[{:pred clojure.core/keyword?, :val "x", :in [2]}] 110 | plus ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a" :via []}] 111 | 112 | opt nil nil nil 113 | opt [] nil nil 114 | opt :k ::s/invalid '[{:pred (clojure.spec.alpha/? clojure.core/keyword?), :val :k}] 115 | opt [:k] :k nil 116 | opt [:k1 :k2] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/? clojure.core/keyword?), :val (:k2)}] 117 | opt [:k1 :k2 "x"] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/? clojure.core/keyword?), :val (:k2 "x")}] 118 | opt ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a"}] 119 | 120 | andre nil nil nil 121 | andre [] nil nil 122 | andre :k :clojure.spec.alpha/invalid '[{:pred (clojure.spec.alpha/& (clojure.spec.alpha/* clojure.core/keyword?) clojure.test-clojure.spec/even-count?), :val :k}] 123 | andre [:k] ::s/invalid '[{:pred clojure.test-clojure.spec/even-count?, :val [:k]}] 124 | andre [:j :k] [:j :k] nil 125 | 126 | m nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] 127 | m {} {} nil 128 | m {:a "b"} {:a "b"} nil 129 | 130 | mkeys nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] 131 | mkeys {} {} nil 132 | mkeys {:a 1 :b 2} {:a 1 :b 2} nil 133 | 134 | mkeys2 nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] 135 | mkeys2 {} {} nil 136 | mkeys2 {:a 1 :b 2} {"a" 1 "b" 2} nil 137 | 138 | s '([:a 1] [:b "2"]) '({:tag :a :val 1} {:tag :b :val "2"}) nil 139 | 140 | v [:a :b] [:a :b] nil 141 | v '(:a :b) ::s/invalid '[{:pred clojure.core/vector? :val (:a :b)}] 142 | 143 | coll nil ::s/invalid '[{:path [], :pred clojure.core/coll?, :val nil, :via [], :in []}] 144 | coll [] [] nil 145 | coll [:a] [:a] nil 146 | coll [:a :b] [:a :b] nil 147 | coll (map identity [:a :b]) '(:a :b) nil 148 | ;;coll [:a "b"] ::s/invalid '[{:pred (coll-checker keyword?), :val [:a b]}] 149 | ))) 150 | 151 | (defn check-conform-unform [spec vals expected-conforms] 152 | (let [actual-conforms (map #(s/conform spec %) vals) 153 | unforms (map #(s/unform spec %) actual-conforms)] 154 | (is (= actual-conforms expected-conforms)) 155 | (is (= vals unforms)))) 156 | 157 | (deftest nilable-conform-unform 158 | (check-conform-unform 159 | (s/nilable int?) 160 | [5 nil] 161 | [5 nil]) 162 | (check-conform-unform 163 | (s/nilable (s/or :i int? :s string?)) 164 | [5 "x" nil] 165 | [[:i 5] [:s "x"] nil])) 166 | 167 | (deftest nonconforming-conform-unform 168 | (check-conform-unform 169 | (s/nonconforming (s/or :i int? :s string?)) 170 | [5 "x"] 171 | [5 "x"])) 172 | 173 | (deftest coll-form 174 | (are [spec form] 175 | (= (s/form spec) form) 176 | (s/map-of int? any?) 177 | '(clojure.spec.alpha/map-of clojure.future/int? clojure.future/any?) 178 | 179 | (s/coll-of int?) 180 | '(clojure.spec.alpha/coll-of clojure.future/int?) 181 | 182 | (s/every-kv int? int?) 183 | '(clojure.spec.alpha/every-kv clojure.future/int? clojure.future/int?) 184 | 185 | (s/every int?) 186 | '(clojure.spec.alpha/every clojure.future/int?) 187 | 188 | (s/coll-of (s/tuple (s/tuple int?))) 189 | '(clojure.spec.alpha/coll-of (clojure.spec.alpha/tuple (clojure.spec.alpha/tuple clojure.future/int?))) 190 | 191 | (s/coll-of int? :kind vector?) 192 | '(clojure.spec.alpha/coll-of clojure.future/int? :kind clojure.core/vector?) 193 | 194 | (s/coll-of int? :gen #(gen/return [1 2])) 195 | '(clojure.spec.alpha/coll-of clojure.future/int? :gen (fn* [] (gen/return [1 2]))))) 196 | 197 | (deftest coll-conform-unform 198 | (check-conform-unform 199 | (s/coll-of (s/or :i int? :s string?)) 200 | [[1 "x"]] 201 | [[[:i 1] [:s "x"]]]) 202 | (check-conform-unform 203 | (s/every (s/or :i int? :s string?)) 204 | [[1 "x"]] 205 | [[1 "x"]]) 206 | (check-conform-unform 207 | (s/map-of int? (s/or :i int? :s string?)) 208 | [{10 10 20 "x"}] 209 | [{10 [:i 10] 20 [:s "x"]}]) 210 | (check-conform-unform 211 | (s/map-of (s/or :i int? :s string?) int? :conform-keys true) 212 | [{10 10 "x" 20}] 213 | [{[:i 10] 10 [:s "x"] 20}]) 214 | (check-conform-unform 215 | (s/every-kv int? (s/or :i int? :s string?)) 216 | [{10 10 20 "x"}] 217 | [{10 10 20 "x"}])) 218 | 219 | (comment 220 | (require '[clojure.test :refer (run-tests)]) 221 | (in-ns 'clojure.test-clojure.spec) 222 | (run-tests) 223 | 224 | ) 225 | -------------------------------------------------------------------------------- /test19/clojure/test_clojure/spec.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.test-clojure.spec 2 | (:require [clojure.spec.alpha :as s] 3 | [clojure.spec.gen.alpha :as gen] 4 | [clojure.spec.test.alpha :as stest] 5 | [clojure.future :refer :all] 6 | [clojure.test :refer :all])) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | (defmacro result-or-ex [x] 11 | `(try 12 | ~x 13 | (catch Throwable t# 14 | (.getName (class t#))))) 15 | 16 | (def even-count? #(even? (count %))) 17 | 18 | (defn submap? 19 | "Is m1 a subset of m2?" 20 | [m1 m2] 21 | (if (and (map? m1) (map? m2)) 22 | (every? (fn [[k v]] (and (contains? m2 k) 23 | (submap? v (get m2 k)))) 24 | m1) 25 | (= m1 m2))) 26 | 27 | (deftest conform-explain 28 | (let [a (s/and #(> % 5) #(< % 10)) 29 | o (s/or :s string? :k keyword?) 30 | c (s/cat :a string? :b keyword?) 31 | either (s/alt :a string? :b keyword?) 32 | star (s/* keyword?) 33 | plus (s/+ keyword?) 34 | opt (s/? keyword?) 35 | andre (s/& (s/* keyword?) even-count?) 36 | m (s/map-of keyword? string?) 37 | mkeys (s/map-of (s/and keyword? (s/conformer name)) any?) 38 | mkeys2 (s/map-of (s/and keyword? (s/conformer name)) any? :conform-keys true) 39 | s (s/coll-of (s/spec (s/cat :tag keyword? :val any?)) :kind list?) 40 | v (s/coll-of keyword? :kind vector?) 41 | coll (s/coll-of keyword?) 42 | lrange (s/int-in 7 42) 43 | drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2) 44 | irange (s/inst-in #inst "1939" #inst "1946") 45 | ] 46 | (are [spec x conformed ed] 47 | (let [co (result-or-ex (s/conform spec x)) 48 | e (result-or-ex (::s/problems (s/explain-data spec x)))] 49 | (when (not= conformed co) (println "conform fail\n\texpect=" conformed "\n\tactual=" co)) 50 | (when (not (every? true? (map submap? ed e))) 51 | (println "explain failures\n\texpect=" ed "\n\tactual failures=" e "\n\tsubmap?=" (map submap? ed e))) 52 | (and (= conformed co) (every? true? (map submap? ed e)))) 53 | 54 | lrange 7 7 nil 55 | lrange 8 8 nil 56 | lrange 42 ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.spec.alpha/int-in-range? 7 42 %)), :val 42}] 57 | 58 | irange #inst "1938" ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.spec.alpha/inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %)), :val #inst "1938"}] 59 | irange #inst "1942" #inst "1942" nil 60 | irange #inst "1946" ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.spec.alpha/inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %)), :val #inst "1946"}] 61 | 62 | drange 3.0 ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.core/<= 3.1 %)), :val 3.0}] 63 | drange 3.1 3.1 nil 64 | drange 3.2 3.2 nil 65 | drange Double/POSITIVE_INFINITY ::s/invalid [{:pred '(clojure.core/fn [%] (clojure.core/not (Double/isInfinite %))), :val Double/POSITIVE_INFINITY}] 66 | ;; can't use equality-based test for Double/NaN 67 | ;; drange Double/NaN ::s/invalid {[] {:pred '(clojure.core/fn [%] (clojure.core/not (Double/isNaN %))), :val Double/NaN}} 68 | 69 | keyword? :k :k nil 70 | keyword? nil ::s/invalid [{:pred ::s/unknown :val nil}] 71 | keyword? "abc" ::s/invalid [{:pred ::s/unknown :val "abc"}] 72 | 73 | a 6 6 nil 74 | a 3 ::s/invalid '[{:pred (clojure.core/fn [%] (clojure.core/> % 5)), :val 3}] 75 | a 20 ::s/invalid '[{:pred (clojure.core/fn [%] (clojure.core/< % 10)), :val 20}] 76 | a nil "java.lang.NullPointerException" "java.lang.NullPointerException" 77 | a :k "java.lang.ClassCastException" "java.lang.ClassCastException" 78 | 79 | o "a" [:s "a"] nil 80 | o :a [:k :a] nil 81 | o 'a ::s/invalid '[{:pred clojure.core/string?, :val a, :path [:s]} {:pred clojure.core/keyword?, :val a :path [:k]}] 82 | 83 | c nil ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/string?, :val (), :path [:a]}] 84 | c [] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/string?, :val (), :path [:a]}] 85 | c [:a] ::s/invalid '[{:pred clojure.core/string?, :val :a, :path [:a], :in [0]}] 86 | c ["a"] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val (), :path [:b]}] 87 | c ["s" :k] '{:a "s" :b :k} nil 88 | c ["s" :k 5] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/cat :a clojure.core/string? :b clojure.core/keyword?), :val (5)}] 89 | (s/cat) nil {} nil 90 | (s/cat) [5] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/cat), :val (5), :in [0]}] 91 | 92 | either nil ::s/invalid '[{:reason "Insufficient input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val () :via []}] 93 | either [] ::s/invalid '[{:reason "Insufficient input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val () :via []}] 94 | either [:k] [:b :k] nil 95 | either ["s"] [:a "s"] nil 96 | either [:b "s"] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/alt :a clojure.core/string? :b clojure.core/keyword?), :val ("s") :via []}] 97 | 98 | star nil [] nil 99 | star [] [] nil 100 | star [:k] [:k] nil 101 | star [:k1 :k2] [:k1 :k2] nil 102 | star [:k1 :k2 "x"] ::s/invalid '[{:pred clojure.core/keyword?, :val "x" :via []}] 103 | star ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a" :via []}] 104 | 105 | plus nil ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val () :via []}] 106 | plus [] ::s/invalid '[{:reason "Insufficient input", :pred clojure.core/keyword?, :val () :via []}] 107 | plus [:k] [:k] nil 108 | plus [:k1 :k2] [:k1 :k2] nil 109 | plus [:k1 :k2 "x"] ::s/invalid '[{:pred clojure.core/keyword?, :val "x", :in [2]}] 110 | plus ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a" :via []}] 111 | 112 | opt nil nil nil 113 | opt [] nil nil 114 | opt :k ::s/invalid '[{:pred (clojure.spec.alpha/? clojure.core/keyword?), :val :k}] 115 | opt [:k] :k nil 116 | opt [:k1 :k2] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/? clojure.core/keyword?), :val (:k2)}] 117 | opt [:k1 :k2 "x"] ::s/invalid '[{:reason "Extra input", :pred (clojure.spec.alpha/? clojure.core/keyword?), :val (:k2 "x")}] 118 | opt ["a"] ::s/invalid '[{:pred clojure.core/keyword?, :val "a"}] 119 | 120 | andre nil nil nil 121 | andre [] nil nil 122 | andre :k :clojure.spec.alpha/invalid '[{:pred (clojure.spec.alpha/& (clojure.spec.alpha/* clojure.core/keyword?) clojure.test-clojure.spec/even-count?), :val :k}] 123 | andre [:k] ::s/invalid '[{:pred clojure.test-clojure.spec/even-count?, :val [:k]}] 124 | andre [:j :k] [:j :k] nil 125 | 126 | m nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] 127 | m {} {} nil 128 | m {:a "b"} {:a "b"} nil 129 | 130 | mkeys nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] 131 | mkeys {} {} nil 132 | mkeys {:a 1 :b 2} {:a 1 :b 2} nil 133 | 134 | mkeys2 nil ::s/invalid '[{:pred clojure.core/map?, :val nil}] 135 | mkeys2 {} {} nil 136 | mkeys2 {:a 1 :b 2} {"a" 1 "b" 2} nil 137 | 138 | s '([:a 1] [:b "2"]) '({:tag :a :val 1} {:tag :b :val "2"}) nil 139 | 140 | v [:a :b] [:a :b] nil 141 | v '(:a :b) ::s/invalid '[{:pred clojure.core/vector? :val (:a :b)}] 142 | 143 | coll nil ::s/invalid '[{:path [], :pred clojure.core/coll?, :val nil, :via [], :in []}] 144 | coll [] [] nil 145 | coll [:a] [:a] nil 146 | coll [:a :b] [:a :b] nil 147 | coll (map identity [:a :b]) '(:a :b) nil 148 | ;;coll [:a "b"] ::s/invalid '[{:pred (coll-checker keyword?), :val [:a b]}] 149 | ))) 150 | 151 | (defn check-conform-unform [spec vals expected-conforms] 152 | (let [actual-conforms (map #(s/conform spec %) vals) 153 | unforms (map #(s/unform spec %) actual-conforms)] 154 | (is (= actual-conforms expected-conforms)) 155 | (is (= vals unforms)))) 156 | 157 | (deftest nilable-conform-unform 158 | (check-conform-unform 159 | (s/nilable int?) 160 | [5 nil] 161 | [5 nil]) 162 | (check-conform-unform 163 | (s/nilable (s/or :i int? :s string?)) 164 | [5 "x" nil] 165 | [[:i 5] [:s "x"] nil])) 166 | 167 | (deftest nonconforming-conform-unform 168 | (check-conform-unform 169 | (s/nonconforming (s/or :i int? :s string?)) 170 | [5 "x"] 171 | [5 "x"])) 172 | 173 | (deftest coll-form 174 | (are [spec form] 175 | (= (s/form spec) form) 176 | (s/map-of int? any?) 177 | '(clojure.spec.alpha/map-of clojure.core/int? clojure.core/any?) 178 | 179 | (s/coll-of int?) 180 | '(clojure.spec.alpha/coll-of clojure.core/int?) 181 | 182 | (s/every-kv int? int?) 183 | '(clojure.spec.alpha/every-kv clojure.core/int? clojure.core/int?) 184 | 185 | (s/every int?) 186 | '(clojure.spec.alpha/every clojure.core/int?) 187 | 188 | (s/coll-of (s/tuple (s/tuple int?))) 189 | '(clojure.spec.alpha/coll-of (clojure.spec.alpha/tuple (clojure.spec.alpha/tuple clojure.core/int?))) 190 | 191 | (s/coll-of int? :kind vector?) 192 | '(clojure.spec.alpha/coll-of clojure.core/int? :kind clojure.core/vector?) 193 | 194 | (s/coll-of int? :gen #(gen/return [1 2])) 195 | '(clojure.spec.alpha/coll-of clojure.core/int? :gen (fn* [] (gen/return [1 2]))))) 196 | 197 | (deftest coll-conform-unform 198 | (check-conform-unform 199 | (s/coll-of (s/or :i int? :s string?)) 200 | [[1 "x"]] 201 | [[[:i 1] [:s "x"]]]) 202 | (check-conform-unform 203 | (s/every (s/or :i int? :s string?)) 204 | [[1 "x"]] 205 | [[1 "x"]]) 206 | (check-conform-unform 207 | (s/map-of int? (s/or :i int? :s string?)) 208 | [{10 10 20 "x"}] 209 | [{10 [:i 10] 20 [:s "x"]}]) 210 | (check-conform-unform 211 | (s/map-of (s/or :i int? :s string?) int? :conform-keys true) 212 | [{10 10 "x" 20}] 213 | [{[:i 10] 10 [:s "x"] 20}]) 214 | (check-conform-unform 215 | (s/every-kv int? (s/or :i int? :s string?)) 216 | [{10 10 20 "x"}] 217 | [{10 10 20 "x"}])) 218 | 219 | (comment 220 | (require '[clojure.test :refer (run-tests)]) 221 | (in-ns 'clojure.test-clojure.spec) 222 | (run-tests) 223 | 224 | ) 225 | --------------------------------------------------------------------------------