diff -Nru clojure-1.9.0~alpha15/build.xml clojure-1.9.0/build.xml --- clojure-1.9.0~alpha15/build.xml 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/build.xml 2017-12-08 13:59:39.000000000 +0000 @@ -59,7 +59,6 @@ - @@ -82,13 +81,6 @@ - - - - - @@ -100,7 +92,7 @@ debug="true" source="1.6" target="1.6" includeantruntime="no"/> Direct linking = ${directlinking} @@ -202,4 +194,11 @@ + + + + + + + diff -Nru clojure-1.9.0~alpha15/changes.md clojure-1.9.0/changes.md --- clojure-1.9.0~alpha15/changes.md 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/changes.md 2017-12-08 13:59:39.000000000 +0000 @@ -1,5 +1,181 @@ +# Changes to Clojure in Version 1.9 + +## 1 New and Improved Features + +### 1.1 spec + +spec is a new core library for describing, validating, and testing the structure of data and functions. + +For more information, see: + +* [About spec](https://clojure.org/about/spec) +* [spec Guide](https://clojure.org/guides/spec) + +Note that spec is in alpha state and API compatibility is not guaranteed. Also, spec and the specs for the Clojure core API are distributed as external libraries that must be included to use Clojure. + +### 1.2 Support for working with maps with qualified keys + +Several enhancements have been made to add support for working with maps with qualified keys: + +* Map namespace syntax - specify the default namespace context for the keys (or symbols) in a map once - `#:car{:make "Jeep" :model "Wrangler"}`. For more information see https://clojure.org/reference/reader#_maps ([CLJ-1910](http://dev.clojure.org/jira/browse/CLJ-1910)) +* Destructuring support - namespaced map keys can now specified once as a namespace for :keys or :syms. For more information see https://clojure.org/reference/special_forms#_map_binding_destructuring ([CLJ-1919](http://dev.clojure.org/jira/browse/CLJ-1919)) +* `*print-namespace-maps*` - by default maps will not print with the map namespace syntax except in the clojure.main repl. This dynamic var is a flag to allow you to control whether the namespace map syntax is used. + +### 1.3 New predicates + +Specs rely heavily on predicates and many new type and value oriented predicates have been added to clojure.core: + +* `boolean?` +* `int?` `pos-int?` `neg-int?` `nat-int?` +* `double?` +* `ident?` `simple-ident?` `qualified-ident?` +* `simple-symbol?` `qualified-symbol?` +* `simple-keyword?` `qualified-keyword?` +* `bytes?` (for `byte[]`) +* `indexed?` +* `uuid?` `uri?` +* `seqable?` +* `any?` + +### 1.4 More support for instants + +More support has been added for the notion of instants in time: + +* Added a new protocol `Inst` for instant types +* `Inst` is extended for `java.util.Date` +* `Inst` is optionally extended for `java.time.Instant` in Java 1.8+ +* New functions that work for instants: `inst?`, `inst-ms` + +### 1.5 Other new core functions + +These are some other new functions in clojure.core: + +* `bounded-count` - a count that avoids realizing the entire collection beyond a bound +* `swap-vals!` and `reset-vals!` - new atom functions that return both the old and new values ([CLJ-1454](http://dev.clojure.org/jira/browse/CLJ-1454)) +* `halt-when` - new transducer that ends transduction when pred is satisfied + +### 1.6 Other reader enhancements + +* Can now bind `*reader-resolver*` to an impl of LispReader$Resolver to control the reader’s use of namespace interactions when resolving autoresolved keywords and maps. +* Add new ## reader macro for symbolic values, and read/print support for double vals ##Inf, ##-Inf, ##NaN ([CLJ-1074](http://dev.clojure.org/jira/browse/CLJ-1074)) + +## 2 Enhancements + +### 2.1 Spec syntax checking + +If a macro has a spec defined via fdef, that spec will be checked at compile time. Specs have been defined for many clojure.core macros and errors will be reported for these based on the specs at compile time. + +### 2.2 Documentation + +* `doc` will now report specs for functions with specs defined using `fdef` +* `doc` can now be invoked with a fully-qualified keyword representing a spec name + +### 2.3 Performance + +* Improved update-in performance +* Optimized seq & destructuring +* [CLJ-2210](http://dev.clojure.org/jira/browse/CLJ-2210) + Cache class derivation in compiler to improve compiler performance +* [CLJ-2188](http://dev.clojure.org/jira/browse/CLJ-2188) + `slurp` - mark return type as String +* [CLJ-2070](http://dev.clojure.org/jira/browse/CLJ-2070) + `clojure.core/delay` - improve performance +* [CLJ-1917](http://dev.clojure.org/jira/browse/CLJ-1917) + Reducing seq over string should call String/length outside of loop +* [CLJ-1901](http://dev.clojure.org/jira/browse/CLJ-1901) + `amap` - should call alength only once +* [CLJ-1224](http://dev.clojure.org/jira/browse/CLJ-1935) + Record instances now cache hasheq and hashCode like maps +* [CLJ-99](http://dev.clojure.org/jira/browse/CLJ-99) + `min-key` and `max-key` - evaluate k on each arg at most once + +### 2.4 Other enhancements + +* Added Var serialization for identity, not value +* `into` now has a 0-arity (returns `[]`) and 1-arity (returns the coll that's passed) +* [CLJ-2184](http://dev.clojure.org/jira/browse/CLJ-2184) + Propagate meta in doto forms to improve error reporting +* [CLJ-1744](http://dev.clojure.org/jira/browse/CLJ-1744) + Clear unused locals, which can prevent memory leaks in some cases +* [CLJ-1673](http://dev.clojure.org/jira/browse/CLJ-1673) + `clojure.repl/dir-fn` now works on namespace aliases +* [CLJ-1423](http://dev.clojure.org/jira/browse/CLJ-1423) + Allow vars to be invoked with infinite arglists (also, faster) + +## 3 Fixes + +### 3.1 Security + +* [CLJ-2204](http://dev.clojure.org/jira/browse/CLJ-2204) + Disable serialization of proxy classes to avoid potential issue when deserializing + +### 3.2 Docs + +* [CLJ-2170](http://dev.clojure.org/jira/browse/CLJ-2170) + fix improperly located docstrings +* [CLJ-2156](http://dev.clojure.org/jira/browse/CLJ-2156) + `clojure.java.io/copy` - doc char[] support +* [CLJ-2104](http://dev.clojure.org/jira/browse/CLJ-2104) + `clojure.pprint` docstring - fix typo +* [CLJ-2051](http://dev.clojure.org/jira/browse/CLJ-2051) + `clojure.instant/validated` docstring - fix typo +* [CLJ-2039](http://dev.clojure.org/jira/browse/CLJ-2039) + `deftype` - fix typo in docstring +* [CLJ-2028](http://dev.clojure.org/jira/browse/CLJ-2028) + `filter`, `filterv`, `remove`, `take-while` - fix docstrings +* [CLJ-1918](http://dev.clojure.org/jira/browse/CLJ-1918) + `await` - improve docstring re `shutdown-agents` +* [CLJ-1873](http://dev.clojure.org/jira/browse/CLJ-1873) + `require`, `*data-readers*` - add .cljc files to docstrings +* [CLJ-1859](http://dev.clojure.org/jira/browse/CLJ-1859) + `zero?`, `pos?`, `neg?` - fix docstrings +* [CLJ-1837](http://dev.clojure.org/jira/browse/CLJ-1837) + `index-of`, `last-index-of` - clarify docstrings +* [CLJ-1826](http://dev.clojure.org/jira/browse/CLJ-1826) + `drop-last` - fix docstring +* [CLJ-1159](http://dev.clojure.org/jira/browse/CLJ-1159) + `clojure.java.io/delete-file` - improve docstring + +### 3.3 Other fixes + +* `clojure.core/Throwable->map` formerly returned `StackTraceElement`s which were later handled by the printer. Now the StackTraceElements are converted to data such that the return value is pure Clojure data, as intended. +* [CLJ-2091](http://dev.clojure.org/jira/browse/CLJ-2091) + `clojure.lang.APersistentVector#hashCode` is not thread-safe +* [CLJ-2077](http://dev.clojure.org/jira/browse/CLJ-2077) + Clojure can't be loaded from the boot classpath under java 9 +* [CLJ-2048](http://dev.clojure.org/jira/browse/CLJ-2048) + Specify type to avoid ClassCastException when stack trace is elided by JVM +* [CLJ-1914](http://dev.clojure.org/jira/browse/CLJ-1914) + Fixed race condition in concurrent `range` realization +* [CLJ-1887](http://dev.clojure.org/jira/browse/CLJ-1887) + `IPersistentVector.length()` - implement missing method +* [CLJ-1870](http://dev.clojure.org/jira/browse/CLJ-1870) + Fixed reloading a `defmulti` removes metadata on the var +* [CLJ-1860](http://dev.clojure.org/jira/browse/CLJ-1860) + Make -0.0 hash consistent with 0.0 +* [CLJ-1841](http://dev.clojure.org/jira/browse/CLJ-1841) + `bean` - iterator was broken +* [CLJ-1793](http://dev.clojure.org/jira/browse/CLJ-1793) + Clear 'this' before calls in tail position +* [CLJ-1790](http://dev.clojure.org/jira/browse/CLJ-1790) + Fixed error extending protocols to Java arrays +* [CLJ-1714](http://dev.clojure.org/jira/browse/CLJ-1714) + using a class in a type hint shouldn’t load the class +* [CLJ-1705](http://dev.clojure.org/jira/browse/CLJ-1705) + `vector-of` - fix NullPointerException if given unrecognized type +* [CLJ-1398](http://dev.clojure.org/jira/browse/CLJ-1398) + `clojure.java.javadoc/javadoc` - update doc urls +* [CLJ-1371](http://dev.clojure.org/jira/browse/CLJ-1371) + `Numbers.divide(Object, Object)` - add checks for NaN +* [CLJ-1358](http://dev.clojure.org/jira/browse/CLJ-1358) + `doc` - does not expand special cases properly (try, catch) +* [CLJ-1242](http://dev.clojure.org/jira/browse/CLJ-1242) + equals doesn't throw on sorted collections +* [CLJ-700](http://dev.clojure.org/jira/browse/CLJ-700) + `contains?`, `get`, and `find` broken for transient collections + # Changes to Clojure in Version 1.8 ## 1 New and Improved Features diff -Nru clojure-1.9.0~alpha15/debian/changelog clojure-1.9.0/debian/changelog --- clojure-1.9.0~alpha15/debian/changelog 2018-02-23 02:48:26.000000000 +0000 +++ clojure-1.9.0/debian/changelog 2018-02-27 23:27:02.000000000 +0000 @@ -1,3 +1,24 @@ +clojure (1.9.0-2) unstable; urgency=medium + + * Add missing libclojure-java dependencies. + * Actually use javahelper to set classpath. + + -- Elana Hashman Tue, 27 Feb 2018 18:27:02 -0500 + +clojure (1.9.0-1) unstable; urgency=medium + + [ Elana Hashman ] + * New upstream version. (Closes: #886565) + * Updated clojure.jar's classpath + * Updated clojure wrapper scripts with correct classpath + * Add versioned dependency on libclojure-java (Closes: #887409) + + [ Emmanuel Bourg ] + * Switch to debhelper level 11 + * Actually made things build + + -- Elana Hashman Tue, 27 Feb 2018 15:28:29 -0500 + clojure (1.9.0~alpha15-2) unstable; urgency=medium * Package breaks libclojure1.8-java (Closes: #891178) diff -Nru clojure-1.9.0~alpha15/debian/clean clojure-1.9.0/debian/clean --- clojure-1.9.0~alpha15/debian/clean 1970-01-01 00:00:00.000000000 +0000 +++ clojure-1.9.0/debian/clean 2018-02-27 19:17:39.000000000 +0000 @@ -0,0 +1 @@ +maven-classpath.properties diff -Nru clojure-1.9.0~alpha15/debian/compat clojure-1.9.0/debian/compat --- clojure-1.9.0~alpha15/debian/compat 2018-01-15 17:28:34.000000000 +0000 +++ clojure-1.9.0/debian/compat 2018-02-27 19:17:39.000000000 +0000 @@ -1 +1 @@ -10 +11 diff -Nru clojure-1.9.0~alpha15/debian/control clojure-1.9.0/debian/control --- clojure-1.9.0~alpha15/debian/control 2018-02-23 02:37:33.000000000 +0000 +++ clojure-1.9.0/debian/control 2018-02-27 23:01:05.000000000 +0000 @@ -5,9 +5,11 @@ Uploaders: Elana Hashman Build-Depends: ant, - debhelper (>= 10), + debhelper (>= 11), default-jdk, javahelper, + libcore-specs-alpha-clojure, + libspec-alpha-clojure, maven-repo-helper, rename Standards-Version: 4.1.3 @@ -19,7 +21,7 @@ Architecture: all Depends: default-jre-headless | java8-runtime-headless, - libclojure-java, + libclojure-java (= ${binary:Version}), ${misc:Depends} Recommends: rlwrap Description: Lisp dialect for the JVM @@ -44,6 +46,7 @@ Architecture: all Depends: libjsr166y-java, + ${java:Depends}, ${misc:Depends} Breaks: clojure (<< 1.9), libclojure1.8-java Replaces: clojure (<< 1.9), libclojure1.8-java diff -Nru clojure-1.9.0~alpha15/debian/libclojure-java.classpath clojure-1.9.0/debian/libclojure-java.classpath --- clojure-1.9.0~alpha15/debian/libclojure-java.classpath 1970-01-01 00:00:00.000000000 +0000 +++ clojure-1.9.0/debian/libclojure-java.classpath 2018-02-27 23:13:43.000000000 +0000 @@ -0,0 +1 @@ +usr/share/java/clojure-1.9.jar /usr/share/maven-repo/org/clojure/spec.alpha/debian/spec.alpha-debian.jar /usr/share/maven-repo/org/clojure/core.specs.alpha/debian/core.specs.alpha-debian.jar diff -Nru clojure-1.9.0~alpha15/debian/maven-classpath.properties clojure-1.9.0/debian/maven-classpath.properties --- clojure-1.9.0~alpha15/debian/maven-classpath.properties 1970-01-01 00:00:00.000000000 +0000 +++ clojure-1.9.0/debian/maven-classpath.properties 2018-02-27 19:17:39.000000000 +0000 @@ -0,0 +1,2 @@ +maven.compile.classpath=/usr/share/maven-repo/org/clojure/spec.alpha/debian/spec.alpha-debian.jar:\ + /usr/share/maven-repo/org/clojure/core.specs.alpha/debian/core.specs.alpha-debian.jar diff -Nru clojure-1.9.0~alpha15/debian/rules clojure-1.9.0/debian/rules --- clojure-1.9.0~alpha15/debian/rules 2018-02-23 02:25:23.000000000 +0000 +++ clojure-1.9.0/debian/rules 2018-02-27 23:12:29.000000000 +0000 @@ -5,13 +5,17 @@ JAVA_HOME = /usr/lib/jvm/default-java %: - dh $@ --with maven-repo-helper + dh $@ --with javahelper,maven-repo-helper + +override_dh_auto_configure: + dh_auto_configure + cp debian/maven-classpath.properties . override_dh_auto_build: dh_auto_build -- jar override_dh_install: - $(JAVA_HOME)/bin/java -cp clojure.jar clojure.main debian/gencompletions.clj > debian/clojure/etc/rlwrap/clojure$(VER) + $(JAVA_HOME)/bin/java -cp clojure.jar:/usr/share/maven-repo/org/clojure/spec.alpha/debian/spec.alpha-debian.jar:/usr/share/maven-repo/org/clojure/core.specs.alpha/debian/core.specs.alpha-debian.jar clojure.main debian/gencompletions.clj > debian/clojure/etc/rlwrap/clojure$(VER) dh_install diff -Nru clojure-1.9.0~alpha15/debian/watch clojure-1.9.0/debian/watch --- clojure-1.9.0~alpha15/debian/watch 2018-02-23 02:25:23.000000000 +0000 +++ clojure-1.9.0/debian/watch 2018-02-27 03:31:03.000000000 +0000 @@ -1,3 +1,3 @@ version=4 -opts="mode=git, pgpmode=none, uversionmangle=s/(\d)[_\.\-\+]?((RC|rc|pre|dev|beta|alpha)\d*)$/$1~$2/, dversionmangle=s/\+dfsg//" \ -https://github.com/clojure/clojure refs/tags/clojure-(.+) +opts="mode=git, pgpmode=none, dversionmangle=s/\+dfsg//" \ +https://github.com/clojure/clojure refs/tags/clojure-([\d\.]+) diff -Nru clojure-1.9.0~alpha15/pom.xml clojure-1.9.0/pom.xml --- clojure-1.9.0~alpha15/pom.xml 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/pom.xml 2017-12-08 13:59:39.000000000 +0000 @@ -5,7 +5,7 @@ clojure clojure jar - 1.9.0-alpha15 + 1.9.0 http://clojure.org/ Clojure core environment and runtime library. @@ -30,7 +30,7 @@ scm:git:git@github.com:clojure/clojure.git scm:git:git@github.com:clojure/clojure.git git@github.com:clojure/clojure.git - clojure-1.9.0-alpha15 + clojure-1.9.0 @@ -39,6 +39,16 @@ + org.clojure + spec.alpha + 0.1.143 + + + org.clojure + core.specs.alpha + 0.1.24 + + org.codehaus.jsr166-mirror jsr166y 1.7.0 @@ -239,21 +249,6 @@ - - - org.apache.maven.plugins - maven-gpg-plugin - 1.5 - - - sign-artifacts - verify - - sign - - - - @@ -298,5 +293,68 @@ + + + sign + + + + org.apache.maven.plugins + maven-gpg-plugin + 1.5 + + + sign-artifacts + verify + + sign + + + + + + + + + local + + + org.clojure + test.check + 0.9.0 + + + org.clojure + clojure + + + + + + + + org.apache.maven.plugins + maven-shade-plugin + 3.1.0 + + + package + + shade + + + + + clojure.main + + + clojure.jar + + + + + + + diff -Nru clojure-1.9.0~alpha15/readme.txt clojure-1.9.0/readme.txt --- clojure-1.9.0~alpha15/readme.txt 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/readme.txt 2017-12-08 13:59:39.000000000 +0000 @@ -7,29 +7,32 @@ * the terms of this license. * You must not remove this notice, or any other, from this software. -Docs: http://clojure.org +Docs: https://clojure.org Feedback: http://groups.google.com/group/clojure -Getting Started: http://dev.clojure.org/display/doc/Getting+Started +Getting Started: https://clojure.org/guides/getting_started -To run: java -cp clojure-${VERSION}.jar clojure.main - -To build locally with Ant: +To build and run locally with Ant: One-time setup: ./antsetup.sh - To build: ant + To build: ant local + To run: java -jar clojure.jar -Maven 2 build instructions: +To build locally with Maven: - To build: mvn package - The built JARs will be in target/ + To build (output JARs in target/): + mvn package - To build without testing: mvn package -Dmaven.test.skip=true + To build without testing: + mvn package -Dmaven.test.skip=true - To build and install in local Maven repository: mvn install + To build and install in local Maven repository: + mvn install - To build a ZIP distribution: mvn package -Pdistribution - The built .zip will be in target/ + To build a standalone jar with dependencies included: + mvn -Plocal -Dmaven.test.skip=true package + To run with the standalone jar: + java -jar clojure.jar -------------------------------------------------------------------------- This program uses the ASM bytecode engineering library which is distributed diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/core/protocols.clj clojure-1.9.0/src/clj/clojure/core/protocols.clj --- clojure-1.9.0~alpha15/src/clj/clojure/core/protocols.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/core/protocols.clj 2017-12-08 13:59:39.000000000 +0000 @@ -145,10 +145,11 @@ clojure.lang.StringSeq (internal-reduce [str-seq f val] - (let [s (.s str-seq)] + (let [s (.s str-seq) + len (.length s)] (loop [i (.i str-seq) val val] - (if (< i (.length s)) + (if (< i len) (let [ret (f val (.charAt s i))] (if (reduced? ret) @ret diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/core/specs.clj clojure-1.9.0/src/clj/clojure/core/specs.clj --- clojure-1.9.0~alpha15/src/clj/clojure/core/specs.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/core/specs.clj 1970-01-01 00:00:00.000000000 +0000 @@ -1,225 +0,0 @@ -(ns ^{:skip-wiki true} clojure.core.specs - (:require [clojure.spec :as s])) - -;;;; destructure - -(s/def ::local-name (s/and simple-symbol? #(not= '& %))) - -(s/def ::binding-form - (s/or :sym ::local-name - :seq ::seq-binding-form - :map ::map-binding-form)) - -;; sequential destructuring - -(s/def ::seq-binding-form - (s/and vector? - (s/cat :elems (s/* ::binding-form) - :rest (s/? (s/cat :amp #{'&} :form ::binding-form)) - :as (s/? (s/cat :as #{:as} :sym ::local-name))))) - -;; map destructuring - -(s/def ::keys (s/coll-of ident? :kind vector?)) -(s/def ::syms (s/coll-of symbol? :kind vector?)) -(s/def ::strs (s/coll-of simple-symbol? :kind vector?)) -(s/def ::or (s/map-of simple-symbol? any?)) -(s/def ::as ::local-name) - -(s/def ::map-special-binding - (s/keys :opt-un [::as ::or ::keys ::syms ::strs])) - -(s/def ::map-binding (s/tuple ::binding-form any?)) - -(s/def ::ns-keys - (s/tuple - (s/and qualified-keyword? #(-> % name #{"keys" "syms"})) - (s/coll-of simple-symbol? :kind vector?))) - -(s/def ::map-bindings - (s/every (s/or :mb ::map-binding - :nsk ::ns-keys - :msb (s/tuple #{:as :or :keys :syms :strs} any?)) :into {})) - -(s/def ::map-binding-form (s/merge ::map-bindings ::map-special-binding)) - -;; bindings - -(s/def ::binding (s/cat :binding ::binding-form :init-expr any?)) -(s/def ::bindings (s/and vector? (s/* ::binding))) - -;; let, if-let, when-let - -(s/fdef clojure.core/let - :args (s/cat :bindings ::bindings - :body (s/* any?))) - -(s/fdef clojure.core/if-let - :args (s/cat :bindings (s/and vector? ::binding) - :then any? - :else (s/? any?))) - -(s/fdef clojure.core/when-let - :args (s/cat :bindings (s/and vector? ::binding) - :body (s/* any?))) - -;; defn, defn-, fn - -(s/def ::arg-list - (s/and - vector? - (s/cat :args (s/* ::binding-form) - :varargs (s/? (s/cat :amp #{'&} :form ::binding-form))))) - -(s/def ::args+body - (s/cat :args ::arg-list - :body (s/alt :prepost+body (s/cat :prepost map? - :body (s/+ any?)) - :body (s/* any?)))) - -(s/def ::defn-args - (s/cat :name simple-symbol? - :docstring (s/? string?) - :meta (s/? map?) - :bs (s/alt :arity-1 ::args+body - :arity-n (s/cat :bodies (s/+ (s/spec ::args+body)) - :attr (s/? map?))))) - -(s/fdef clojure.core/defn - :args ::defn-args - :ret any?) - -(s/fdef clojure.core/defn- - :args ::defn-args - :ret any?) - -(s/fdef clojure.core/fn - :args (s/cat :name (s/? simple-symbol?) - :bs (s/alt :arity-1 ::args+body - :arity-n (s/+ (s/spec ::args+body)))) - :ret any?) - -;;;; ns - -(s/def ::exclude (s/coll-of simple-symbol?)) -(s/def ::only (s/coll-of simple-symbol?)) -(s/def ::rename (s/map-of simple-symbol? simple-symbol?)) -(s/def ::filters (s/keys* :opt-un [::exclude ::only ::rename])) - -(s/def ::ns-refer-clojure - (s/spec (s/cat :clause #{:refer-clojure} - :filters ::filters))) - -(s/def ::refer (s/or :all #{:all} - :syms (s/coll-of simple-symbol?))) - -(s/def ::prefix-list - (s/spec - (s/cat :prefix simple-symbol? - :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::prefix-list)) - :refer (s/keys* :opt-un [::as ::refer])))) - -(s/def ::ns-require - (s/spec (s/cat :clause #{:require} - :libs (s/* (s/alt :lib simple-symbol? - :prefix-list ::prefix-list - :flag #{:reload :reload-all :verbose}))))) - -(s/def ::package-list - (s/spec - (s/cat :package simple-symbol? - :classes (s/* simple-symbol?)))) - -(s/def ::import-list - (s/* (s/alt :class simple-symbol? - :package-list ::package-list))) - -(s/def ::ns-import - (s/spec - (s/cat :clause #{:import} - :classes ::import-list))) - -(s/def ::ns-refer - (s/spec (s/cat :clause #{:refer} - :lib simple-symbol? - :filters ::filters))) - -(s/def ::use-prefix-list - (s/spec - (s/cat :prefix simple-symbol? - :suffix (s/* (s/alt :lib simple-symbol? :prefix-list ::use-prefix-list)) - :filters ::filters))) - -(s/def ::ns-use - (s/spec (s/cat :clause #{:use} - :libs (s/* (s/alt :lib simple-symbol? - :prefix-list ::use-prefix-list - :flag #{:reload :reload-all :verbose}))))) - -(s/def ::ns-load - (s/spec (s/cat :clause #{:load} - :libs (s/* string?)))) - -(s/def ::name simple-symbol?) -(s/def ::extends simple-symbol?) -(s/def ::implements (s/coll-of simple-symbol? :kind vector?)) -(s/def ::init symbol?) -(s/def ::class-ident (s/or :class simple-symbol? :class-name string?)) -(s/def ::signature (s/coll-of ::class-ident :kind vector?)) -(s/def ::constructors (s/map-of ::signature ::signature)) -(s/def ::post-init symbol?) -(s/def ::method (s/and vector? - (s/cat :name simple-symbol? - :param-types ::signature - :return-type simple-symbol?))) -(s/def ::methods (s/coll-of ::method :kind vector?)) -(s/def ::main boolean?) -(s/def ::factory simple-symbol?) -(s/def ::state simple-symbol?) -(s/def ::get simple-symbol?) -(s/def ::set simple-symbol?) -(s/def ::expose (s/keys :opt-un [::get ::set])) -(s/def ::exposes (s/map-of simple-symbol? ::expose)) -(s/def ::prefix string?) -(s/def ::impl-ns simple-symbol?) -(s/def ::load-impl-ns boolean?) - -(s/def ::ns-gen-class - (s/spec (s/cat :clause #{:gen-class} - :options (s/keys* :opt-un [::name ::extends ::implements - ::init ::constructors ::post-init - ::methods ::main ::factory ::state - ::exposes ::prefix ::impl-ns ::load-impl-ns])))) - -(s/def ::ns-clauses - (s/* (s/alt :refer-clojure ::ns-refer-clojure - :require ::ns-require - :import ::ns-import - :use ::ns-use - :refer ::ns-refer - :load ::ns-load - :gen-class ::ns-gen-class))) - -(s/fdef clojure.core/ns - :args (s/cat :name simple-symbol? - :docstring (s/? string?) - :attr-map (s/? map?) - :clauses ::ns-clauses)) - -(defmacro ^:private quotable - "Returns a spec that accepts both the spec and a (quote ...) form of the spec" - [spec] - `(s/or :spec ~spec :quoted-spec (s/cat :quote #{'quote} :spec ~spec))) - -(s/def ::quotable-import-list - (s/* (s/alt :class (quotable simple-symbol?) - :package-list (quotable ::package-list)))) - -(s/fdef clojure.core/import - :args ::quotable-import-list) - -(s/fdef clojure.core/refer-clojure - :args (s/* (s/alt - :exclude (s/cat :op (quotable #{:exclude}) :arg (quotable ::exclude)) - :only (s/cat :op (quotable #{:only}) :arg (quotable ::only)) - :rename (s/cat :op (quotable #{:rename}) :arg (quotable ::rename))))) \ No newline at end of file diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/core.clj clojure-1.9.0/src/clj/clojure/core.clj --- clojure-1.9.0~alpha15/src/clj/clojure/core.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/core.clj 2017-12-08 13:59:39.000000000 +0000 @@ -859,9 +859,9 @@ (defn zero? "Returns true if num is zero, else false" { - :inline (fn [x] `(. clojure.lang.Numbers (isZero ~x))) + :inline (fn [num] `(. clojure.lang.Numbers (isZero ~num))) :added "1.0"} - [x] (. clojure.lang.Numbers (isZero x))) + [num] (. clojure.lang.Numbers (isZero num))) (defn count "Returns the number of items in the collection. (count nil) returns @@ -1239,16 +1239,16 @@ (defn pos? "Returns true if num is greater than zero, else false" { - :inline (fn [x] `(. clojure.lang.Numbers (isPos ~x))) + :inline (fn [num] `(. clojure.lang.Numbers (isPos ~num))) :added "1.0"} - [x] (. clojure.lang.Numbers (isPos x))) + [num] (. clojure.lang.Numbers (isPos num))) (defn neg? "Returns true if num is less than zero, else false" { - :inline (fn [x] `(. clojure.lang.Numbers (isNeg ~x))) + :inline (fn [num] `(. clojure.lang.Numbers (isNeg ~num))) :added "1.0"} - [x] (. clojure.lang.Numbers (isNeg x))) + [num] (. clojure.lang.Numbers (isNeg num))) (defn quot "quot[ient] of dividing numerator by denominator." @@ -1420,11 +1420,6 @@ {:added "1.9"} [x] (instance? Double x)) -(defn bigdec? - "Return true if x is a BigDecimal" - {:added "1.9"} - [x] (instance? java.math.BigDecimal x)) - ;; (defn complement @@ -1599,6 +1594,13 @@ [^clojure.lang.Named x] (. x (getNamespace))) +(defn boolean + "Coerce to boolean" + { + :inline (fn [x] `(. clojure.lang.RT (booleanCast ~x))) + :added "1.0"} + [x] (clojure.lang.RT/booleanCast x)) + (defn ident? "Return true if x is a symbol or keyword" {:added "1.9"} @@ -1612,7 +1614,7 @@ (defn qualified-ident? "Return true if x is a symbol or keyword with a namespace" {:added "1.9"} - [x] (and (ident? x) (namespace x) true)) + [x] (boolean (and (ident? x) (namespace x) true))) (defn simple-symbol? "Return true if x is a symbol without a namespace" @@ -1622,7 +1624,7 @@ (defn qualified-symbol? "Return true if x is a symbol with a namespace" {:added "1.9"} - [x] (and (symbol? x) (namespace x) true)) + [x] (boolean (and (symbol? x) (namespace x) true))) (defn simple-keyword? "Return true if x is a keyword without a namespace" @@ -1632,7 +1634,7 @@ (defn qualified-keyword? "Return true if x is a keyword with a namespace" {:added "1.9"} - [x] (and (keyword? x) (namespace x) true)) + [x] (boolean (and (keyword? x) (namespace x) true))) (defmacro locking "Executes exprs in an implicit do, while holding the monitor of x. @@ -2344,6 +2346,17 @@ ([^clojure.lang.IAtom atom f x y] (.swap atom f x y)) ([^clojure.lang.IAtom atom f x y & args] (.swap atom f x y args))) +(defn swap-vals! + "Atomically swaps the value of atom to be: + (apply f current-value-of-atom args). Note that f may be called + multiple times, and thus should be free of side effects. + Returns [old new], the value of the atom before and after the swap." + {:added "1.9"} + (^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f] (.swapVals atom f)) + (^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f x] (.swapVals atom f x)) + (^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f x y] (.swapVals atom f x y)) + (^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom f x y & args] (.swapVals atom f x y args))) + (defn compare-and-set! "Atomically sets the value of atom to newval if and only if the current value of the atom is identical to oldval. Returns true if @@ -2359,6 +2372,12 @@ :static true} [^clojure.lang.IAtom atom newval] (.reset atom newval)) +(defn reset-vals! + "Sets the value of atom to newval. Returns [old new], the value of the + atom before and after the reset." + {:added "1.9"} + ^clojure.lang.IPersistentVector [^clojure.lang.IAtom2 atom newval] (.resetVals atom newval)) + (defn set-validator! "Sets the validator-fn for a var/ref/agent/atom. validator-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended @@ -2765,7 +2784,7 @@ (defn filter "Returns a lazy sequence of the items in coll for which - (pred item) returns true. pred must be free of side-effects. + (pred item) returns logical true. pred must be free of side-effects. Returns a transducer when no collection is provided." {:added "1.0" :static true} @@ -2798,7 +2817,7 @@ (defn remove "Returns a lazy sequence of the items in coll for which - (pred item) returns false. pred must be free of side-effects. + (pred item) returns logical false. pred must be free of side-effects. Returns a transducer when no collection is provided." {:added "1.0" :static true} @@ -2860,7 +2879,7 @@ (defn take-while "Returns a lazy sequence of successive items from coll while - (pred item) returns true. pred must be free of side-effects. + (pred item) returns logical true. pred must be free of side-effects. Returns a transducer when no collection is provided." {:added "1.0" :static true} @@ -2908,8 +2927,8 @@ "Return a lazy sequence of all but the last n (default 1) items in coll" {:added "1.0" :static true} - ([s] (drop-last 1 s)) - ([n s] (map (fn [x _] x) s (drop n s)))) + ([coll] (drop-last 1 coll)) + ([n coll] (map (fn [x _] x) coll (drop n coll)))) (defn take-last "Returns a seq of the last n items in coll. Depending on the type @@ -3248,7 +3267,7 @@ "Blocks the current thread (indefinitely!) until all actions dispatched thus far, from this thread or agent, to the agent(s) have occurred. Will block on failed agents. Will never return if - a failed agent is restarted with :clear-actions true." + a failed agent is restarted with :clear-actions true or shutdown-agents was called." {:added "1.0" :static true} [& agents] @@ -3486,13 +3505,6 @@ :added "1.1"} [x] (. clojure.lang.RT (charCast x))) -(defn boolean - "Coerce to boolean" - { - :inline (fn [x] `(. clojure.lang.RT (booleanCast ~x))) - :added "1.0"} - [x] (clojure.lang.RT/booleanCast x)) - (defn unchecked-byte "Coerce to byte. Subject to rounding or truncation." {:inline (fn [x] `(. clojure.lang.RT (uncheckedByteCast ~x))) @@ -3814,9 +3826,11 @@ (let [gx (gensym)] `(let [~gx ~x] ~@(map (fn [f] - (if (seq? f) - `(~(first f) ~gx ~@(next f)) - `(~f ~gx))) + (with-meta + (if (seq? f) + `(~(first f) ~gx ~@(next f)) + `(~f ~gx)) + (meta f))) forms) ~gx))) @@ -4913,22 +4927,44 @@ (^String [^String s start end] (. s (substring start end)))) (defn max-key - "Returns the x for which (k x), a number, is greatest." + "Returns the x for which (k x), a number, is greatest. + + If there are multiple such xs, the last one is returned." {:added "1.0" :static true} ([k x] x) ([k x y] (if (> (k x) (k y)) x y)) ([k x y & more] - (reduce1 #(max-key k %1 %2) (max-key k x y) more))) + (let [kx (k x) ky (k y) + [v kv] (if (> kx ky) [x kx] [y ky])] + (loop [v v kv kv more more] + (if more + (let [w (first more) + kw (k w)] + (if (>= kw kv) + (recur w kw (next more)) + (recur v kv (next more)))) + v))))) (defn min-key - "Returns the x for which (k x), a number, is least." + "Returns the x for which (k x), a number, is least. + + If there are multiple such xs, the last one is returned." {:added "1.0" :static true} ([k x] x) ([k x y] (if (< (k x) (k y)) x y)) ([k x y & more] - (reduce1 #(min-key k %1 %2) (min-key k x y) more))) + (let [kx (k x) ky (k y) + [v kv] (if (< kx ky) [x kx] [y ky])] + (loop [v v kv kv more more] + (if more + (let [w (first more) + kw (k w)] + (if (<= kw kv) + (recur w kw (next more)) + (recur v kv (next more)))) + v))))) (defn distinct "Returns a lazy sequence of the elements of coll with duplicates removed. @@ -5157,10 +5193,10 @@ array ret." {:added "1.0"} [a idx ret expr] - `(let [a# ~a + `(let [a# ~a l# (alength a#) ~ret (aclone a#)] (loop [~idx 0] - (if (< ~idx (alength a#)) + (if (< ~idx l#) (do (aset ~ret ~idx ~expr) (recur (unchecked-inc ~idx))) @@ -5763,7 +5799,7 @@ exception (Exception. message) raw-trace (.getStackTrace exception) boring? #(not= (.getMethodName ^StackTraceElement %) "doInvoke") - trace (into-array (drop 2 (drop-while boring? raw-trace)))] + trace (into-array StackTraceElement (drop 2 (drop-while boring? raw-trace)))] (.setStackTrace exception trace) (throw (clojure.lang.Compiler$CompilerException. *file* @@ -5928,9 +5964,11 @@ 'require loads a lib by loading its root resource. The root resource path is derived from the lib name in the following manner: Consider a lib named by the symbol 'x.y.z; it has the root directory - /x/y/, and its root resource is /x/y/z.clj. The root - resource should contain code to create the lib's namespace (usually by using - the ns macro) and load any additional lib resources. + /x/y/, and its root resource is /x/y/z.clj, or + /x/y/z.cljc if /x/y/z.clj does not exist. The + root resource should contain code to create the lib's + namespace (usually by using the ns macro) and load any additional + lib resources. Libspecs @@ -6649,7 +6687,15 @@ (load "core_deftype") (load "core/protocols") (load "gvec") -(load "instant") + +(defmacro ^:private when-class [class-name & body] + `(try + (Class/forName ^String ~class-name) + ~@body + (catch ClassNotFoundException _#))) + +(when-class "java.sql.Timestamp" + (load "instant")) (defprotocol Inst (inst-ms* [inst])) @@ -6659,10 +6705,8 @@ (inst-ms* [inst] (.getTime ^java.util.Date inst))) ;; conditionally extend to Instant on Java 8+ -(try - (Class/forName "java.time.Instant") - (load "core_instant18") - (catch ClassNotFoundException cnfe)) +(when-class "java.time.Instant" + (load "core_instant18")) (defn inst-ms "Return the number of milliseconds since January 1, 1970, 00:00:00 GMT" @@ -6796,7 +6840,7 @@ (defn filterv "Returns a vector of the items in coll for which - (pred item) returns true. pred must be free of side-effects." + (pred item) returns logical true. pred must be free of side-effects." {:added "1.4" :static true} [pred coll] @@ -6818,7 +6862,8 @@ (defn slurp "Opens a reader on f and reads all its contents, returning a string. See clojure.java.io/reader for a complete list of supported arguments." - {:added "1.0"} + {:added "1.0" + :tag String} ([f & opts] (let [opts (normalize-slurp-opts opts) sw (java.io.StringWriter.)] @@ -7625,15 +7670,17 @@ (def ^{:added "1.4"} default-data-readers "Default map of data reader functions provided by Clojure. May be overridden by binding *data-readers*." - {'inst #'clojure.instant/read-instant-date - 'uuid #'clojure.uuid/default-uuid-reader}) + (merge + {'uuid #'clojure.uuid/default-uuid-reader} + (when-class "java.sql.Timestamp" + {'inst #'clojure.instant/read-instant-date}))) (def ^{:added "1.4" :dynamic true} *data-readers* "Map from reader tag symbols to data reader Vars. When Clojure starts, it searches for files named 'data_readers.clj' - at the root of the classpath. Each such file must contain a literal - map of symbols, like this: + and 'data_readers.cljc' at the root of the classpath. Each such file + must contain a literal map of symbols, like this: {foo/bar my.project.foo/bar foo/baz my.project/baz} @@ -7654,7 +7701,7 @@ Reader tags without namespace qualifiers are reserved for Clojure. Default reader tags are defined in clojure.core/default-data-readers but may be overridden in - data_readers.clj or by rebinding this Var." + data_readers.clj, data_readers.cljc, or by rebinding this Var." {}) (def ^{:added "1.5" :dynamic true} *default-data-reader-fn* @@ -7718,4 +7765,4 @@ (defn uri? "Return true if x is a java.net.URI" {:added "1.9"} - [x] (instance? java.net.URI x)) \ No newline at end of file + [x] (instance? java.net.URI x)) diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/core_deftype.clj clojure-1.9.0/src/clj/clojure/core_deftype.clj --- clojure-1.9.0~alpha15/src/clj/clojure/core_deftype.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/core_deftype.clj 2017-12-08 13:59:39.000000000 +0000 @@ -425,8 +425,8 @@ Options are expressed as sequential keywords and arguments (in any order). Supported options: - :load-ns - if true, importing the record class will cause the - namespace in which the record was defined to be loaded. + :load-ns - if true, importing the type class will cause the + namespace in which the type was defined to be loaded. Defaults to false. Each spec consists of a protocol or interface name followed by zero diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/core_print.clj clojure-1.9.0/src/clj/clojure/core_print.clj --- clojure-1.9.0~alpha15/src/clj/clojure/core_print.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/core_print.clj 2017-12-08 13:59:39.000000000 +0000 @@ -128,6 +128,20 @@ (defmethod print-method Number [o, ^Writer w] (.write w (str o))) +(defmethod print-method Double [o, ^Writer w] + (cond + (= Double/POSITIVE_INFINITY o) (.write w "##Inf") + (= Double/NEGATIVE_INFINITY o) (.write w "##-Inf") + (.isNaN ^Double o) (.write w "##NaN") + :else (.write w (str o)))) + +(defmethod print-method Float [o, ^Writer w] + (cond + (= Float/POSITIVE_INFINITY o) (.write w "##Inf") + (= Float/NEGATIVE_INFINITY o) (.write w "##-Inf") + (.isNaN ^Float o) (.write w "##NaN") + :else (.write w (str o)))) + (defmethod print-dup Number [o, ^Writer w] (print-ctor o (fn [o w] diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/core_proxy.clj clojure-1.9.0/src/clj/clojure/core_proxy.clj --- clojure-1.9.0~alpha15/src/clj/clojure/core_proxy.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/core_proxy.clj 2017-12-08 13:59:39.000000000 +0000 @@ -13,6 +13,7 @@ (import '(clojure.asm ClassWriter ClassVisitor Opcodes Type) '(java.lang.reflect Modifier Constructor) + '(java.io Serializable NotSerializableException) '(clojure.asm.commons Method GeneratorAdapter) '(clojure.lang IProxy Reflector DynamicClassLoader IPersistentMap PersistentHashMap RT)) @@ -23,8 +24,10 @@ (or (some (fn [t] (when (every? #(isa? t %) rtypes) t)) rtypes) (throw (Exception. "Incompatible return types")))) -(defn- group-by-sig [coll] - "takes a collection of [msig meth] and returns a seq of maps from return-types to meths." +(defn- group-by-sig + "Takes a collection of [msig meth] and returns a seq of maps from + return-types to meths." + [coll] (vals (reduce1 (fn [m [msig meth]] (let [rtype (peek msig) argsig (pop msig)] @@ -44,7 +47,8 @@ (defn- generate-proxy [^Class super interfaces] (let [cv (new ClassWriter (. ClassWriter COMPUTE_MAXS)) - cname (.replace (proxy-name super interfaces) \. \/) ;(str "clojure/lang/" (gensym "Proxy__")) + pname (proxy-name super interfaces) + cname (.replace pname \. \/) ;(str "clojure/lang/" (gensym "Proxy__")) ctype (. Type (getObjectType cname)) iname (fn [^Class c] (.. Type (getType c) (getInternalName))) fmap "__clojureFnMap" @@ -148,6 +152,22 @@ (. gen (returnValue)) (. gen (endMethod))))) + ;disable serialization + (when (some #(isa? % Serializable) (cons super interfaces)) + (let [m (. Method (getMethod "void writeObject(java.io.ObjectOutputStream)")) + gen (new GeneratorAdapter (. Opcodes ACC_PRIVATE) m nil nil cv)] + (. gen (visitCode)) + (. gen (loadThis)) + (. gen (loadArgs)) + (. gen (throwException (totype NotSerializableException) pname)) + (. gen (endMethod))) + (let [m (. Method (getMethod "void readObject(java.io.ObjectInputStream)")) + gen (new GeneratorAdapter (. Opcodes ACC_PRIVATE) m nil nil cv)] + (. gen (visitCode)) + (. gen (loadThis)) + (. gen (loadArgs)) + (. gen (throwException (totype NotSerializableException) pname)) + (. gen (endMethod)))) ;add IProxy methods (let [m (. Method (getMethod "void __initClojureFnMappings(clojure.lang.IPersistentMap)")) gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)] @@ -395,10 +415,15 @@ snapshot (fn [] (reduce1 (fn [m e] (assoc m (key e) ((val e)))) - {} (seq pmap)))] + {} (seq pmap))) + thisfn (fn thisfn [plseq] + (lazy-seq + (when-let [pseq (seq plseq)] + (cons (clojure.lang.MapEntry/create (first pseq) (v (first pseq))) + (thisfn (rest pseq))))))] (proxy [clojure.lang.APersistentMap] [] - (iterator [] (.iterator ^Iterable pmap)) + (iterator [] (clojure.lang.SeqIterator. ^java.util.Iterator (thisfn (keys pmap)))) (containsKey [k] (contains? pmap k)) (entryAt [k] (when (contains? pmap k) (clojure.lang.MapEntry/create k (v k)))) (valAt ([k] (when (contains? pmap k) (v k))) @@ -407,11 +432,7 @@ (count [] (count pmap)) (assoc [k v] (assoc (snapshot) k v)) (without [k] (dissoc (snapshot) k)) - (seq [] ((fn thisfn [plseq] - (lazy-seq - (when-let [pseq (seq plseq)] - (cons (clojure.lang.MapEntry/create (first pseq) (v (first pseq))) - (thisfn (rest pseq)))))) (keys pmap)))))) + (seq [] (thisfn (keys pmap)))))) diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/gvec.clj clojure-1.9.0/src/clj/clojure/gvec.clj --- clojure-1.9.0~alpha15/src/clj/clojure/gvec.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/gvec.clj 2017-12-08 13:59:39.000000000 +0000 @@ -249,6 +249,7 @@ (new Vec am cnt shift (.doAssoc this shift root i val) tail (meta this))) (= i cnt) (.cons this val) :else (throw (IndexOutOfBoundsException.)))) + (length [_] cnt) clojure.lang.Reversible (rseq [this] @@ -474,7 +475,13 @@ :char (mk-am char) :boolean (mk-am boolean)}) -(defn vector-of +(defmacro ^:private ams-check [t] + `(let [am# (ams ~t)] + (if am# + am# + (throw (IllegalArgumentException. (str "Unrecognized type " ~t)))))) + +(defn vector-of "Creates a new vector of a single primitive type t, where t is one of :int :long :float :double :byte :short :char or :boolean. The resulting vector complies with the interface of vectors in general, @@ -484,28 +491,28 @@ {:added "1.2" :arglists '([t] [t & elements])} ([t] - (let [am ^clojure.core.ArrayManager (ams t)] + (let [^clojure.core.ArrayManager am (ams-check t)] (Vec. am 0 5 EMPTY-NODE (.array am 0) nil))) ([t x1] - (let [am ^clojure.core.ArrayManager (ams t) + (let [^clojure.core.ArrayManager am (ams-check t) arr (.array am 1)] (.aset am arr 0 x1) (Vec. am 1 5 EMPTY-NODE arr nil))) ([t x1 x2] - (let [am ^clojure.core.ArrayManager (ams t) + (let [^clojure.core.ArrayManager am (ams-check t) arr (.array am 2)] (.aset am arr 0 x1) (.aset am arr 1 x2) (Vec. am 2 5 EMPTY-NODE arr nil))) ([t x1 x2 x3] - (let [am ^clojure.core.ArrayManager (ams t) + (let [^clojure.core.ArrayManager am (ams-check t) arr (.array am 3)] (.aset am arr 0 x1) (.aset am arr 1 x2) (.aset am arr 2 x3) (Vec. am 3 5 EMPTY-NODE arr nil))) ([t x1 x2 x3 x4] - (let [am ^clojure.core.ArrayManager (ams t) + (let [^clojure.core.ArrayManager am (ams-check t) arr (.array am 4)] (.aset am arr 0 x1) (.aset am arr 1 x2) diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/instant.clj clojure-1.9.0/src/clj/clojure/instant.clj --- clojure-1.9.0~alpha15/src/clj/clojure/instant.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/instant.clj 2017-12-08 13:59:39.000000000 +0000 @@ -136,7 +136,7 @@ ((if leap-year? dim-leap dim-norm) month)))) (defn validated - "Return a function which constructs and instant by calling constructor + "Return a function which constructs an instant by calling constructor after first validating that those arguments are in range and otherwise plausible. The resulting function will throw an exception if called with invalid arguments." diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/java/io.clj clojure-1.9.0/src/clj/clojure/java/io.clj --- clojure-1.9.0~alpha15/src/clj/clojure/java/io.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/java/io.clj 2017-12-08 13:59:39.000000000 +0000 @@ -390,7 +390,7 @@ (defn copy "Copies input to output. Returns nil or throws IOException. - Input may be an InputStream, Reader, File, byte[], or String. + Input may be an InputStream, Reader, File, byte[], char[], or String. Output may be an OutputStream, Writer, or File. Options are key/value pairs and may be one of @@ -428,7 +428,7 @@ (reduce file (file parent child) more))) (defn delete-file - "Delete file f. Raise an exception if it fails unless silently is true." + "Delete file f. If silently is nil or false, raise an exception on failure, else return the value of silently." {:added "1.2"} [f & [silently]] (or (.delete (file f)) diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/java/javadoc.clj clojure-1.9.0/src/clj/clojure/java/javadoc.clj --- clojure-1.9.0~alpha15/src/clj/clojure/java/javadoc.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/java/javadoc.clj 2017-12-08 13:59:39.000000000 +0000 @@ -20,20 +20,24 @@ (def ^:dynamic *core-java-api* (case (System/getProperty "java.specification.version") - "1.6" "http://java.sun.com/javase/6/docs/api/" - "http://java.sun.com/javase/7/docs/api/")) + "1.6" "http://docs.oracle.com/javase/6/docs/api/" + "1.7" "http://docs.oracle.com/javase/7/docs/api/" + "1.8" "http://docs.oracle.com/javase/8/docs/api/" + "http://docs.oracle.com/javase/8/docs/api/")) (def ^:dynamic *remote-javadocs* (ref (sorted-map + "com.google.common." "http://google.github.io/guava/releases/23.0/api/docs/" "java." *core-java-api* "javax." *core-java-api* "org.ietf.jgss." *core-java-api* "org.omg." *core-java-api* "org.w3c.dom." *core-java-api* "org.xml.sax." *core-java-api* - "org.apache.commons.codec." "http://commons.apache.org/codec/api-release/" - "org.apache.commons.io." "http://commons.apache.org/io/api-release/" - "org.apache.commons.lang." "http://commons.apache.org/lang/api-release/"))) + "org.apache.commons.codec." "http://commons.apache.org/proper/commons-codec/apidocs/" + "org.apache.commons.io." "http://commons.apache.org/proper/commons-io/javadocs/api-release/" + "org.apache.commons.lang." "http://commons.apache.org/proper/commons-lang/javadocs/api-2.6/" + "org.apache.commons.lang3." "http://commons.apache.org/proper/commons-lang/javadocs/api-release/"))) (defn add-local-javadoc "Adds to the list of local Javadoc paths." diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/main.clj clojure-1.9.0/src/clj/clojure/main.clj --- clojure-1.9.0~alpha15/src/clj/clojure/main.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/main.clj 2017-12-08 13:59:39.000000000 +0000 @@ -12,6 +12,7 @@ :author "Stephen C. Gilardi and Rich Hickey"} clojure.main (:refer-clojure :exclude [with-bindings]) + (:require [clojure.spec.alpha]) (:import (clojure.lang Compiler Compiler$CompilerException LineNumberingPushbackReader RT)) ;;(:use [clojure.repl :only (demunge root-cause stack-element-str)]) @@ -81,7 +82,7 @@ *command-line-args* *command-line-args* *unchecked-math* *unchecked-math* *assert* *assert* - clojure.spec/*explain-out* clojure.spec/*explain-out* + clojure.spec.alpha/*explain-out* clojure.spec.alpha/*explain-out* *1 nil *2 nil *3 nil diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/pprint/pretty_writer.clj clojure-1.9.0/src/clj/clojure/pprint/pretty_writer.clj --- clojure-1.9.0~alpha15/src/clj/clojure/pprint/pretty_writer.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/pprint/pretty_writer.clj 2017-12-08 13:59:39.000000000 +0000 @@ -40,9 +40,10 @@ [sym] `(~sym @@~'this)) -(defmacro ^{:private true} - setf [sym new-val] +(defmacro ^{:private true} + setf "Set the value of the field SYM to NEW-VAL" + [sym new-val] `(alter @~'this assoc ~sym ~new-val)) (defmacro ^{:private true} diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/pprint/utilities.clj clojure-1.9.0/src/clj/clojure/pprint/utilities.clj --- clojure-1.9.0~alpha15/src/clj/clojure/pprint/utilities.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/pprint/utilities.clj 2017-12-08 13:59:39.000000000 +0000 @@ -50,19 +50,22 @@ [acc context] (recur new-context (conj acc result)))))) -(defn- unzip-map [m] - "Take a map that has pairs in the value slots and produce a pair of maps, - the first having all the first elements of the pairs and the second all - the second elements of the pairs" +(defn- unzip-map + "Take a map that has pairs in the value slots and produce a pair of + maps, the first having all the first elements of the pairs and the + second all the second elements of the pairs" + [m] [(into {} (for [[k [v1 v2]] m] [k v1])) (into {} (for [[k [v1 v2]] m] [k v2]))]) -(defn- tuple-map [m v1] +(defn- tuple-map "For all the values, v, in the map, replace them with [v v1]" + [m v1] (into {} (for [[k v] m] [k [v v1]]))) -(defn- rtrim [s c] +(defn- rtrim "Trim all instances of c from the end of sequence s" + [s c] (let [len (count s)] (if (and (pos? len) (= (nth s (dec (count s))) c)) (loop [n (dec len)] @@ -72,8 +75,9 @@ true (recur (dec n)))) s))) -(defn- ltrim [s c] +(defn- ltrim "Trim all instances of c from the beginning of sequence s" + [s c] (let [len (count s)] (if (and (pos? len) (= (nth s 0) c)) (loop [n 0] @@ -82,24 +86,27 @@ (recur (inc n)))) s))) -(defn- prefix-count [aseq val] - "Return the number of times that val occurs at the start of sequence aseq, -if val is a seq itself, count the number of times any element of val occurs at the -beginning of aseq" +(defn- prefix-count + "Return the number of times that val occurs at the start of sequence aseq, + if val is a seq itself, count the number of times any element of val + occurs at the beginning of aseq" + [aseq val] (let [test (if (coll? val) (set val) #{val})] (loop [pos 0] (if (or (= pos (count aseq)) (not (test (nth aseq pos)))) pos (recur (inc pos)))))) -(defn- prerr [& args] +(defn- prerr "Println to *err*" + [& args] (binding [*out* *err*] (apply println args))) - -(defmacro ^{:private true} prlabel [prefix arg & more-args] + +(defmacro ^{:private true} prlabel "Print args to *err* in name = value format" - `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) + [prefix arg & more-args] + `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) (cons arg (seq more-args)))))) ;; Flush the pretty-print buffer without flushing the underlying stream diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/pprint.clj clojure-1.9.0/src/clj/clojure/pprint.clj --- clojure-1.9.0~alpha15/src/clj/clojure/pprint.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/pprint.clj 2017-12-08 13:59:39.000000000 +0000 @@ -32,7 +32,7 @@ a more powerful alternative to Clojure's standard format function. See documentation for pprint and cl-format for more information or -complete documentation on the the clojure web site on github.", +complete documentation on the Clojure web site on GitHub.", :added "1.2"} clojure.pprint (:refer-clojure :exclude (deftype)) diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/repl.clj clojure-1.9.0/src/clj/clojure/repl.clj --- clojure-1.9.0~alpha15/src/clj/clojure/repl.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/repl.clj 2017-12-08 13:59:39.000000000 +0000 @@ -12,7 +12,7 @@ ^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim" :doc "Utilities meant to be used interactively at the REPL"} clojure.repl - (:require [clojure.spec :as spec]) + (:require [clojure.spec.alpha :as spec]) (:import (java.io LineNumberReader InputStreamReader PushbackReader) (clojure.lang RT Reflector))) @@ -135,7 +135,7 @@ {:added "1.0"} [name] (if-let [special-name ('{& fn catch try finally try} name)] - (#'print-doc (#'special-doc special-name)) + `(#'print-doc (#'special-doc '~special-name)) (cond (special-doc-map name) `(#'print-doc (#'special-doc '~name)) (keyword? name) `(#'print-doc {:spec '~name :doc '~(spec/describe name)}) diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/set.clj clojure-1.9.0/src/clj/clojure/set.clj --- clojure-1.9.0~alpha15/src/clj/clojure/set.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/set.clj 2017-12-08 13:59:39.000000000 +0000 @@ -10,9 +10,10 @@ :author "Rich Hickey"} clojure.set) -(defn- bubble-max-key [k coll] - "Move a maximal element of coll according to fn k (which returns a number) - to the front of coll." +(defn- bubble-max-key + "Move a maximal element of coll according to fn k (which returns a + number) to the front of coll." + [k coll] (let [max (apply max-key k coll)] (cons max (remove #(identical? max %) coll)))) diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/spec/gen.clj clojure-1.9.0/src/clj/clojure/spec/gen.clj --- clojure-1.9.0~alpha15/src/clj/clojure/spec/gen.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/spec/gen.clj 1970-01-01 00:00:00.000000000 +0000 @@ -1,224 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.spec.gen - (:refer-clojure :exclude [boolean bytes cat hash-map list map not-empty set vector - char double int keyword symbol string uuid delay])) - -(alias 'c 'clojure.core) - -(defn- dynaload - [s] - (let [ns (namespace s)] - (assert ns) - (require (c/symbol ns)) - (let [v (resolve s)] - (if v - @v - (throw (RuntimeException. (str "Var " s " is not on the classpath"))))))) - -(def ^:private quick-check-ref - (c/delay (dynaload 'clojure.test.check/quick-check))) -(defn quick-check - [& args] - (apply @quick-check-ref args)) - -(def ^:private for-all*-ref - (c/delay (dynaload 'clojure.test.check.properties/for-all*))) -(defn for-all* - "Dynamically loaded clojure.test.check.properties/for-all*." - [& args] - (apply @for-all*-ref args)) - -(let [g? (c/delay (dynaload 'clojure.test.check.generators/generator?)) - g (c/delay (dynaload 'clojure.test.check.generators/generate)) - mkg (c/delay (dynaload 'clojure.test.check.generators/->Generator))] - (defn- generator? - [x] - (@g? x)) - (defn- generator - [gfn] - (@mkg gfn)) - (defn generate - "Generate a single value using generator." - [generator] - (@g generator))) - -(defn ^:skip-wiki delay-impl - [gfnd] - ;;N.B. depends on test.check impl details - (generator (fn [rnd size] - ((:gen @gfnd) rnd size)))) - -(defmacro delay - "given body that returns a generator, returns a - generator that delegates to that, but delays - creation until used." - [& body] - `(delay-impl (c/delay ~@body))) - -(defn gen-for-name - "Dynamically loads test.check generator named s." - [s] - (let [g (dynaload s)] - (if (generator? g) - g - (throw (RuntimeException. (str "Var " s " is not a generator")))))) - -(defmacro ^:skip-wiki lazy-combinator - "Implementation macro, do not call directly." - [s] - (let [fqn (c/symbol "clojure.test.check.generators" (name s)) - doc (str "Lazy loaded version of " fqn)] - `(let [g# (c/delay (dynaload '~fqn))] - (defn ~s - ~doc - [& ~'args] - (apply @g# ~'args))))) - -(defmacro ^:skip-wiki lazy-combinators - "Implementation macro, do not call directly." - [& syms] - `(do - ~@(c/map - (fn [s] (c/list 'lazy-combinator s)) - syms))) - -(lazy-combinators hash-map list map not-empty set vector vector-distinct fmap elements - bind choose fmap one-of such-that tuple sample return - large-integer* double* frequency) - -(defmacro ^:skip-wiki lazy-prim - "Implementation macro, do not call directly." - [s] - (let [fqn (c/symbol "clojure.test.check.generators" (name s)) - doc (str "Fn returning " fqn)] - `(let [g# (c/delay (dynaload '~fqn))] - (defn ~s - ~doc - [& ~'args] - @g#)))) - -(defmacro ^:skip-wiki lazy-prims - "Implementation macro, do not call directly." - [& syms] - `(do - ~@(c/map - (fn [s] (c/list 'lazy-prim s)) - syms))) - -(lazy-prims any any-printable boolean bytes char char-alpha char-alphanumeric char-ascii double - int keyword keyword-ns large-integer ratio simple-type simple-type-printable - string string-ascii string-alphanumeric symbol symbol-ns uuid) - -(defn cat - "Returns a generator of a sequence catenated from results of -gens, each of which should generate something sequential." - [& gens] - (fmap #(apply concat %) - (apply tuple gens))) - -(defn- qualified? [ident] (not (nil? (namespace ident)))) - -(def ^:private - gen-builtins - (c/delay - (let [simple (simple-type-printable)] - {any? (one-of [(return nil) (any-printable)]) - some? (such-that some? (any-printable)) - number? (one-of [(large-integer) (double)]) - integer? (large-integer) - int? (large-integer) - pos-int? (large-integer* {:min 1}) - neg-int? (large-integer* {:max -1}) - nat-int? (large-integer* {:min 0}) - float? (double) - double? (double) - boolean? (boolean) - string? (string-alphanumeric) - ident? (one-of [(keyword-ns) (symbol-ns)]) - simple-ident? (one-of [(keyword) (symbol)]) - qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)])) - keyword? (keyword-ns) - simple-keyword? (keyword) - qualified-keyword? (such-that qualified? (keyword-ns)) - symbol? (symbol-ns) - simple-symbol? (symbol) - qualified-symbol? (such-that qualified? (symbol-ns)) - uuid? (uuid) - uri? (fmap #(java.net.URI/create (str "http://" % ".com")) (uuid)) - bigdec? (fmap #(BigDecimal/valueOf %) - (double* {:infinite? false :NaN? false})) - inst? (fmap #(java.util.Date. %) - (large-integer)) - seqable? (one-of [(return nil) - (list simple) - (vector simple) - (map simple simple) - (set simple) - (string-alphanumeric)]) - indexed? (vector simple) - map? (map simple simple) - vector? (vector simple) - list? (list simple) - seq? (list simple) - char? (char) - set? (set simple) - nil? (return nil) - false? (return false) - true? (return true) - zero? (return 0) - rational? (one-of [(large-integer) (ratio)]) - coll? (one-of [(map simple simple) - (list simple) - (vector simple) - (set simple)]) - empty? (elements [nil '() [] {} #{}]) - associative? (one-of [(map simple simple) (vector simple)]) - sequential? (one-of [(list simple) (vector simple)]) - ratio? (such-that ratio? (ratio)) - bytes? (bytes)}))) - -(defn gen-for-pred - "Given a predicate, returns a built-in generator if one exists." - [pred] - (if (set? pred) - (elements pred) - (get @gen-builtins pred))) - -(comment - (require :reload 'clojure.spec.gen) - (in-ns 'clojure.spec.gen) - - ;; combinators, see call to lazy-combinators above for complete list - (generate (one-of [(gen-for-pred integer?) (gen-for-pred string?)])) - (generate (such-that #(< 10000 %) (gen-for-pred integer?))) - (let [reqs {:a (gen-for-pred number?) - :b (gen-for-pred ratio?)} - opts {:c (gen-for-pred string?)}] - (generate (bind (choose 0 (count opts)) - #(let [args (concat (seq reqs) (shuffle (seq opts)))] - (->> args - (take (+ % (count reqs))) - (mapcat identity) - (apply hash-map)))))) - (generate (cat (list (gen-for-pred string?)) - (list (gen-for-pred ratio?)))) - - ;; load your own generator - (gen-for-name 'clojure.test.check.generators/int) - - ;; failure modes - (gen-for-name 'unqualified) - (gen-for-name 'clojure.core/+) - (gen-for-name 'clojure.core/name-does-not-exist) - (gen-for-name 'ns.does.not.exist/f) - - ) - - diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/spec/test.clj clojure-1.9.0/src/clj/clojure/spec/test.clj --- clojure-1.9.0~alpha15/src/clj/clojure/spec/test.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/spec/test.clj 1970-01-01 00:00:00.000000000 +0000 @@ -1,466 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.spec.test - (:refer-clojure :exclude [test]) - (:require - [clojure.pprint :as pp] - [clojure.spec :as s] - [clojure.spec.gen :as gen] - [clojure.string :as str])) - -(in-ns 'clojure.spec.test.check) -(in-ns 'clojure.spec.test) -(alias 'stc 'clojure.spec.test.check) - -(defn- throwable? - [x] - (instance? Throwable x)) - -(defn ->sym - [x] - (@#'s/->sym x)) - -(defn- ->var - [s-or-v] - (if (var? s-or-v) - s-or-v - (let [v (and (symbol? s-or-v) (resolve s-or-v))] - (if (var? v) - v - (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var"))))))) - -(defn- collectionize - [x] - (if (symbol? x) - (list x) - x)) - -(defn enumerate-namespace - "Given a symbol naming an ns, or a collection of such symbols, -returns the set of all symbols naming vars in those nses." - [ns-sym-or-syms] - (into - #{} - (mapcat (fn [ns-sym] - (map - (fn [name-sym] - (symbol (name ns-sym) (name name-sym))) - (keys (ns-interns ns-sym))))) - (collectionize ns-sym-or-syms))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^:private ^:dynamic *instrument-enabled* - "if false, instrumented fns call straight through" - true) - -(defn- fn-spec? - "Fn-spec must include at least :args or :ret specs." - [m] - (or (:args m) (:ret m))) - -(defmacro with-instrument-disabled - "Disables instrument's checking of calls, within a scope." - [& body] - `(binding [*instrument-enabled* nil] - ~@body)) - -(defn- interpret-stack-trace-element - "Given the vector-of-syms form of a stacktrace element produced -by e.g. Throwable->map, returns a map form that adds some keys -guessing the original Clojure names. Returns a map with - - :class class name symbol from stack trace - :method method symbol from stack trace - :file filename from stack trace - :line line number from stack trace - :var-scope optional Clojure var symbol scoping fn def - :local-fn optional local Clojure symbol scoping fn def - -For non-Clojure fns, :scope and :local-fn will be absent." - [[cls method file line]] - (let [clojure? (contains? '#{invoke invokeStatic} method) - demunge #(clojure.lang.Compiler/demunge %) - degensym #(str/replace % #"--.*" "") - [ns-sym name-sym local] (when clojure? - (->> (str/split (str cls) #"\$" 3) - (map demunge)))] - (merge {:file file - :line line - :method method - :class cls} - (when (and ns-sym name-sym) - {:var-scope (symbol ns-sym name-sym)}) - (when local - {:local-fn (symbol (degensym local))})))) - -(defn- stacktrace-relevant-to-instrument - "Takes a coll of stack trace elements (as returned by -StackTraceElement->vec) and returns a coll of maps as per -interpret-stack-trace-element that are relevant to a -failure in instrument." - [elems] - (let [plumbing? (fn [{:keys [var-scope]}] - (contains? '#{clojure.spec.test/spec-checking-fn} var-scope))] - (sequence (comp (map StackTraceElement->vec) - (map interpret-stack-trace-element) - (filter :var-scope) - (drop-while plumbing?)) - elems))) - -(defn- spec-checking-fn - [v f fn-spec] - (let [fn-spec (@#'s/maybe-spec fn-spec) - conform! (fn [v role spec data args] - (let [conformed (s/conform spec data)] - (if (= ::s/invalid conformed) - (let [caller (->> (.getStackTrace (Thread/currentThread)) - stacktrace-relevant-to-instrument - first) - ed (merge (assoc (s/explain-data* spec [role] [] [] data) - ::s/args args - ::s/failure :instrument) - (when caller - {::caller (dissoc caller :class :method)}))] - (throw (ex-info - (str "Call to " v " did not conform to spec:\n" (with-out-str (s/explain-out ed))) - ed))) - conformed)))] - (fn - [& args] - (if *instrument-enabled* - (with-instrument-disabled - (when (:args fn-spec) (conform! v :args (:args fn-spec) args args)) - (binding [*instrument-enabled* true] - (.applyTo ^clojure.lang.IFn f args))) - (.applyTo ^clojure.lang.IFn f args))))) - -(defn- no-fspec - [v spec] - (ex-info (str "Fn at " v " is not spec'ed.") - {:var v :spec spec ::s/failure :no-fspec})) - -(defonce ^:private instrumented-vars (atom {})) - -(defn- instrument-choose-fn - "Helper for instrument." - [f spec sym {over :gen :keys [stub replace]}] - (if (some #{sym} stub) - (-> spec (s/gen over) gen/generate) - (get replace sym f))) - -(defn- instrument-choose-spec - "Helper for instrument" - [spec sym {overrides :spec}] - (get overrides sym spec)) - -(defn- instrument-1 - [s opts] - (when-let [v (resolve s)] - (when-not (-> v meta :macro) - (let [spec (s/get-spec v) - {:keys [raw wrapped]} (get @instrumented-vars v) - current @v - to-wrap (if (= wrapped current) raw current) - ospec (or (instrument-choose-spec spec s opts) - (throw (no-fspec v spec))) - ofn (instrument-choose-fn to-wrap ospec s opts) - checked (spec-checking-fn v ofn ospec)] - (alter-var-root v (constantly checked)) - (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked}) - (->sym v))))) - -(defn- unstrument-1 - [s] - (when-let [v (resolve s)] - (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)] - (swap! instrumented-vars dissoc v) - (let [current @v] - (when (= wrapped current) - (alter-var-root v (constantly raw)) - (->sym v)))))) - -(defn- opt-syms - "Returns set of symbols referenced by 'instrument' opts map" - [opts] - (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))])) - -(defn- fn-spec-name? - [s] - (and (symbol? s) - (not (some-> (resolve s) meta :macro)))) - -(defn instrumentable-syms - "Given an opts map as per instrument, returns the set of syms -that can be instrumented." - ([] (instrumentable-syms nil)) - ([opts] - (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys") - (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) - (keys (:spec opts)) - (:stub opts) - (keys (:replace opts))]))) - -(defn instrument - "Instruments the vars named by sym-or-syms, a symbol or collection -of symbols, or all instrumentable vars if sym-or-syms is not -specified. - -If a var has an :args fn-spec, sets the var's root binding to a -fn that checks arg conformance (throwing an exception on failure) -before delegating to the original fn. - -The opts map can be used to override registered specs, and/or to -replace fn implementations entirely. Opts for symbols not included -in sym-or-syms are ignored. This facilitates sharing a common -options map across many different calls to instrument. - -The opts map may have the following keys: - - :spec a map from var-name symbols to override specs - :stub a set of var-name symbols to be replaced by stubs - :gen a map from spec names to generator overrides - :replace a map from var-name symbols to replacement fns - -:spec overrides registered fn-specs with specs your provide. Use -:spec overrides to provide specs for libraries that do not have -them, or to constrain your own use of a fn to a subset of its -spec'ed contract. - -:stub replaces a fn with a stub that checks :args, then uses the -:ret spec to generate a return value. - -:gen overrides are used only for :stub generation. - -:replace replaces a fn with a fn that checks args conformance, then -invokes the fn you provide, enabling arbitrary stubbing and mocking. - -:spec can be used in combination with :stub or :replace. - -Returns a collection of syms naming the vars instrumented." - ([] (instrument (instrumentable-syms))) - ([sym-or-syms] (instrument sym-or-syms nil)) - ([sym-or-syms opts] - (locking instrumented-vars - (into - [] - (comp (filter (instrumentable-syms opts)) - (distinct) - (map #(instrument-1 % opts)) - (remove nil?)) - (collectionize sym-or-syms))))) - -(defn unstrument - "Undoes instrument on the vars named by sym-or-syms, specified -as in instrument. With no args, unstruments all instrumented vars. -Returns a collection of syms naming the vars unstrumented." - ([] (unstrument (map ->sym (keys @instrumented-vars)))) - ([sym-or-syms] - (locking instrumented-vars - (into - [] - (comp (filter symbol?) - (map unstrument-1) - (remove nil?)) - (collectionize sym-or-syms))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- explain-check - [args spec v role] - (ex-info - "Specification-based check failed" - (when-not (s/valid? spec v nil) - (assoc (s/explain-data* spec [role] [] [] v) - ::args args - ::val v - ::s/failure :check-failed)))) - -(defn- check-call - "Returns true if call passes specs, otherwise *returns* an exception -with explain-data + ::s/failure." - [f specs args] - (let [cargs (when (:args specs) (s/conform (:args specs) args))] - (if (= cargs ::s/invalid) - (explain-check args (:args specs) args :args) - (let [ret (apply f args) - cret (when (:ret specs) (s/conform (:ret specs) ret))] - (if (= cret ::s/invalid) - (explain-check args (:ret specs) ret :ret) - (if (and (:args specs) (:ret specs) (:fn specs)) - (if (s/valid? (:fn specs) {:args cargs :ret cret}) - true - (explain-check args (:fn specs) {:args cargs :ret cret} :fn)) - true)))))) - -(defn- quick-check - [f specs {gen :gen opts ::stc/opts}] - (let [{:keys [num-tests] :or {num-tests 1000}} opts - g (try (s/gen (:args specs) gen) (catch Throwable t t))] - (if (throwable? g) - {:result g} - (let [prop (gen/for-all* [g] #(check-call f specs %))] - (apply gen/quick-check num-tests prop (mapcat identity opts)))))) - -(defn- make-check-result - "Builds spec result map." - [check-sym spec test-check-ret] - (merge {:spec spec - ::stc/ret test-check-ret} - (when check-sym - {:sym check-sym}) - (when-let [result (-> test-check-ret :result)] - (when-not (true? result) {:failure result})) - (when-let [shrunk (-> test-check-ret :shrunk)] - {:failure (:result shrunk)}))) - -(defn- check-1 - [{:keys [s f v spec]} opts] - (let [re-inst? (and v (seq (unstrument s)) true) - f (or f (when v @v)) - specd (s/spec spec)] - (try - (cond - (or (nil? f) (some-> v meta :macro)) - {:failure (ex-info "No fn to spec" {::s/failure :no-fn}) - :sym s :spec spec} - - (:args specd) - (let [tcret (quick-check f specd opts)] - (make-check-result s spec tcret)) - - :default - {:failure (ex-info "No :args spec" {::s/failure :no-args-spec}) - :sym s :spec spec}) - (finally - (when re-inst? (instrument s)))))) - -(defn- sym->check-map - [s] - (let [v (resolve s)] - {:s s - :v v - :spec (when v (s/get-spec v))})) - -(defn- validate-check-opts - [opts] - (assert (every? ident? (keys (:gen opts))) "check :gen expects ident keys")) - -(defn check-fn - "Runs generative tests for fn f using spec and opts. See -'check' for options and return." - ([f spec] (check-fn f spec nil)) - ([f spec opts] - (validate-check-opts opts) - (check-1 {:f f :spec spec} opts))) - -(defn checkable-syms - "Given an opts map as per check, returns the set of syms that -can be checked." - ([] (checkable-syms nil)) - ([opts] - (validate-check-opts opts) - (reduce into #{} [(filter fn-spec-name? (keys (s/registry))) - (keys (:spec opts))]))) - -(defn check - "Run generative tests for spec conformance on vars named by -sym-or-syms, a symbol or collection of symbols. If sym-or-syms -is not specified, check all checkable vars. - -The opts map includes the following optional keys, where stc -aliases clojure.spec.test.check: - -::stc/opts opts to flow through test.check/quick-check -:gen map from spec names to generator overrides - -The ::stc/opts include :num-tests in addition to the keys -documented by test.check. Generator overrides are passed to -spec/gen when generating function args. - -Returns a lazy sequence of check result maps with the following -keys - -:spec the spec tested -:sym optional symbol naming the var tested -:failure optional test failure -::stc/ret optional value returned by test.check/quick-check - -The value for :failure can be any exception. Exceptions thrown by -spec itself will have an ::s/failure value in ex-data: - -:check-failed at least one checked return did not conform -:no-args-spec no :args spec provided -:no-fn no fn provided -:no-fspec no fspec provided -:no-gen unable to generate :args -:instrument invalid args detected by instrument -" - ([] (check (checkable-syms))) - ([sym-or-syms] (check sym-or-syms nil)) - ([sym-or-syms opts] - (->> (collectionize sym-or-syms) - (filter (checkable-syms opts)) - (pmap - #(check-1 (sym->check-map %) opts))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting ;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- failure-type - [x] - (::s/failure (ex-data x))) - -(defn- unwrap-failure - [x] - (if (failure-type x) - (ex-data x) - x)) - -(defn- result-type - "Returns the type of the check result. This can be any of the -::s/failure keywords documented in 'check', or: - - :check-passed all checked fn returns conformed - :check-threw checked fn threw an exception" - [ret] - (let [failure (:failure ret)] - (cond - (nil? failure) :check-passed - (failure-type failure) (failure-type failure) - :default :check-threw))) - -(defn abbrev-result - "Given a check result, returns an abbreviated version -suitable for summary use." - [x] - (if (:failure x) - (-> (dissoc x ::stc/ret) - (update :spec s/describe) - (update :failure unwrap-failure)) - (dissoc x :spec ::stc/ret))) - -(defn summarize-results - "Given a collection of check-results, e.g. from 'check', pretty -prints the summary-result (default abbrev-result) of each. - -Returns a map with :total, the total number of results, plus a -key with a count for each different :type of result." - ([check-results] (summarize-results check-results abbrev-result)) - ([check-results summary-result] - (reduce - (fn [summary result] - (pp/pprint (summary-result result)) - (-> summary - (update :total inc) - (update (result-type result) (fnil inc 0)))) - {:total 0} - check-results))) - - - diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/spec.clj clojure-1.9.0/src/clj/clojure/spec.clj --- clojure-1.9.0~alpha15/src/clj/clojure/spec.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/spec.clj 1970-01-01 00:00:00.000000000 +0000 @@ -1,1936 +0,0 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - -(ns clojure.spec - (:refer-clojure :exclude [+ * and assert or cat def keys merge]) - (:require [clojure.walk :as walk] - [clojure.spec.gen :as gen] - [clojure.string :as str])) - -(alias 'c 'clojure.core) - -(set! *warn-on-reflection* true) - -(def ^:dynamic *recursion-limit* - "A soft limit on how many times a branching spec (or/alt/*/opt-keys/multi-spec) - can be recursed through during generation. After this a - non-recursive branch will be chosen." - 4) - -(def ^:dynamic *fspec-iterations* - "The number of times an anonymous fn specified by fspec will be (generatively) tested during conform" - 21) - -(def ^:dynamic *coll-check-limit* - "The number of elements validated in a collection spec'ed with 'every'" - 101) - -(def ^:dynamic *coll-error-limit* - "The number of errors reported by explain in a collection spec'ed with 'every'" - 20) - -(defprotocol Spec - (conform* [spec x]) - (unform* [spec y]) - (explain* [spec path via in x]) - (gen* [spec overrides path rmap]) - (with-gen* [spec gfn]) - (describe* [spec])) - -(defonce ^:private registry-ref (atom {})) - -(defn- deep-resolve [reg k] - (loop [spec k] - (if (ident? spec) - (recur (get reg spec)) - spec))) - -(defn- reg-resolve - "returns the spec/regex at end of alias chain starting with k, nil if not found, k if k not ident" - [k] - (if (ident? k) - (let [reg @registry-ref - spec (get reg k)] - (if-not (ident? spec) - spec - (deep-resolve reg spec))) - k)) - -(defn- reg-resolve! - "returns the spec/regex at end of alias chain starting with k, throws if not found, k if k not ident" - [k] - (if (ident? k) - (c/or (reg-resolve k) - (throw (Exception. (str "Unable to resolve spec: " k)))) - k)) - -(defn spec? - "returns x if x is a spec object, else logical false" - [x] - (when (instance? clojure.spec.Spec x) - x)) - -(defn regex? - "returns x if x is a (clojure.spec) regex op, else logical false" - [x] - (c/and (::op x) x)) - -(defn- with-name [spec name] - (cond - (ident? spec) spec - (regex? spec) (assoc spec ::name name) - - (instance? clojure.lang.IObj spec) - (with-meta spec (assoc (meta spec) ::name name)))) - -(defn- spec-name [spec] - (cond - (ident? spec) spec - - (regex? spec) (::name spec) - - (instance? clojure.lang.IObj spec) - (-> (meta spec) ::name))) - -(declare spec-impl) -(declare regex-spec-impl) - -(defn- maybe-spec - "spec-or-k must be a spec, regex or resolvable kw/sym, else returns nil." - [spec-or-k] - (let [s (c/or (c/and (ident? spec-or-k) (reg-resolve spec-or-k)) - (spec? spec-or-k) - (regex? spec-or-k) - nil)] - (if (regex? s) - (with-name (regex-spec-impl s nil) (spec-name s)) - s))) - -(defn- the-spec - "spec-or-k must be a spec, regex or kw/sym, else returns nil. Throws if unresolvable kw/sym" - [spec-or-k] - (c/or (maybe-spec spec-or-k) - (when (ident? spec-or-k) - (throw (Exception. (str "Unable to resolve spec: " spec-or-k)))))) - -(defprotocol Specize - (specize* [_] [_ form])) - -(extend-protocol Specize - clojure.lang.Keyword - (specize* ([k] (specize* (reg-resolve! k))) - ([k _] (specize* (reg-resolve! k)))) - - clojure.lang.Symbol - (specize* ([s] (specize* (reg-resolve! s))) - ([s _] (specize* (reg-resolve! s)))) - - Object - (specize* ([o] (spec-impl ::unknown o nil nil)) - ([o form] (spec-impl form o nil nil)))) - -(defn- specize - ([s] (c/or (spec? s) (specize* s))) - ([s form] (c/or (spec? s) (specize* s form)))) - -(defn invalid? - "tests the validity of a conform return value" - [ret] - (identical? ::invalid ret)) - -(defn conform - "Given a spec and a value, returns :clojure.spec/invalid if value does not match spec, - else the (possibly destructured) value." - [spec x] - (conform* (specize spec) x)) - -(defn unform - "Given a spec and a value created by or compliant with a call to - 'conform' with the same spec, returns a value with all conform - destructuring undone." - [spec x] - (unform* (specize spec) x)) - -(defn form - "returns the spec as data" - [spec] - ;;TODO - incorporate gens - (describe* (specize spec))) - -(defn abbrev [form] - (cond - (seq? form) - (walk/postwalk (fn [form] - (cond - (c/and (symbol? form) (namespace form)) - (-> form name symbol) - - (c/and (seq? form) (= 'fn (first form)) (= '[%] (second form))) - (last form) - - :else form)) - form) - - (c/and (symbol? form) (namespace form)) - (-> form name symbol) - - :else form)) - -(defn describe - "returns an abbreviated description of the spec as data" - [spec] - (abbrev (form spec))) - -(defn with-gen - "Takes a spec and a no-arg, generator-returning fn and returns a version of that spec that uses that generator" - [spec gen-fn] - (let [spec (reg-resolve spec)] - (if (regex? spec) - (assoc spec ::gfn gen-fn) - (with-gen* (specize spec) gen-fn)))) - -(defn explain-data* [spec path via in x] - (let [probs (explain* (specize spec) path via in x)] - (when-not (empty? probs) - {::problems probs}))) - -(defn explain-data - "Given a spec and a value x which ought to conform, returns nil if x - conforms, else a map with at least the key ::problems whose value is - a collection of problem-maps, where problem-map has at least :path :pred and :val - keys describing the predicate and the value that failed at that - path." - [spec x] - (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) [] x)) - -(defn explain-printer - "Default printer for explain-data. nil indicates a successful validation." - [ed] - (if ed - (do - ;;(prn {:ed ed}) - (doseq [{:keys [path pred val reason via in] :as prob} (::problems ed)] - (when-not (empty? in) - (print "In:" (pr-str in) "")) - (print "val: ") - (pr val) - (print " fails") - (when-not (empty? via) - (print " spec:" (pr-str (last via)))) - (when-not (empty? path) - (print " at:" (pr-str path))) - (print " predicate: ") - (pr (abbrev pred)) - (when reason (print ", " reason)) - (doseq [[k v] prob] - (when-not (#{:path :pred :val :reason :via :in} k) - (print "\n\t" (pr-str k) " ") - (pr v))) - (newline)) - (doseq [[k v] ed] - (when-not (#{::problems} k) - (print (pr-str k) " ") - (pr v) - (newline)))) - (println "Success!"))) - -(def ^:dynamic *explain-out* explain-printer) - -(defn explain-out - "Prints explanation data (per 'explain-data') to *out* using the printer in *explain-out*, - by default explain-printer." - [ed] - (*explain-out* ed)) - -(defn explain - "Given a spec and a value that fails to conform, prints an explanation to *out*." - [spec x] - (explain-out (explain-data spec x))) - -(defn explain-str - "Given a spec and a value that fails to conform, returns an explanation as a string." - [spec x] - (with-out-str (explain spec x))) - -(declare valid?) - -(defn- gensub - [spec overrides path rmap form] - ;;(prn {:spec spec :over overrides :path path :form form}) - (let [spec (specize spec)] - (if-let [g (c/or (when-let [gfn (c/or (get overrides (c/or (spec-name spec) spec)) - (get overrides path))] - (gfn)) - (gen* spec overrides path rmap))] - (gen/such-that #(valid? spec %) g 100) - (let [abbr (abbrev form)] - (throw (ex-info (str "Unable to construct gen at: " path " for: " abbr) - {::path path ::form form ::failure :no-gen})))))) - -(defn gen - "Given a spec, returns the generator for it, or throws if none can - be constructed. Optionally an overrides map can be provided which - should map spec names or paths (vectors of keywords) to no-arg - generator-creating fns. These will be used instead of the generators at those - names/paths. Note that parent generator (in the spec or overrides - map) will supersede those of any subtrees. A generator for a regex - op must always return a sequential collection (i.e. a generator for - s/? should return either an empty sequence/vector or a - sequence/vector with one item in it)" - ([spec] (gen spec nil)) - ([spec overrides] (gensub spec overrides [] {::recursion-limit *recursion-limit*} spec))) - -(defn- ->sym - "Returns a symbol from a symbol or var" - [x] - (if (var? x) - (let [^clojure.lang.Var v x] - (symbol (str (.name (.ns v))) - (str (.sym v)))) - x)) - -(defn- unfn [expr] - (if (c/and (seq? expr) - (symbol? (first expr)) - (= "fn*" (name (first expr)))) - (let [[[s] & form] (rest expr)] - (conj (walk/postwalk-replace {s '%} form) '[%] 'fn)) - expr)) - -(defn- res [form] - (cond - (keyword? form) form - (symbol? form) (c/or (-> form resolve ->sym) form) - (sequential? form) (walk/postwalk #(if (symbol? %) (res %) %) (unfn form)) - :else form)) - -(defn ^:skip-wiki def-impl - "Do not call this directly, use 'def'" - [k form spec] - (c/assert (c/and (ident? k) (namespace k)) "k must be namespaced keyword or resolvable symbol") - (let [spec (if (c/or (spec? spec) (regex? spec) (get @registry-ref spec)) - spec - (spec-impl form spec nil nil))] - (swap! registry-ref assoc k (with-name spec k)) - k)) - -(defn- ns-qualify - "Qualify symbol s by resolving it or using the current *ns*." - [s] - (if-let [ns-sym (some-> s namespace symbol)] - (c/or (some-> (get (ns-aliases *ns*) ns-sym) str (symbol (name s))) - s) - (symbol (str (.name *ns*)) (str s)))) - -(defmacro def - "Given a namespace-qualified keyword or resolvable symbol k, and a - spec, spec-name, predicate or regex-op makes an entry in the - registry mapping k to the spec" - [k spec-form] - (let [k (if (symbol? k) (ns-qualify k) k)] - `(def-impl '~k '~(res spec-form) ~spec-form))) - -(defn registry - "returns the registry map, prefer 'get-spec' to lookup a spec by name" - [] - @registry-ref) - -(defn get-spec - "Returns spec registered for keyword/symbol/var k, or nil." - [k] - (get (registry) (if (keyword? k) k (->sym k)))) - -(declare map-spec) - -(defmacro spec - "Takes a single predicate form, e.g. can be the name of a predicate, - like even?, or a fn literal like #(< % 42). Note that it is not - generally necessary to wrap predicates in spec when using the rest - of the spec macros, only to attach a unique generator - - Can also be passed the result of one of the regex ops - - cat, alt, *, +, ?, in which case it will return a regex-conforming - spec, useful when nesting an independent regex. - --- - - Optionally takes :gen generator-fn, which must be a fn of no args that - returns a test.check generator. - - Returns a spec." - [form & {:keys [gen]}] - (when form - `(spec-impl '~(res form) ~form ~gen nil))) - -(defmacro multi-spec - "Takes the name of a spec/predicate-returning multimethod and a - tag-restoring keyword or fn (retag). Returns a spec that when - conforming or explaining data will pass it to the multimethod to get - an appropriate spec. You can e.g. use multi-spec to dynamically and - extensibly associate specs with 'tagged' data (i.e. data where one - of the fields indicates the shape of the rest of the structure). - - (defmulti mspec :tag) - - The methods should ignore their argument and return a predicate/spec: - (defmethod mspec :int [_] (s/keys :req-un [::tag ::i])) - - retag is used during generation to retag generated values with - matching tags. retag can either be a keyword, at which key the - dispatch-tag will be assoc'ed, or a fn of generated value and - dispatch-tag that should return an appropriately retagged value. - - Note that because the tags themselves comprise an open set, - the tag key spec cannot enumerate the values, but can e.g. - test for keyword?. - - Note also that the dispatch values of the multimethod will be - included in the path, i.e. in reporting and gen overrides, even - though those values are not evident in the spec. -" - [mm retag] - `(multi-spec-impl '~(res mm) (var ~mm) ~retag)) - -(defmacro keys - "Creates and returns a map validating spec. :req and :opt are both - vectors of namespaced-qualified keywords. The validator will ensure - the :req keys are present. The :opt keys serve as documentation and - may be used by the generator. - - The :req key vector supports 'and' and 'or' for key groups: - - (s/keys :req [::x ::y (or ::secret (and ::user ::pwd))] :opt [::z]) - - There are also -un versions of :req and :opt. These allow - you to connect unqualified keys to specs. In each case, fully - qualfied keywords are passed, which name the specs, but unqualified - keys (with the same name component) are expected and checked at - conform-time, and generated during gen: - - (s/keys :req-un [:my.ns/x :my.ns/y]) - - The above says keys :x and :y are required, and will be validated - and generated by specs (if they exist) named :my.ns/x :my.ns/y - respectively. - - In addition, the values of *all* namespace-qualified keys will be validated - (and possibly destructured) by any registered specs. Note: there is - no support for inline value specification, by design. - - Optionally takes :gen generator-fn, which must be a fn of no args that - returns a test.check generator." - [& {:keys [req req-un opt opt-un gen]}] - (let [unk #(-> % name keyword) - req-keys (filterv keyword? (flatten req)) - req-un-specs (filterv keyword? (flatten req-un)) - _ (c/assert (every? #(c/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un)) - "all keys must be namespace-qualified keywords") - req-specs (into req-keys req-un-specs) - req-keys (into req-keys (map unk req-un-specs)) - opt-keys (into (vec opt) (map unk opt-un)) - opt-specs (into (vec opt) opt-un) - gx (gensym) - parse-req (fn [rk f] - (map (fn [x] - (if (keyword? x) - `(contains? ~gx ~(f x)) - (walk/postwalk - (fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y)) - x))) - rk)) - pred-exprs [`(map? ~gx)] - pred-exprs (into pred-exprs (parse-req req identity)) - pred-exprs (into pred-exprs (parse-req req-un unk)) - keys-pred `(fn* [~gx] (c/and ~@pred-exprs)) - pred-exprs (mapv (fn [e] `(fn* [~gx] ~e)) pred-exprs) - pred-forms (walk/postwalk res pred-exprs)] - ;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen) - `(map-spec-impl {:req '~req :opt '~opt :req-un '~req-un :opt-un '~opt-un - :req-keys '~req-keys :req-specs '~req-specs - :opt-keys '~opt-keys :opt-specs '~opt-specs - :pred-forms '~pred-forms - :pred-exprs ~pred-exprs - :keys-pred ~keys-pred - :gfn ~gen}))) - -(defmacro or - "Takes key+pred pairs, e.g. - - (s/or :even even? :small #(< % 42)) - - Returns a destructuring spec that returns a map entry containing the - key of the first matching pred and the corresponding value. Thus the - 'key' and 'val' functions can be used to refer generically to the - components of the tagged return." - [& key-pred-forms] - (let [pairs (partition 2 key-pred-forms) - keys (mapv first pairs) - pred-forms (mapv second pairs) - pf (mapv res pred-forms)] - (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords") - `(or-spec-impl ~keys '~pf ~pred-forms nil))) - -(defmacro and - "Takes predicate/spec-forms, e.g. - - (s/and even? #(< % 42)) - - Returns a spec that returns the conformed value. Successive - conformed values propagate through rest of predicates." - [& pred-forms] - `(and-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) - -(defmacro merge - "Takes map-validating specs (e.g. 'keys' specs) and - returns a spec that returns a conformed map satisfying all of the - specs. Unlike 'and', merge can generate maps satisfying the - union of the predicates." - [& pred-forms] - `(merge-spec-impl '~(mapv res pred-forms) ~(vec pred-forms) nil)) - -(defn- res-kind - [opts] - (let [{kind :kind :as mopts} opts] - (->> - (if kind - (assoc mopts :kind `~(res kind)) - mopts) - (mapcat identity)))) - -(defmacro every - "takes a pred and validates collection elements against that pred. - - Note that 'every' does not do exhaustive checking, rather it samples - *coll-check-limit* elements. Nor (as a result) does it do any - conforming of elements. 'explain' will report at most *coll-error-limit* - problems. Thus 'every' should be suitable for potentially large - collections. - - Takes several kwargs options that further constrain the collection: - - :kind - a pred/spec that the collection type must satisfy, e.g. vector? - (default nil) Note that if :kind is specified and :into is - not, this pred must generate in order for every to generate. - :count - specifies coll has exactly this count (default nil) - :min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil) - :distinct - all the elements are distinct (default nil) - - And additional args that control gen - - :gen-max - the maximum coll size to generate (default 20) - :into - one of [], (), {}, #{} - the default collection to generate into - (default: empty coll as generated by :kind pred if supplied, else []) - - Optionally takes :gen generator-fn, which must be a fn of no args that - returns a test.check generator - - See also - coll-of, every-kv -" - [pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}] - (let [desc (::describe opts) - nopts (-> opts - (dissoc :gen ::describe) - (assoc ::kind-form `'~(res (:kind opts)) - ::describe (c/or desc `'(every ~(res pred) ~@(res-kind opts))))) - gx (gensym) - cpreds (cond-> [(list (c/or kind `coll?) gx)] - count (conj `(= ~count (bounded-count ~count ~gx))) - - (c/or min-count max-count) - (conj `(<= (c/or ~min-count 0) - (bounded-count (if ~max-count (inc ~max-count) ~min-count) ~gx) - (c/or ~max-count Integer/MAX_VALUE))) - - distinct - (conj `(c/or (empty? ~gx) (apply distinct? ~gx))))] - `(every-impl '~pred ~pred ~(assoc nopts ::cpred `(fn* [~gx] (c/and ~@cpreds))) ~gen))) - -(defmacro every-kv - "like 'every' but takes separate key and val preds and works on associative collections. - - Same options as 'every', :into defaults to {} - - See also - map-of" - - [kpred vpred & opts] - (let [desc `(every-kv ~(res kpred) ~(res vpred) ~@(res-kind opts))] - `(every (tuple ~kpred ~vpred) ::kfn (fn [i# v#] (nth v# 0)) :into {} ::describe '~desc ~@opts))) - -(defmacro coll-of - "Returns a spec for a collection of items satisfying pred. Unlike - 'every', coll-of will exhaustively conform every value. - - Same options as 'every'. conform will produce a collection - corresponding to :into if supplied, else will match the input collection, - avoiding rebuilding when possible. - - See also - every, map-of" - [pred & opts] - (let [desc `(coll-of ~(res pred) ~@(res-kind opts))] - `(every ~pred ::conform-all true ::describe '~desc ~@opts))) - -(defmacro map-of - "Returns a spec for a map whose keys satisfy kpred and vals satisfy - vpred. Unlike 'every-kv', map-of will exhaustively conform every - value. - - Same options as 'every', :kind defaults to map?, with the addition of: - - :conform-keys - conform keys as well as values (default false) - - See also - every-kv" - [kpred vpred & opts] - (let [desc `(map-of ~(res kpred) ~(res vpred) ~@(res-kind opts))] - `(every-kv ~kpred ~vpred ::conform-all true :kind map? ::describe '~desc ~@opts))) - - -(defmacro * - "Returns a regex op that matches zero or more values matching - pred. Produces a vector of matches iff there is at least one match" - [pred-form] - `(rep-impl '~(res pred-form) ~pred-form)) - -(defmacro + - "Returns a regex op that matches one or more values matching - pred. Produces a vector of matches" - [pred-form] - `(rep+impl '~(res pred-form) ~pred-form)) - -(defmacro ? - "Returns a regex op that matches zero or one value matching - pred. Produces a single value (not a collection) if matched." - [pred-form] - `(maybe-impl ~pred-form '~pred-form)) - -(defmacro alt - "Takes key+pred pairs, e.g. - - (s/alt :even even? :small #(< % 42)) - - Returns a regex op that returns a map entry containing the key of the - first matching pred and the corresponding value. Thus the - 'key' and 'val' functions can be used to refer generically to the - components of the tagged return" - [& key-pred-forms] - (let [pairs (partition 2 key-pred-forms) - keys (mapv first pairs) - pred-forms (mapv second pairs) - pf (mapv res pred-forms)] - (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords") - `(alt-impl ~keys ~pred-forms '~pf))) - -(defmacro cat - "Takes key+pred pairs, e.g. - - (s/cat :e even? :o odd?) - - Returns a regex op that matches (all) values in sequence, returning a map - containing the keys of each pred and the corresponding value." - [& key-pred-forms] - (let [pairs (partition 2 key-pred-forms) - keys (mapv first pairs) - pred-forms (mapv second pairs) - pf (mapv res pred-forms)] - ;;(prn key-pred-forms) - (c/assert (c/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords") - `(cat-impl ~keys ~pred-forms '~pf))) - -(defmacro & - "takes a regex op re, and predicates. Returns a regex-op that consumes - input as per re but subjects the resulting value to the - conjunction of the predicates, and any conforming they might perform." - [re & preds] - (let [pv (vec preds)] - `(amp-impl ~re ~pv '~(mapv res pv)))) - -(defmacro conformer - "takes a predicate function with the semantics of conform i.e. it should return either a - (possibly converted) value or :clojure.spec/invalid, and returns a - spec that uses it as a predicate/conformer. Optionally takes a - second fn that does unform of result of first" - ([f] `(spec-impl '(conformer ~(res f)) ~f nil true)) - ([f unf] `(spec-impl '(conformer ~(res f) ~(res unf)) ~f nil true ~unf))) - -(defmacro fspec - "takes :args :ret and (optional) :fn kwargs whose values are preds - and returns a spec whose conform/explain take a fn and validates it - using generative testing. The conformed value is always the fn itself. - - See 'fdef' for a single operation that creates an fspec and - registers it, as well as a full description of :args, :ret and :fn - - fspecs can generate functions that validate the arguments and - fabricate a return value compliant with the :ret spec, ignoring - the :fn spec if present. - - Optionally takes :gen generator-fn, which must be a fn of no args - that returns a test.check generator." - - [& {:keys [args ret fn gen]}] - `(fspec-impl (spec ~args) '~(res args) - (spec ~ret) '~(res ret) - (spec ~fn) '~(res fn) ~gen)) - -(defmacro tuple - "takes one or more preds and returns a spec for a tuple, a vector - where each element conforms to the corresponding pred. Each element - will be referred to in paths using its ordinal." - [& preds] - (c/assert (not (empty? preds))) - `(tuple-impl '~(mapv res preds) ~(vec preds))) - -(defn- macroexpand-check - [v args] - (let [fn-spec (get-spec v)] - (when-let [arg-spec (:args fn-spec)] - (when (invalid? (conform arg-spec args)) - (let [ed (assoc (explain-data* arg-spec [:args] - (if-let [name (spec-name arg-spec)] [name] []) [] args) - ::args args)] - (throw (ex-info - (str - "Call to " (->sym v) " did not conform to spec:\n" - (with-out-str (explain-out ed))) - ed))))))) - -(defmacro fdef - "Takes a symbol naming a function, and one or more of the following: - - :args A regex spec for the function arguments as they were a list to be - passed to apply - in this way, a single spec can handle functions with - multiple arities - :ret A spec for the function's return value - :fn A spec of the relationship between args and ret - the - value passed is {:args conformed-args :ret conformed-ret} and is - expected to contain predicates that relate those values - - Qualifies fn-sym with resolve, or using *ns* if no resolution found. - Registers an fspec in the global registry, where it can be retrieved - by calling get-spec with the var or fully-qualified symbol. - - Once registered, function specs are included in doc, checked by - instrument, tested by the runner clojure.spec.test/check, and (if - a macro) used to explain errors during macroexpansion. - - Note that :fn specs require the presence of :args and :ret specs to - conform values, and so :fn specs will be ignored if :args or :ret - are missing. - - Returns the qualified fn-sym. - - For example, to register function specs for the symbol function: - - (s/fdef clojure.core/symbol - :args (s/alt :separate (s/cat :ns string? :n string?) - :str string? - :sym symbol?) - :ret symbol?)" - [fn-sym & specs] - `(clojure.spec/def ~fn-sym (clojure.spec/fspec ~@specs))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defn- recur-limit? [rmap id path k] - (c/and (> (get rmap id) (::recursion-limit rmap)) - (contains? (set path) k))) - -(defn- inck [m k] - (assoc m k (inc (c/or (get m k) 0)))) - -(defn- dt - ([pred x form] (dt pred x form nil)) - ([pred x form cpred?] - (if pred - (if-let [spec (the-spec pred)] - (conform spec x) - (if (ifn? pred) - (if cpred? - (pred x) - (if (pred x) x ::invalid)) - (throw (Exception. (str (pr-str form) " is not a fn, expected predicate fn"))))) - x))) - -(defn valid? - "Helper function that returns true when x is valid for spec." - ([spec x] - (let [spec (specize spec)] - (not (invalid? (conform* spec x))))) - ([spec x form] - (let [spec (specize spec form)] - (not (invalid? (conform* spec x)))))) - -(defn- pvalid? - "internal helper function that returns true when x is valid for spec." - ([pred x] - (not (invalid? (dt pred x ::unknown)))) - ([pred x form] - (not (invalid? (dt pred x form))))) - -(defn- explain-1 [form pred path via in v] - ;;(prn {:form form :pred pred :path path :in in :v v}) - (let [pred (maybe-spec pred)] - (if (spec? pred) - (explain* pred path (if-let [name (spec-name pred)] (conj via name) via) in v) - [{:path path :pred (abbrev form) :val v :via via :in in}]))) - -(defn ^:skip-wiki map-spec-impl - "Do not call this directly, use 'spec' with a map argument" - [{:keys [req-un opt-un keys-pred pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn] - :as argm}] - (let [k->s (zipmap (concat req-keys opt-keys) (concat req-specs opt-specs)) - keys->specnames #(c/or (k->s %) %) - id (java.util.UUID/randomUUID)] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ m] - (if (keys-pred m) - (let [reg (registry)] - (loop [ret m, [[k v] & ks :as keys] m] - (if keys - (let [sname (keys->specnames k)] - (if-let [s (get reg sname)] - (let [cv (conform s v)] - (if (invalid? cv) - ::invalid - (recur (if (identical? cv v) ret (assoc ret k cv)) - ks))) - (recur ret ks))) - ret))) - ::invalid)) - (unform* [_ m] - (let [reg (registry)] - (loop [ret m, [k & ks :as keys] (c/keys m)] - (if keys - (if (contains? reg (keys->specnames k)) - (let [cv (get m k) - v (unform (keys->specnames k) cv)] - (recur (if (identical? cv v) ret (assoc ret k v)) - ks)) - (recur ret ks)) - ret)))) - (explain* [_ path via in x] - (if-not (map? x) - [{:path path :pred 'map? :val x :via via :in in}] - (let [reg (registry)] - (apply concat - (when-let [probs (->> (map (fn [pred form] (when-not (pred x) (abbrev form))) - pred-exprs pred-forms) - (keep identity) - seq)] - (map - #(identity {:path path :pred % :val x :via via :in in}) - probs)) - (map (fn [[k v]] - (when-not (c/or (not (contains? reg (keys->specnames k))) - (pvalid? (keys->specnames k) v k)) - (explain-1 (keys->specnames k) (keys->specnames k) (conj path k) via (conj in k) v))) - (seq x)))))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [rmap (inck rmap id) - gen (fn [k s] (gensub s overrides (conj path k) rmap k)) - ogen (fn [k s] - (when-not (recur-limit? rmap id path k) - [k (gen/delay (gensub s overrides (conj path k) rmap k))])) - req-gens (map gen req-keys req-specs) - opt-gens (remove nil? (map ogen opt-keys opt-specs))] - (when (every? identity (concat req-gens opt-gens)) - (let [reqs (zipmap req-keys req-gens) - opts (into {} opt-gens)] - (gen/bind (gen/choose 0 (count opts)) - #(let [args (concat (seq reqs) (when (seq opts) (shuffle (seq opts))))] - (->> args - (take (c/+ % (count reqs))) - (apply concat) - (apply gen/hash-map))))))))) - (with-gen* [_ gfn] (map-spec-impl (assoc argm :gfn gfn))) - (describe* [_] (cons `keys - (cond-> [] - req (conj :req req) - opt (conj :opt opt) - req-un (conj :req-un req-un) - opt-un (conj :opt-un opt-un))))))) - - - - -(defn ^:skip-wiki spec-impl - "Do not call this directly, use 'spec'" - ([form pred gfn cpred?] (spec-impl form pred gfn cpred? nil)) - ([form pred gfn cpred? unc] - (cond - (spec? pred) (cond-> pred gfn (with-gen gfn)) - (regex? pred) (regex-spec-impl pred gfn) - (ident? pred) (cond-> (the-spec pred) gfn (with-gen gfn)) - :else - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (let [ret (pred x)] - (if cpred? - ret - (if ret x ::invalid)))) - (unform* [_ x] (if cpred? - (if unc - (unc x) - (throw (IllegalStateException. "no unform fn for conformer"))) - x)) - (explain* [_ path via in x] - (when (invalid? (dt pred x form cpred?)) - [{:path path :pred (abbrev form) :val x :via via :in in}])) - (gen* [_ _ _ _] (if gfn - (gfn) - (gen/gen-for-pred pred))) - (with-gen* [_ gfn] (spec-impl form pred gfn cpred? unc)) - (describe* [_] form))))) - -(defn ^:skip-wiki multi-spec-impl - "Do not call this directly, use 'multi-spec'" - ([form mmvar retag] (multi-spec-impl form mmvar retag nil)) - ([form mmvar retag gfn] - (let [id (java.util.UUID/randomUUID) - predx #(let [^clojure.lang.MultiFn mm @mmvar] - (c/and (.getMethod mm ((.dispatchFn mm) %)) - (mm %))) - dval #((.dispatchFn ^clojure.lang.MultiFn @mmvar) %) - tag (if (keyword? retag) - #(assoc %1 retag %2) - retag)] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (if-let [pred (predx x)] - (dt pred x form) - ::invalid)) - (unform* [_ x] (if-let [pred (predx x)] - (unform pred x) - (throw (IllegalStateException. (str "No method of: " form " for dispatch value: " (dval x)))))) - (explain* [_ path via in x] - (let [dv (dval x) - path (conj path dv)] - (if-let [pred (predx x)] - (explain-1 form pred path via in x) - [{:path path :pred (abbrev form) :val x :reason "no method" :via via :in in}]))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [gen (fn [[k f]] - (let [p (f nil)] - (let [rmap (inck rmap id)] - (when-not (recur-limit? rmap id path k) - (gen/delay - (gen/fmap - #(tag % k) - (gensub p overrides (conj path k) rmap (list 'method form k)))))))) - gs (->> (methods @mmvar) - (remove (fn [[k]] (invalid? k))) - (map gen) - (remove nil?))] - (when (every? identity gs) - (gen/one-of gs))))) - (with-gen* [_ gfn] (multi-spec-impl form mmvar retag gfn)) - (describe* [_] `(multi-spec ~form ~retag)))))) - -(defn ^:skip-wiki tuple-impl - "Do not call this directly, use 'tuple'" - ([forms preds] (tuple-impl forms preds nil)) - ([forms preds gfn] - (let [specs (delay (mapv specize preds forms)) - cnt (count preds)] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] - (let [specs @specs] - (if-not (c/and (vector? x) - (= (count x) cnt)) - ::invalid - (loop [ret x, i 0] - (if (= i cnt) - ret - (let [v (x i) - cv (conform* (specs i) v)] - (if (invalid? cv) - ::invalid - (recur (if (identical? cv v) ret (assoc ret i cv)) - (inc i))))))))) - (unform* [_ x] - (c/assert (c/and (vector? x) - (= (count x) (count preds)))) - (loop [ret x, i 0] - (if (= i (count x)) - ret - (let [cv (x i) - v (unform (preds i) cv)] - (recur (if (identical? cv v) ret (assoc ret i v)) - (inc i)))))) - (explain* [_ path via in x] - (cond - (not (vector? x)) - [{:path path :pred 'vector? :val x :via via :in in}] - - (not= (count x) (count preds)) - [{:path path :pred `(= (count ~'%) ~(count preds)) :val x :via via :in in}] - - :else - (apply concat - (map (fn [i form pred] - (let [v (x i)] - (when-not (pvalid? pred v) - (explain-1 form pred (conj path i) via (conj in i) v)))) - (range (count preds)) forms preds)))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [gen (fn [i p f] - (gensub p overrides (conj path i) rmap f)) - gs (map gen (range (count preds)) preds forms)] - (when (every? identity gs) - (apply gen/tuple gs))))) - (with-gen* [_ gfn] (tuple-impl forms preds gfn)) - (describe* [_] `(tuple ~@forms)))))) - -(defn- tagged-ret [tag ret] - (clojure.lang.MapEntry. tag ret)) - -(defn ^:skip-wiki or-spec-impl - "Do not call this directly, use 'or'" - [keys forms preds gfn] - (let [id (java.util.UUID/randomUUID) - kps (zipmap keys preds) - specs (delay (mapv specize preds forms)) - cform (case (count preds) - 2 (fn [x] - (let [specs @specs - ret (conform* (specs 0) x)] - (if (invalid? ret) - (let [ret (conform* (specs 1) x)] - (if (invalid? ret) - ::invalid - (tagged-ret (keys 1) ret))) - (tagged-ret (keys 0) ret)))) - 3 (fn [x] - (let [specs @specs - ret (conform* (specs 0) x)] - (if (invalid? ret) - (let [ret (conform* (specs 1) x)] - (if (invalid? ret) - (let [ret (conform* (specs 2) x)] - (if (invalid? ret) - ::invalid - (tagged-ret (keys 2) ret))) - (tagged-ret (keys 1) ret))) - (tagged-ret (keys 0) ret)))) - (fn [x] - (let [specs @specs] - (loop [i 0] - (if (< i (count specs)) - (let [spec (specs i)] - (let [ret (conform* spec x)] - (if (invalid? ret) - (recur (inc i)) - (tagged-ret (keys i) ret)))) - ::invalid)))))] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (cform x)) - (unform* [_ [k x]] (unform (kps k) x)) - (explain* [this path via in x] - (when-not (pvalid? this x) - (apply concat - (map (fn [k form pred] - (when-not (pvalid? pred x) - (explain-1 form pred (conj path k) via in x))) - keys forms preds)))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [gen (fn [k p f] - (let [rmap (inck rmap id)] - (when-not (recur-limit? rmap id path k) - (gen/delay - (gensub p overrides (conj path k) rmap f))))) - gs (remove nil? (map gen keys preds forms))] - (when-not (empty? gs) - (gen/one-of gs))))) - (with-gen* [_ gfn] (or-spec-impl keys forms preds gfn)) - (describe* [_] `(or ~@(mapcat vector keys forms)))))) - -(defn- and-preds [x preds forms] - (loop [ret x - [pred & preds] preds - [form & forms] forms] - (if pred - (let [nret (dt pred ret form)] - (if (invalid? nret) - ::invalid - ;;propagate conformed values - (recur nret preds forms))) - ret))) - -(defn- explain-pred-list - [forms preds path via in x] - (loop [ret x - [form & forms] forms - [pred & preds] preds] - (when pred - (let [nret (dt pred ret form)] - (if (invalid? nret) - (explain-1 form pred path via in ret) - (recur nret forms preds)))))) - -(defn ^:skip-wiki and-spec-impl - "Do not call this directly, use 'and'" - [forms preds gfn] - (let [specs (delay (mapv specize preds forms)) - cform - (case (count preds) - 2 (fn [x] - (let [specs @specs - ret (conform* (specs 0) x)] - (if (invalid? ret) - ::invalid - (conform* (specs 1) ret)))) - 3 (fn [x] - (let [specs @specs - ret (conform* (specs 0) x)] - (if (invalid? ret) - ::invalid - (let [ret (conform* (specs 1) ret)] - (if (invalid? ret) - ::invalid - (conform* (specs 2) ret)))))) - (fn [x] - (let [specs @specs] - (loop [ret x i 0] - (if (< i (count specs)) - (let [nret (conform* (specs i) ret)] - (if (invalid? nret) - ::invalid - ;;propagate conformed values - (recur nret (inc i)))) - ret)))))] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (cform x)) - (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds))) - (explain* [_ path via in x] (explain-pred-list forms preds path via in x)) - (gen* [_ overrides path rmap] (if gfn (gfn) (gensub (first preds) overrides path rmap (first forms)))) - (with-gen* [_ gfn] (and-spec-impl forms preds gfn)) - (describe* [_] `(and ~@forms))))) - -(defn ^:skip-wiki merge-spec-impl - "Do not call this directly, use 'merge'" - [forms preds gfn] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (let [ms (map #(dt %1 x %2) preds forms)] - (if (some invalid? ms) - ::invalid - (apply c/merge ms)))) - (unform* [_ x] (apply c/merge (map #(unform % x) (reverse preds)))) - (explain* [_ path via in x] - (apply concat - (map #(explain-1 %1 %2 path via in x) - forms preds))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (gen/fmap - #(apply c/merge %) - (apply gen/tuple (map #(gensub %1 overrides path rmap %2) - preds forms))))) - (with-gen* [_ gfn] (merge-spec-impl forms preds gfn)) - (describe* [_] `(merge ~@forms)))) - -(defn- coll-prob [x kfn kform distinct count min-count max-count - path via in] - (let [pred (c/or kfn coll?) - kform (c/or kform `coll?)] - (cond - (not (pvalid? pred x)) - (explain-1 kform pred path via in x) - - (c/and count (not= count (bounded-count count x))) - [{:path path :pred `(= ~count (c/count ~'%)) :val x :via via :in in}] - - (c/and (c/or min-count max-count) - (not (<= (c/or min-count 0) - (bounded-count (if max-count (inc max-count) min-count) x) - (c/or max-count Integer/MAX_VALUE)))) - [{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}] - - (c/and distinct (not (empty? x)) (not (apply distinct? x))) - [{:path path :pred 'distinct? :val x :via via :in in}]))) - -(defn ^:skip-wiki every-impl - "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'" - ([form pred opts] (every-impl form pred opts nil)) - ([form pred {gen-into :into - describe-form ::describe - :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn ::cpred - conform-keys ::conform-all] - :or {gen-max 20} - :as opts} - gfn] - (let [conform-into gen-into - spec (delay (specize pred)) - check? #(valid? @spec %) - kfn (c/or kfn (fn [i v] i)) - addcv (fn [ret i v cv] (conj ret cv)) - cfns (fn [x] - ;;returns a tuple of [init add complete] fns - (cond - (c/and (vector? x) (c/or (not conform-into) (vector? conform-into))) - [identity - (fn [ret i v cv] - (if (identical? v cv) - ret - (assoc ret i cv))) - identity] - - (c/and (map? x) (c/or (c/and kind (not conform-into)) (map? conform-into))) - [(if conform-keys empty identity) - (fn [ret i v cv] - (if (c/and (identical? v cv) (not conform-keys)) - ret - (assoc ret (nth (if conform-keys cv v) 0) (nth cv 1)))) - identity] - - (c/or (list? conform-into) (seq? conform-into) (c/and (not conform-into) (c/or (list? x) (seq? x)))) - [(constantly ()) addcv reverse] - - :else [#(empty (c/or conform-into %)) addcv identity]))] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] - (let [spec @spec] - (cond - (not (cpred x)) ::invalid - - conform-all - (let [[init add complete] (cfns x)] - (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)] - (if vseq - (let [cv (conform* spec v)] - (if (invalid? cv) - ::invalid - (recur (add ret i v cv) (inc i) vs))) - (complete ret)))) - - - :else - (if (indexed? x) - (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))] - (loop [i 0] - (if (>= i (c/count x)) - x - (if (valid? spec (nth x i)) - (recur (c/+ i step)) - ::invalid)))) - (let [limit *coll-check-limit*] - (loop [i 0 [v & vs :as vseq] (seq x)] - (cond - (c/or (nil? vseq) (= i limit)) x - (valid? spec v) (recur (inc i) vs) - :else ::invalid))))))) - (unform* [_ x] x) - (explain* [_ path via in x] - (c/or (coll-prob x kind kind-form distinct count min-count max-count - path via in) - (apply concat - ((if conform-all identity (partial take *coll-error-limit*)) - (keep identity - (map (fn [i v] - (let [k (kfn i v)] - (when-not (check? v) - (let [prob (explain-1 form pred path via (conj in k) v)] - prob)))) - (range) x)))))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (let [pgen (gensub pred overrides path rmap form)] - (gen/bind - (cond - gen-into (gen/return (empty gen-into)) - kind (gen/fmap #(if (empty? %) % (empty %)) - (gensub kind overrides path rmap form)) - :else (gen/return [])) - (fn [init] - (gen/fmap - #(if (vector? init) % (into init %)) - (cond - distinct - (if count - (gen/vector-distinct pgen {:num-elements count :max-tries 100}) - (gen/vector-distinct pgen {:min-elements (c/or min-count 0) - :max-elements (c/or max-count (max gen-max (c/* 2 (c/or min-count 0)))) - :max-tries 100})) - - count - (gen/vector pgen count) - - (c/or min-count max-count) - (gen/vector pgen (c/or min-count 0) (c/or max-count (max gen-max (c/* 2 (c/or min-count 0))))) - - :else - (gen/vector pgen 0 gen-max)))))))) - - (with-gen* [_ gfn] (every-impl form pred opts gfn)) - (describe* [_] (c/or describe-form `(every ~(res form) ~@(mapcat identity opts)))))))) - -;;;;;;;;;;;;;;;;;;;;;;; regex ;;;;;;;;;;;;;;;;;;; -;;See: -;; http://matt.might.net/articles/implementation-of-regular-expression-matching-in-scheme-with-derivatives/ -;; http://www.ccs.neu.edu/home/turon/re-deriv.pdf - -;;ctors -(defn- accept [x] {::op ::accept :ret x}) - -(defn- accept? [{:keys [::op]}] - (= ::accept op)) - -(defn- pcat* [{[p1 & pr :as ps] :ps, [k1 & kr :as ks] :ks, [f1 & fr :as forms] :forms, ret :ret, rep+ :rep+}] - (when (every? identity ps) - (if (accept? p1) - (let [rp (:ret p1) - ret (conj ret (if ks {k1 rp} rp))] - (if pr - (pcat* {:ps pr :ks kr :forms fr :ret ret}) - (accept ret))) - {::op ::pcat, :ps ps, :ret ret, :ks ks, :forms forms :rep+ rep+}))) - -(defn- pcat [& ps] (pcat* {:ps ps :ret []})) - -(defn ^:skip-wiki cat-impl - "Do not call this directly, use 'cat'" - [ks ps forms] - (pcat* {:ks ks, :ps ps, :forms forms, :ret {}})) - -(defn- rep* [p1 p2 ret splice form] - (when p1 - (let [r {::op ::rep, :p2 p2, :splice splice, :forms form :id (java.util.UUID/randomUUID)}] - (if (accept? p1) - (assoc r :p1 p2 :ret (conj ret (:ret p1))) - (assoc r :p1 p1, :ret ret))))) - -(defn ^:skip-wiki rep-impl - "Do not call this directly, use '*'" - [form p] (rep* p p [] false form)) - -(defn ^:skip-wiki rep+impl - "Do not call this directly, use '+'" - [form p] - (pcat* {:ps [p (rep* p p [] true form)] :forms `[~form (* ~form)] :ret [] :rep+ form})) - -(defn ^:skip-wiki amp-impl - "Do not call this directly, use '&'" - [re preds pred-forms] - {::op ::amp :p1 re :ps preds :forms pred-forms}) - -(defn- filter-alt [ps ks forms f] - (if (c/or ks forms) - (let [pks (->> (map vector ps - (c/or (seq ks) (repeat nil)) - (c/or (seq forms) (repeat nil))) - (filter #(-> % first f)))] - [(seq (map first pks)) (when ks (seq (map second pks))) (when forms (seq (map #(nth % 2) pks)))]) - [(seq (filter f ps)) ks forms])) - -(defn- alt* [ps ks forms] - (let [[[p1 & pr :as ps] [k1 :as ks] forms] (filter-alt ps ks forms identity)] - (when ps - (let [ret {::op ::alt, :ps ps, :ks ks :forms forms}] - (if (nil? pr) - (if k1 - (if (accept? p1) - (accept (tagged-ret k1 (:ret p1))) - ret) - p1) - ret))))) - -(defn- alts [& ps] (alt* ps nil nil)) -(defn- alt2 [p1 p2] (if (c/and p1 p2) (alts p1 p2) (c/or p1 p2))) - -(defn ^:skip-wiki alt-impl - "Do not call this directly, use 'alt'" - [ks ps forms] (assoc (alt* ps ks forms) :id (java.util.UUID/randomUUID))) - -(defn ^:skip-wiki maybe-impl - "Do not call this directly, use '?'" - [p form] (assoc (alt* [p (accept ::nil)] nil [form ::nil]) :maybe form)) - -(defn- noret? [p1 pret] - (c/or (= pret ::nil) - (c/and (#{::rep ::pcat} (::op (reg-resolve! p1))) ;;hrm, shouldn't know these - (empty? pret)) - nil)) - -(declare preturn) - -(defn- accept-nil? [p] - (let [{:keys [::op ps p1 p2 forms] :as p} (reg-resolve! p)] - (case op - ::accept true - nil nil - ::amp (c/and (accept-nil? p1) - (c/or (noret? p1 (preturn p1)) - (let [ret (-> (preturn p1) (and-preds ps (next forms)))] - (not (invalid? ret))))) - ::rep (c/or (identical? p1 p2) (accept-nil? p1)) - ::pcat (every? accept-nil? ps) - ::alt (c/some accept-nil? ps)))) - -(declare add-ret) - -(defn- preturn [p] - (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms] :as p} (reg-resolve! p)] - (case op - ::accept ret - nil nil - ::amp (let [pret (preturn p1)] - (if (noret? p1 pret) - ::nil - (and-preds pret ps forms))) - ::rep (add-ret p1 ret k) - ::pcat (add-ret p0 ret k) - ::alt (let [[[p0] [k0]] (filter-alt ps ks forms accept-nil?) - r (if (nil? p0) ::nil (preturn p0))] - (if k0 (tagged-ret k0 r) r))))) - -(defn- op-unform [p x] - ;;(prn {:p p :x x}) - (let [{[p0 & pr :as ps] :ps, [k :as ks] :ks, :keys [::op p1 ret forms rep+ maybe] :as p} (reg-resolve! p) - kps (zipmap ks ps)] - (case op - ::accept [ret] - nil [(unform p x)] - ::amp (let [px (reduce #(unform %2 %1) x (reverse ps))] - (op-unform p1 px)) - ::rep (mapcat #(op-unform p1 %) x) - ::pcat (if rep+ - (mapcat #(op-unform p0 %) x) - (mapcat (fn [k] - (when (contains? x k) - (op-unform (kps k) (get x k)))) - ks)) - ::alt (if maybe - [(unform p0 x)] - (let [[k v] x] - (op-unform (kps k) v)))))) - -(defn- add-ret [p r k] - (let [{:keys [::op ps splice] :as p} (reg-resolve! p) - prop #(let [ret (preturn p)] - (if (empty? ret) r ((if splice into conj) r (if k {k ret} ret))))] - (case op - nil r - (::alt ::accept ::amp) - (let [ret (preturn p)] - ;;(prn {:ret ret}) - (if (= ret ::nil) r (conj r (if k {k ret} ret)))) - - (::rep ::pcat) (prop)))) - -(defn- deriv - [p x] - (let [{[p0 & pr :as ps] :ps, [k0 & kr :as ks] :ks, :keys [::op p1 p2 ret splice forms] :as p} (reg-resolve! p)] - (when p - (case op - ::accept nil - nil (let [ret (dt p x p)] - (when-not (invalid? ret) (accept ret))) - ::amp (when-let [p1 (deriv p1 x)] - (if (= ::accept (::op p1)) - (let [ret (-> (preturn p1) (and-preds ps (next forms)))] - (when-not (invalid? ret) - (accept ret))) - (amp-impl p1 ps forms))) - ::pcat (alt2 (pcat* {:ps (cons (deriv p0 x) pr), :ks ks, :forms forms, :ret ret}) - (when (accept-nil? p0) (deriv (pcat* {:ps pr, :ks kr, :forms (next forms), :ret (add-ret p0 ret k0)}) x))) - ::alt (alt* (map #(deriv % x) ps) ks forms) - ::rep (alt2 (rep* (deriv p1 x) p2 ret splice forms) - (when (accept-nil? p1) (deriv (rep* p2 p2 (add-ret p1 ret nil) splice forms) x))))))) - -(defn- op-describe [p] - (let [{:keys [::op ps ks forms splice p1 rep+ maybe] :as p} (reg-resolve! p)] - ;;(prn {:op op :ks ks :forms forms :p p}) - (when p - (case op - ::accept nil - nil p - ::amp (list* 'clojure.spec/& (op-describe p1) forms) - ::pcat (if rep+ - (list `+ rep+) - (cons `cat (mapcat vector (c/or (seq ks) (repeat :_)) forms))) - ::alt (if maybe - (list `? (res maybe)) - (cons `alt (mapcat vector ks forms))) - ::rep (list (if splice `+ `*) forms))))) - -(defn- op-explain [form p path via in input] - ;;(prn {:form form :p p :path path :input input}) - (let [[x :as input] input - {:keys [::op ps ks forms splice p1 p2] :as p} (reg-resolve! p) - via (if-let [name (spec-name p)] (conj via name) via) - insufficient (fn [path form] - [{:path path - :reason "Insufficient input" - :pred (abbrev form) - :val () - :via via - :in in}])] - (when p - (case op - ::accept nil - nil (if (empty? input) - (insufficient path form) - (explain-1 form p path via in x)) - ::amp (if (empty? input) - (if (accept-nil? p1) - (explain-pred-list forms ps path via in (preturn p1)) - (insufficient path (op-describe p1))) - (if-let [p1 (deriv p1 x)] - (explain-pred-list forms ps path via in (preturn p1)) - (op-explain (op-describe p1) p1 path via in input))) - ::pcat (let [pkfs (map vector - ps - (c/or (seq ks) (repeat nil)) - (c/or (seq forms) (repeat nil))) - [pred k form] (if (= 1 (count pkfs)) - (first pkfs) - (first (remove (fn [[p]] (accept-nil? p)) pkfs))) - path (if k (conj path k) path) - form (c/or form (op-describe pred))] - (if (c/and (empty? input) (not pred)) - (insufficient path form) - (op-explain form pred path via in input))) - ::alt (if (empty? input) - (insufficient path (op-describe p)) - (apply concat - (map (fn [k form pred] - (op-explain (c/or form (op-describe pred)) - pred - (if k (conj path k) path) - via - in - input)) - (c/or (seq ks) (repeat nil)) - (c/or (seq forms) (repeat nil)) - ps))) - ::rep (op-explain (if (identical? p1 p2) - forms - (op-describe p1)) - p1 path via in input))))) - -(defn- re-gen [p overrides path rmap f] - ;;(prn {:op op :ks ks :forms forms}) - (let [origp p - {:keys [::op ps ks p1 p2 forms splice ret id ::gfn] :as p} (reg-resolve! p) - rmap (if id (inck rmap id) rmap) - ggens (fn [ps ks forms] - (let [gen (fn [p k f] - ;;(prn {:k k :path path :rmap rmap :op op :id id}) - (when-not (c/and rmap id k (recur-limit? rmap id path k)) - (if id - (gen/delay (re-gen p overrides (if k (conj path k) path) rmap (c/or f p))) - (re-gen p overrides (if k (conj path k) path) rmap (c/or f p)))))] - (map gen ps (c/or (seq ks) (repeat nil)) (c/or (seq forms) (repeat nil)))))] - (c/or (when-let [gfn (c/or (get overrides (spec-name origp)) - (get overrides (spec-name p) ) - (get overrides path))] - (case op - (:accept nil) (gen/fmap vector (gfn)) - (gfn))) - (when gfn - (gfn)) - (when p - (case op - ::accept (if (= ret ::nil) - (gen/return []) - (gen/return [ret])) - nil (when-let [g (gensub p overrides path rmap f)] - (gen/fmap vector g)) - ::amp (re-gen p1 overrides path rmap (op-describe p1)) - ::pcat (let [gens (ggens ps ks forms)] - (when (every? identity gens) - (apply gen/cat gens))) - ::alt (let [gens (remove nil? (ggens ps ks forms))] - (when-not (empty? gens) - (gen/one-of gens))) - ::rep (if (recur-limit? rmap id [id] id) - (gen/return []) - (when-let [g (re-gen p2 overrides path rmap forms)] - (gen/fmap #(apply concat %) - (gen/vector g))))))))) - -(defn- re-conform [p [x & xs :as data]] - ;;(prn {:p p :x x :xs xs}) - (if (empty? data) - (if (accept-nil? p) - (let [ret (preturn p)] - (if (= ret ::nil) - nil - ret)) - ::invalid) - (if-let [dp (deriv p x)] - (recur dp xs) - ::invalid))) - -(defn- re-explain [path via in re input] - (loop [p re [x & xs :as data] input i 0] - ;;(prn {:p p :x x :xs xs :re re}) (prn) - (if (empty? data) - (if (accept-nil? p) - nil ;;success - (op-explain (op-describe p) p path via in nil)) - (if-let [dp (deriv p x)] - (recur dp xs (inc i)) - (if (accept? p) - (if (= (::op p) ::pcat) - (op-explain (op-describe p) p path via (conj in i) (seq data)) - [{:path path - :reason "Extra input" - :pred (abbrev (op-describe re)) - :val data - :via via - :in (conj in i)}]) - (c/or (op-explain (op-describe p) p path via (conj in i) (seq data)) - [{:path path - :reason "Extra input" - :pred (abbrev (op-describe p)) - :val data - :via via - :in (conj in i)}])))))) - -(defn ^:skip-wiki regex-spec-impl - "Do not call this directly, use 'spec' with a regex op argument" - [re gfn] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] - (if (c/or (nil? x) (coll? x)) - (re-conform re (seq x)) - ::invalid)) - (unform* [_ x] (op-unform re x)) - (explain* [_ path via in x] - (if (c/or (nil? x) (coll? x)) - (re-explain path via in re (seq x)) - [{:path path :pred (abbrev (op-describe re)) :val x :via via :in in}])) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (re-gen re overrides path rmap (op-describe re)))) - (with-gen* [_ gfn] (regex-spec-impl re gfn)) - (describe* [_] (op-describe re)))) - -;;;;;;;;;;;;;;;;; HOFs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- call-valid? - [f specs args] - (let [cargs (conform (:args specs) args)] - (when-not (invalid? cargs) - (let [ret (apply f args) - cret (conform (:ret specs) ret)] - (c/and (not (invalid? cret)) - (if (:fn specs) - (pvalid? (:fn specs) {:args cargs :ret cret}) - true)))))) - -(defn- validate-fn - "returns f if valid, else smallest" - [f specs iters] - (let [g (gen (:args specs)) - prop (gen/for-all* [g] #(call-valid? f specs %))] - (let [ret (gen/quick-check iters prop)] - (if-let [[smallest] (-> ret :shrunk :smallest)] - smallest - f)))) - -(defn ^:skip-wiki fspec-impl - "Do not call this directly, use 'fspec'" - [argspec aform retspec rform fnspec fform gfn] - (let [specs {:args argspec :ret retspec :fn fnspec}] - (reify - clojure.lang.ILookup - (valAt [this k] (get specs k)) - (valAt [_ k not-found] (get specs k not-found)) - - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [this f] (if argspec - (if (ifn? f) - (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid) - ::invalid) - (throw (Exception. (str "Can't conform fspec without args spec: " (pr-str (describe this))))))) - (unform* [_ f] f) - (explain* [_ path via in f] - (if (ifn? f) - (let [args (validate-fn f specs 100)] - (if (identical? f args) ;;hrm, we might not be able to reproduce - nil - (let [ret (try (apply f args) (catch Throwable t t))] - (if (instance? Throwable ret) - ;;TODO add exception data - [{:path path :pred '(apply fn) :val args :reason (.getMessage ^Throwable ret) :via via :in in}] - - (let [cret (dt retspec ret rform)] - (if (invalid? cret) - (explain-1 rform retspec (conj path :ret) via in ret) - (when fnspec - (let [cargs (conform argspec args)] - (explain-1 fform fnspec (conj path :fn) via in {:args cargs :ret cret}))))))))) - [{:path path :pred 'ifn? :val f :via via :in in}])) - (gen* [_ overrides _ _] (if gfn - (gfn) - (gen/return - (fn [& args] - (c/assert (pvalid? argspec args) (with-out-str (explain argspec args))) - (gen/generate (gen retspec overrides)))))) - (with-gen* [_ gfn] (fspec-impl argspec aform retspec rform fnspec fform gfn)) - (describe* [_] `(fspec :args ~aform :ret ~rform :fn ~fform))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; non-primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(clojure.spec/def ::kvs->map (conformer #(zipmap (map ::k %) (map ::v %)) #(map (fn [[k v]] {::k k ::v v}) %))) - -(defmacro keys* - "takes the same arguments as spec/keys and returns a regex op that matches sequences of key/values, - converts them into a map, and conforms that map with a corresponding - spec/keys call: - - user=> (s/conform (s/keys :req-un [::a ::c]) {:a 1 :c 2}) - {:a 1, :c 2} - user=> (s/conform (s/keys* :req-un [::a ::c]) [:a 1 :c 2]) - {:a 1, :c 2} - - the resulting regex op can be composed into a larger regex: - - user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99]) - {:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}" - [& kspecs] - `(let [mspec# (keys ~@kspecs)] - (with-gen (clojure.spec/& (* (cat ::k keyword? ::v any?)) ::kvs->map mspec#) - (fn [] (gen/fmap (fn [m#] (apply concat m#)) (gen mspec#)))))) - -(defn ^:skip-wiki nonconforming - "takes a spec and returns a spec that has the same properties except - 'conform' returns the original (not the conformed) value. Note, will specize regex ops." - [spec] - (let [spec (delay (specize spec))] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (let [ret (conform* @spec x)] - (if (invalid? ret) - ::invalid - x))) - (unform* [_ x] x) - (explain* [_ path via in x] (explain* @spec path via in x)) - (gen* [_ overrides path rmap] (gen* @spec overrides path rmap)) - (with-gen* [_ gfn] (nonconforming (with-gen* @spec gfn))) - (describe* [_] `(nonconforming ~(describe* @spec)))))) - -(defn ^:skip-wiki nilable-impl - "Do not call this directly, use 'nilable'" - [form pred gfn] - (let [spec (delay (specize pred form))] - (reify - Specize - (specize* [s] s) - (specize* [s _] s) - - Spec - (conform* [_ x] (if (nil? x) nil (conform* @spec x))) - (unform* [_ x] (if (nil? x) nil (unform* @spec x))) - (explain* [_ path via in x] - (when-not (c/or (pvalid? @spec x) (nil? x)) - (conj - (explain-1 form pred (conj path ::pred) via in x) - {:path (conj path ::nil) :pred 'nil? :val x :via via :in in}))) - (gen* [_ overrides path rmap] - (if gfn - (gfn) - (gen/frequency - [[1 (gen/delay (gen/return nil))] - [9 (gen/delay (gensub pred overrides (conj path ::pred) rmap form))]]))) - (with-gen* [_ gfn] (nilable-impl form pred gfn)) - (describe* [_] `(nilable ~(res form)))))) - -(defmacro nilable - "returns a spec that accepts nil and values satisfying pred" - [pred] - (let [pf (res pred)] - `(nilable-impl '~pf ~pred nil))) - -(defn exercise - "generates a number (default 10) of values compatible with spec and maps conform over them, - returning a sequence of [val conformed-val] tuples. Optionally takes - a generator overrides map as per gen" - ([spec] (exercise spec 10)) - ([spec n] (exercise spec n nil)) - ([spec n overrides] - (map #(vector % (conform spec %)) (gen/sample (gen spec overrides) n)))) - -(defn exercise-fn - "exercises the fn named by sym (a symbol) by applying it to - n (default 10) generated samples of its args spec. When fspec is - supplied its arg spec is used, and sym-or-f can be a fn. Returns a - sequence of tuples of [args ret]. " - ([sym] (exercise-fn sym 10)) - ([sym n] (exercise-fn sym n (get-spec sym))) - ([sym-or-f n fspec] - (let [f (if (symbol? sym-or-f) (resolve sym-or-f) sym-or-f)] - (for [args (gen/sample (gen (:args fspec)) n)] - [args (apply f args)])))) - -(defn inst-in-range? - "Return true if inst at or after start and before end" - [start end inst] - (c/and (inst? inst) - (let [t (inst-ms inst)] - (c/and (<= (inst-ms start) t) (< t (inst-ms end)))))) - -(defmacro inst-in - "Returns a spec that validates insts in the range from start -(inclusive) to end (exclusive)." - [start end] - `(let [st# (inst-ms ~start) - et# (inst-ms ~end) - mkdate# (fn [d#] (java.util.Date. ^{:tag ~'long} d#))] - (spec (and inst? #(inst-in-range? ~start ~end %)) - :gen (fn [] - (gen/fmap mkdate# - (gen/large-integer* {:min st# :max et#})))))) - -(defn int-in-range? - "Return true if start <= val and val < end" - [start end val] - (c/and int? (<= start val) (< val end))) - -(defmacro int-in - "Returns a spec that validates ints in the range from start -(inclusive) to end (exclusive)." - [start end] - `(spec (and int? #(int-in-range? ~start ~end %)) - :gen #(gen/large-integer* {:min ~start :max (dec ~end)}))) - -(defmacro double-in - "Specs a 64-bit floating point number. Options: - - :infinite? - whether +/- infinity allowed (default true) - :NaN? - whether NaN allowed (default true) - :min - minimum value (inclusive, default none) - :max - maximum value (inclusive, default none)" - [& {:keys [infinite? NaN? min max] - :or {infinite? true NaN? true} - :as m}] - `(spec (and c/double? - ~@(when-not infinite? '[#(not (Double/isInfinite %))]) - ~@(when-not NaN? '[#(not (Double/isNaN %))]) - ~@(when max `[#(<= % ~max)]) - ~@(when min `[#(<= ~min %)])) - :gen #(gen/double* ~m))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; assert ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defonce - ^{:dynamic true - :doc "If true, compiler will enable spec asserts, which are then -subject to runtime control via check-asserts? If false, compiler -will eliminate all spec assert overhead. See 'assert'. - -Initially set to boolean value of clojure.spec.compile-asserts -system property. Defaults to true."} - *compile-asserts* - (not= "false" (System/getProperty "clojure.spec.compile-asserts"))) - -(defn check-asserts? - "Returns the value set by check-asserts." - [] - clojure.lang.RT/checkSpecAsserts) - -(defn check-asserts - "Enable or disable spec asserts that have been compiled -with '*compile-asserts*' true. See 'assert'. - -Initially set to boolean value of clojure.spec.check-asserts -system property. Defaults to false." - [flag] - (set! (. clojure.lang.RT checkSpecAsserts) flag)) - -(defn assert* - "Do not call this directly, use 'assert'." - [spec x] - (if (valid? spec x) - x - (let [ed (c/merge (assoc (explain-data* spec [] [] [] x) - ::failure :assertion-failed))] - (throw (ex-info - (str "Spec assertion failed\n" (with-out-str (explain-out ed))) - ed))))) - -(defmacro assert - "spec-checking assert expression. Returns x if x is valid? according -to spec, else throws an ex-info with explain-data plus ::failure of -:assertion-failed. - -Can be disabled at either compile time or runtime: - -If *compile-asserts* is false at compile time, compiles to x. Defaults -to value of 'clojure.spec.compile-asserts' system property, or true if -not set. - -If (check-asserts?) is false at runtime, always returns x. Defaults to -value of 'clojure.spec.check-asserts' system property, or false if not -set. You can toggle check-asserts? with (check-asserts bool)." - [spec x] - (if *compile-asserts* - `(if clojure.lang.RT/checkSpecAsserts - (assert* ~spec ~x) - ~x) - x)) - - diff -Nru clojure-1.9.0~alpha15/src/clj/clojure/string.clj clojure-1.9.0/src/clj/clojure/string.clj --- clojure-1.9.0~alpha15/src/clj/clojure/string.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/clj/clojure/string.clj 2017-12-08 13:59:39.000000000 +0000 @@ -317,7 +317,7 @@ (defn index-of "Return index of value (string or char) in s, optionally searching - forward from from-index or nil if not found." + forward from from-index. Return nil if value not found." {:added "1.8"} ([^CharSequence s value] (let [result ^long @@ -338,7 +338,7 @@ (defn last-index-of "Return last index of value (string or char) in s, optionally - searching backward from from-index or nil if not found." + searching backward from from-index. Return nil if value not found." {:added "1.8"} ([^CharSequence s value] (let [result ^long diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/APersistentMap.java clojure-1.9.0/src/jvm/clojure/lang/APersistentMap.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/APersistentMap.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/APersistentMap.java 2017-12-08 13:59:39.000000000 +0000 @@ -14,8 +14,8 @@ import java.util.*; public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable, MapEquivalence, IHashEq { -int _hash = -1; -int _hasheq = -1; +int _hash; +int _hasheq; public String toString(){ return RT.printString(this); @@ -93,11 +93,12 @@ return true; } public int hashCode(){ - if(_hash == -1) + int cached = this._hash; + if(cached == 0) { - this._hash = mapHash(this); + this._hash = cached = mapHash(this); } - return _hash; + return cached; } static public int mapHash(IPersistentMap m){ @@ -112,12 +113,13 @@ } public int hasheq(){ - if(_hasheq == -1) + int cached = this._hasheq; + if(cached == 0) { //this._hasheq = mapHasheq(this); - _hasheq = Murmur3.hashUnordered(this); + this._hasheq = cached = Murmur3.hashUnordered(this); } - return _hasheq; + return cached; } static public int mapHasheq(IPersistentMap m) { diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/APersistentSet.java clojure-1.9.0/src/jvm/clojure/lang/APersistentSet.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/APersistentSet.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/APersistentSet.java 2017-12-08 13:59:39.000000000 +0000 @@ -18,8 +18,8 @@ import java.util.Set; public abstract class APersistentSet extends AFn implements IPersistentSet, Collection, Set, Serializable, IHashEq { -int _hash = -1; -int _hasheq = -1; +int _hash; +int _hasheq; final IPersistentMap impl; protected APersistentSet(IPersistentMap impl){ @@ -91,10 +91,10 @@ } public int hashCode(){ - if(_hash == -1) + int hash = this._hash; + if(hash == 0) { //int hash = count(); - int hash = 0; for(ISeq s = seq(); s != null; s = s.next()) { Object e = s.first(); @@ -103,11 +103,12 @@ } this._hash = hash; } - return _hash; + return hash; } public int hasheq(){ - if(_hasheq == -1){ + int cached = this._hasheq; + if(cached == 0){ // int hash = 0; // for(ISeq s = seq(); s != null; s = s.next()) // { @@ -115,9 +116,9 @@ // hash += Util.hasheq(e); // } // this._hasheq = hash; - _hasheq = Murmur3.hashUnordered(this); + this._hasheq = cached = Murmur3.hashUnordered(this); } - return _hasheq; + return cached; } public Object[] toArray(){ diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/APersistentVector.java clojure-1.9.0/src/jvm/clojure/lang/APersistentVector.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/APersistentVector.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/APersistentVector.java 2017-12-08 13:59:39.000000000 +0000 @@ -19,8 +19,8 @@ List, RandomAccess, Comparable, Serializable, IHashEq { -int _hash = -1; -int _hasheq = -1; +int _hash; +int _hasheq; public String toString(){ return RT.printString(this); @@ -139,9 +139,10 @@ } public int hashCode(){ - if(_hash == -1) + int hash = this._hash; + if(hash == 0) { - int hash = 1; + hash = 1; for(int i = 0;i 0) @@ -637,6 +643,8 @@ final static Method getMethod = Method.getMethod("Object get()"); final static Method setMethod = Method.getMethod("Object set(Object)"); + Class jc; + public VarExpr(Var var, Symbol tag){ this.var = var; this.tag = tag != null ? tag : var.getTag(); @@ -659,7 +667,9 @@ } public Class getJavaClass() { - return HostExpr.tagToClass(tag); + if (jc == null) + jc = HostExpr.tagToClass(tag); + return jc; } public Object evalAssign(Expr val) { @@ -1005,12 +1015,13 @@ Symbol sym = (Symbol) RT.first(call); Symbol tag = tagOf(form); PersistentVector args = PersistentVector.EMPTY; + boolean tailPosition = inTailCall(context); for(ISeq s = RT.next(call); s != null; s = s.next()) args = args.cons(analyze(context == C.EVAL ? context : C.EXPRESSION, s.first())); if(c != null) - return new StaticMethodExpr(source, line, column, tag, c, munge(sym.name), args); + return new StaticMethodExpr(source, line, column, tag, c, munge(sym.name), args, tailPosition); else - return new InstanceMethodExpr(source, line, column, tag, instance, munge(sym.name), args); + return new InstanceMethodExpr(source, line, column, tag, instance, munge(sym.name), args, tailPosition); } } } @@ -1027,7 +1038,7 @@ if(Util.equals(sym,COMPILE_STUB_SYM.get())) return (Class) COMPILE_STUB_CLASS.get(); if(sym.name.indexOf('.') > 0 || sym.name.charAt(0) == '[') - c = RT.classForName(sym.name); + c = RT.classForNameNonLoading(sym.name); else { Object o = currentNS().getMapping(sym); @@ -1038,7 +1049,7 @@ else { try{ - c = RT.classForName(sym.name); + c = RT.classForNameNonLoading(sym.name); } catch(Exception e){ // aargh @@ -1049,7 +1060,7 @@ } } else if(stringOk && form instanceof String) - c = RT.classForName((String) form); + c = RT.classForNameNonLoading((String) form); return c; } @@ -1134,6 +1145,7 @@ final static Method invokeNoArgInstanceMember = Method.getMethod("Object invokeNoArgInstanceMember(Object,String,boolean)"); final static Method setInstanceFieldMethod = Method.getMethod("Object setInstanceField(Object,String,Object)"); + Class jc; public InstanceFieldExpr(int line, int column, Expr target, String fieldName, Symbol tag, boolean requireField) { this.target = target; @@ -1213,7 +1225,9 @@ } public Class getJavaClass() { - return tag != null ? HostExpr.tagToClass(tag) : field.getType(); + if (jc == null) + jc = tag != null ? HostExpr.tagToClass(tag) : field.getType(); + return jc; } public Object evalAssign(Expr val) { @@ -1256,6 +1270,8 @@ final int line; final int column; + Class jc; + public StaticFieldExpr(int line, int column, Class c, String fieldName, Symbol tag) { //this.className = className; this.fieldName = fieldName; @@ -1309,7 +1325,9 @@ public Class getJavaClass() { //Class c = Class.forName(className); //java.lang.reflect.Field field = c.getField(fieldName); - return tag != null ? HostExpr.tagToClass(tag) : field.getType(); + if (jc == null) + jc =tag != null ? HostExpr.tagToClass(tag) : field.getType(); + return jc; } public Object evalAssign(Expr val) { @@ -1440,13 +1458,16 @@ public final int line; public final int column; public final Symbol tag; + public final boolean tailPosition; public final java.lang.reflect.Method method; + Class jc; final static Method invokeInstanceMethodMethod = Method.getMethod("Object invokeInstanceMethod(Object,String,Object[])"); - public InstanceMethodExpr(String source, int line, int column, Symbol tag, Expr target, String methodName, IPersistentVector args) + public InstanceMethodExpr(String source, int line, int column, Symbol tag, Expr target, + String methodName, IPersistentVector args, boolean tailPosition) { this.source = source; this.line = line; @@ -1455,6 +1476,7 @@ this.methodName = methodName; this.target = target; this.tag = tag; + this.tailPosition = tailPosition; if(target.hasJavaClass() && target.getJavaClass() != null) { List methods = Reflector.getMethods(target.getJavaClass(), args.count(), methodName, false); @@ -1548,10 +1570,10 @@ gen.checkCast(type); MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); gen.visitLineNumber(line, gen.mark()); - if(context == C.RETURN) + if(tailPosition && !objx.canBeDirect) { ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); + method.emitClearThis(gen); } Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); if(method.getDeclaringClass().isInterface()) @@ -1607,7 +1629,9 @@ } public Class getJavaClass() { - return retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null); + if (jc == null) + jc = retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null); + return jc; } } @@ -1622,12 +1646,15 @@ public final int column; public final java.lang.reflect.Method method; public final Symbol tag; + public final boolean tailPosition; final static Method forNameMethod = Method.getMethod("Class classForName(String)"); final static Method invokeStaticMethodMethod = Method.getMethod("Object invokeStaticMethod(Class,String,Object[])"); final static Keyword warnOnBoxedKeyword = Keyword.intern("warn-on-boxed"); + Class jc; - public StaticMethodExpr(String source, int line, int column, Symbol tag, Class c, String methodName, IPersistentVector args) + public StaticMethodExpr(String source, int line, int column, Symbol tag, Class c, + String methodName, IPersistentVector args, boolean tailPosition) { this.c = c; this.methodName = methodName; @@ -1636,6 +1663,7 @@ this.line = line; this.column = column; this.tag = tag; + this.tailPosition = tailPosition; List methods = Reflector.getMethods(c, args.count(), methodName, true); if(methods.isEmpty()) @@ -1774,10 +1802,10 @@ MethodExpr.emitTypedArgs(objx, gen, method.getParameterTypes(), args); gen.visitLineNumber(line, gen.mark()); //Type type = Type.getObjectType(className.replace('.', '/')); - if(context == C.RETURN) + if(tailPosition && !objx.canBeDirect) { ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); + method.emitClearThis(gen); } Type type = Type.getType(c); Method m = new Method(methodName, Type.getReturnType(method), Type.getArgumentTypes(method)); @@ -1820,7 +1848,9 @@ } public Class getJavaClass() { - return retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null); + if (jc == null) + jc = retType((tag!=null)?HostExpr.tagToClass(tag):null, (method!=null)?method.getReturnType():null); + return jc; } } @@ -2271,13 +2301,14 @@ } else { - if(bodyExpr == null) - try { - Var.pushThreadBindings(RT.map(NO_RECUR, true)); - bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body)); - } finally { - Var.popThreadBindings(); - } + if(bodyExpr == null) + try { + Var.pushThreadBindings(RT.map(NO_RECUR, true, METHOD_RETURN_CONTEXT, null)); + bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body)); + } finally { + Var.popThreadBindings(); + } + if(Util.equals(op, CATCH)) { Class c = HostExpr.maybeClass(RT.second(f), false); @@ -2325,17 +2356,21 @@ } } } - if(bodyExpr == null) { - try - { - Var.pushThreadBindings(RT.map(NO_RECUR, true)); - bodyExpr = (new BodyExpr.Parser()).parse(C.EXPRESSION, RT.seq(body)); - } - finally - { - Var.popThreadBindings(); - } - } + if(bodyExpr == null) + { + // this codepath is hit when there is neither catch or finally, e.g. (try (expr)) + // return a body expr directly + try + { + Var.pushThreadBindings(RT.map(NO_RECUR, true)); + bodyExpr = (new BodyExpr.Parser()).parse(context, RT.seq(body)); + } + finally + { + Var.popThreadBindings(); + } + return bodyExpr; + } return new TryExpr(bodyExpr, catches, finallyExpr, retLocal, finallyLocal); @@ -2587,11 +2622,6 @@ gen.newInstance(type); gen.dup(); MethodExpr.emitTypedArgs(objx, gen, ctor.getParameterTypes(), args); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } gen.invokeConstructor(type, new Method("", Type.getConstructorDescriptor(ctor))); } else @@ -2599,11 +2629,6 @@ gen.push(destubClassName(c.getName())); gen.invokeStatic(RT_TYPE, forNameMethod); MethodExpr.emitArgsAsArray(args, objx, gen); - if(context == C.RETURN) - { - ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); - } gen.invokeStatic(REFLECTOR_TYPE, invokeConstructorMethod); } if(context == C.STATEMENT) @@ -3260,6 +3285,7 @@ public final int siteIndex; public final String source; static Type ILOOKUP_TYPE = Type.getType(ILookup.class); + Class jc; public KeywordInvokeExpr(String source, int line, int column, Symbol tag, KeywordExpr kw, Expr target){ this.source = source; @@ -3324,7 +3350,9 @@ } public Class getJavaClass() { - return HostExpr.tagToClass(tag); + if(jc == null) + jc = HostExpr.tagToClass(tag); + return jc; } } @@ -3431,16 +3459,19 @@ public final Type[] paramtypes; public final IPersistentVector args; public final boolean variadic; + public final boolean tailPosition; public final Object tag; + Class jc; StaticInvokeExpr(Type target, Class retClass, Class[] paramclasses, Type[] paramtypes, boolean variadic, - IPersistentVector args,Object tag){ + IPersistentVector args,Object tag, boolean tailPosition){ this.target = target; this.retClass = retClass; this.paramclasses = paramclasses; this.paramtypes = paramtypes; this.args = args; this.variadic = variadic; + this.tailPosition = tailPosition; this.tag = tag; } @@ -3466,7 +3497,9 @@ } public Class getJavaClass() { - return retType((tag!=null)?HostExpr.tagToClass(tag):null, retClass); + if(jc == null) + jc =retType((tag!=null)?HostExpr.tagToClass(tag):null, retClass); + return jc; } public boolean canEmitPrimitive(){ @@ -3497,6 +3530,12 @@ else MethodExpr.emitTypedArgs(objx, gen, paramclasses, args); + if(tailPosition && !objx.canBeDirect) + { + ObjMethod method = (ObjMethod) METHOD.deref(); + method.emitClearThis(gen); + } + gen.invokeStatic(target, ms); } @@ -3504,7 +3543,7 @@ return Type.getType(retClass); } - public static Expr parse(Var v, ISeq args, Object tag) { + public static Expr parse(Var v, ISeq args, Object tag, boolean tailPosition) { if(!v.isBound() || v.get() == null) { // System.out.println("Not bound: " + v); @@ -3560,7 +3599,7 @@ for(ISeq s = RT.seq(args); s != null; s = s.next()) argv = argv.cons(analyze(C.EXPRESSION, s.first())); - return new StaticInvokeExpr(target,retClass,paramClasses, paramTypes,variadic, argv, tag); + return new StaticInvokeExpr(target,retClass,paramClasses, paramTypes,variadic, argv, tag, tailPosition); } } @@ -3571,6 +3610,7 @@ public final IPersistentVector args; public final int line; public final int column; + public final boolean tailPosition; public final String source; public boolean isProtocol = false; public boolean isDirect = false; @@ -3579,6 +3619,7 @@ public java.lang.reflect.Method onMethod; static Keyword onKey = Keyword.intern("on"); static Keyword methodMapKey = Keyword.intern("method-map"); + Class jc; static Object sigTag(int argcount, Var v){ Object arglists = RT.get(RT.meta(v), arglistsKey); @@ -3593,12 +3634,14 @@ return null; } - public InvokeExpr(String source, int line, int column, Symbol tag, Expr fexpr, IPersistentVector args) { + public InvokeExpr(String source, int line, int column, Symbol tag, Expr fexpr, IPersistentVector args, boolean tailPosition) { this.source = source; this.fexpr = fexpr; this.args = args; this.line = line; this.column = column; + this.tailPosition = tailPosition; + if(fexpr instanceof VarExpr) { Var fvar = ((VarExpr)fexpr).var; @@ -3743,10 +3786,10 @@ } gen.visitLineNumber(line, gen.mark()); - if(context == C.RETURN) + if(tailPosition && !objx.canBeDirect) { ObjMethod method = (ObjMethod) METHOD.deref(); - method.emitClearLocals(gen); + method.emitClearThis(gen); } gen.invokeInterface(IFN_TYPE, new Method("invoke", OBJECT_TYPE, ARG_TYPES[Math.min(MAX_POSITIONAL_ARITY + 1, @@ -3758,10 +3801,13 @@ } public Class getJavaClass() { - return HostExpr.tagToClass(tag); + if (jc == null) + jc = HostExpr.tagToClass(tag); + return jc; } static public Expr parse(C context, ISeq form) { + boolean tailPosition = inTailCall(context); if(context != C.EVAL) context = C.EXPRESSION; Expr fexpr = analyze(context, form.first()); @@ -3791,7 +3837,7 @@ Object sigtag = sigTag(arity, v); Object vtag = RT.get(RT.meta(v), RT.TAG_KEY); Expr ret = StaticInvokeExpr - .parse(v, RT.next(form), formtag != null ? formtag : sigtag != null ? sigtag : vtag); + .parse(v, RT.next(form), formtag != null ? formtag : sigtag != null ? sigtag : vtag, tailPosition); if(ret != null) { // System.out.println("invoke direct: " + v); @@ -3838,7 +3884,7 @@ // throw new IllegalArgumentException( // String.format("No more than %d args supported", MAX_POSITIONAL_ARITY)); - return new InvokeExpr((String) SOURCE.deref(), lineDeref(), columnDeref(), tagOf(form), fexpr, args); + return new InvokeExpr((String) SOURCE.deref(), lineDeref(), columnDeref(), tagOf(form), fexpr, args, tailPosition); } } @@ -3863,6 +3909,7 @@ private boolean hasMeta; private boolean hasEnclosingMethod; // String superName = null; + Class jc; public FnExpr(Object tag){ super(tag); @@ -3877,7 +3924,9 @@ } public Class getJavaClass() { - return tag != null ? HostExpr.tagToClass(tag) : AFunction.class; + if (jc == null) + jc = tag != null ? HostExpr.tagToClass(tag) : AFunction.class; + return jc; } protected void emitMethods(ClassVisitor cv){ @@ -5005,10 +5054,13 @@ return true; } + Class jc; public Class getJavaClass() { - return (compiledClass != null) ? compiledClass - : (tag != null) ? HostExpr.tagToClass(tag) - : IFn.class; + if (jc == null) + jc = (compiledClass != null) ? compiledClass + : (tag != null) ? HostExpr.tagToClass(tag) + : IFn.class; + return jc; } public void emitAssignLocal(GeneratorAdapter gen, LocalBinding lb,Expr val){ @@ -5296,6 +5348,7 @@ ,CLEAR_PATH, pnode ,CLEAR_ROOT, pnode ,CLEAR_SITES, PersistentHashMap.EMPTY + ,METHOD_RETURN_CONTEXT, RT.T )); method.prim = primInterface(parms); @@ -5873,6 +5926,11 @@ } } } + + void emitClearThis(GeneratorAdapter gen) { + gen.visitInsn(Opcodes.ACONST_NULL); + gen.visitVarInsn(Opcodes.ASTORE, 0); + } } public static class LocalBinding{ @@ -5900,18 +5958,25 @@ name = munge(sym.name); } + Boolean hjc; + public boolean hasJavaClass() { - if(init != null && init.hasJavaClass() - && Util.isPrimitive(init.getJavaClass()) - && !(init instanceof MaybePrimitiveExpr)) - return false; - return tag != null - || (init != null && init.hasJavaClass()); - } + if (hjc == null) + { + if(init != null && init.hasJavaClass() && Util.isPrimitive(init.getJavaClass()) && !(init instanceof MaybePrimitiveExpr)) + hjc = false; + else + hjc = tag != null || (init != null && init.hasJavaClass()); + } + return hjc; + } + + Class jc; public Class getJavaClass() { - return tag != null ? HostExpr.tagToClass(tag) - : init.getJavaClass(); + if (jc == null) + jc = tag != null ? HostExpr.tagToClass(tag) : init.getJavaClass(); + return jc; } public Class getPrimitiveType(){ @@ -5999,10 +6064,15 @@ return tag != null || b.hasJavaClass(); } + Class jc; public Class getJavaClass() { - if(tag != null) - return HostExpr.tagToClass(tag); - return b.getJavaClass(); + if (jc == null) { + if(tag != null) + jc = HostExpr.tagToClass(tag); + else + jc = b.getJavaClass(); + } + return jc; } @@ -6300,14 +6370,14 @@ { if(recurMismatches != null && RT.booleanCast(recurMismatches.nth(i/2))) { - init = new StaticMethodExpr("", 0, 0, null, RT.class, "box", RT.vector(init)); + init = new StaticMethodExpr("", 0, 0, null, RT.class, "box", RT.vector(init), false); if(RT.booleanCast(RT.WARN_ON_REFLECTION.deref())) RT.errPrintWriter().println("Auto-boxing loop arg: " + sym); } else if(maybePrimitiveType(init) == int.class) - init = new StaticMethodExpr("", 0, 0, null, RT.class, "longCast", RT.vector(init)); + init = new StaticMethodExpr("", 0, 0, null, RT.class, "longCast", RT.vector(init), false); else if(maybePrimitiveType(init) == float.class) - init = new StaticMethodExpr("", 0, 0, null, RT.class, "doubleCast", RT.vector(init)); + init = new StaticMethodExpr("", 0, 0, null, RT.class, "doubleCast", RT.vector(init), false); } //sequential enhancement of env (like Lisp let*) try @@ -6339,10 +6409,12 @@ try { if(isLoop) { + Object methodReturnContext = context == C.RETURN ? METHOD_RETURN_CONTEXT.deref() : null; Var.pushThreadBindings( RT.map(CLEAR_PATH, clearpath, CLEAR_ROOT, clearroot, - NO_RECUR, null)); + NO_RECUR, null, + METHOD_RETURN_CONTEXT, methodReturnContext)); } bodyExpr = (new BodyExpr.Parser()).parse(isLoop ? C.RETURN : context, body); @@ -6792,6 +6864,35 @@ return dst; } +private static volatile Var MACRO_CHECK = null; +private static volatile boolean MACRO_CHECK_LOADING = false; +private static final Object MACRO_CHECK_LOCK = new Object(); + +private static Var ensureMacroCheck() throws ClassNotFoundException, IOException { + if(MACRO_CHECK == null) { + synchronized(MACRO_CHECK_LOCK) { + if(MACRO_CHECK == null) { + MACRO_CHECK_LOADING = true; + RT.load("clojure/spec/alpha"); + RT.load("clojure/core/specs/alpha"); + MACRO_CHECK = Var.find(Symbol.intern("clojure.spec.alpha", "macroexpand-check")); + MACRO_CHECK_LOADING = false; + } + } + } + return MACRO_CHECK; +} + +public static void checkSpecs(Var v, ISeq form) { + if(RT.CHECK_SPECS && !MACRO_CHECK_LOADING) { + try { + ensureMacroCheck().applyTo(RT.cons(v, RT.list(form.next()))); + } catch(Exception e) { + throw new CompilerException((String) SOURCE_PATH.deref(), lineDeref(), columnDeref(), e); + } + } +} + public static Object macroexpand1(Object x) { if(x instanceof ISeq) { @@ -6803,25 +6904,8 @@ Var v = isMacro(op); if(v != null) { - // Do not check specs while inside clojure.spec - if(! "clojure/spec.clj".equals(SOURCE_PATH.deref())) - { - try - { - final Namespace checkns = Namespace.find(Symbol.intern("clojure.spec")); - if (checkns != null) - { - final Var check = Var.find(Symbol.intern("clojure.spec/macroexpand-check")); - if ((check != null) && (check.isBound())) - check.applyTo(RT.cons(v, RT.list(form.next()))); - } - Symbol.intern("clojure.spec"); - } - catch(IllegalArgumentException e) - { - throw new CompilerException((String) SOURCE_PATH.deref(), lineDeref(), columnDeref(), e); - } - } + checkSpecs(v, form); + try { ISeq args = RT.cons(form, RT.cons(Compiler.LOCAL_ENV.get(), form.next())); @@ -8248,6 +8332,7 @@ ,CLEAR_PATH, pnode ,CLEAR_ROOT, pnode ,CLEAR_SITES, PersistentHashMap.EMPTY + ,METHOD_RETURN_CONTEXT, RT.T )); //register 'this' as local 0 diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/Delay.java clojure-1.9.0/src/jvm/clojure/lang/Delay.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/Delay.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/Delay.java 2017-12-08 13:59:39.000000000 +0000 @@ -13,9 +13,9 @@ package clojure.lang; public class Delay implements IDeref, IPending{ -Object val; -Throwable exception; -IFn fn; +volatile Object val; +volatile Throwable exception; +volatile IFn fn; public Delay(IFn fn){ this.fn = fn; @@ -29,18 +29,25 @@ : x; } -synchronized public Object deref() { +public Object deref() { if(fn != null) { - try - { - val = fn.invoke(); - } - catch(Throwable t) - { - exception = t; - } - fn = null; + synchronized(this) + { + //double check + if(fn!=null) + { + try + { + val = fn.invoke(); + } + catch(Throwable t) + { + exception = t; + } + fn = null; + } + } } if(exception != null) throw Util.sneakyThrow(exception); diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/EdnReader.java clojure-1.9.0/src/jvm/clojure/lang/EdnReader.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/EdnReader.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/EdnReader.java 2017-12-08 13:59:39.000000000 +0000 @@ -49,6 +49,7 @@ macros['#'] = new DispatchReader(); + dispatchMacros['#'] = new SymbolicValueReader(); dispatchMacros['^'] = new MetaReader(); //dispatchMacros['"'] = new RegexReader(); dispatchMacros['{'] = new SetReader(); @@ -505,35 +506,31 @@ throw Util.runtimeException("Namespaced map literal must contain an even number of forms"); // Construct output map - IPersistentMap m = RT.map(); + Object[] a = new Object[kvs.size()]; Iterator iter = kvs.iterator(); - while(iter.hasNext()) { + for(int i = 0; iter.hasNext(); i += 2) { Object key = iter.next(); Object val = iter.next(); if(key instanceof Keyword) { Keyword kw = (Keyword) key; if (kw.getNamespace() == null) { - m = m.assoc(Keyword.intern(ns, kw.getName()), val); + key = Keyword.intern(ns, kw.getName()); } else if (kw.getNamespace().equals("_")) { - m = m.assoc(Keyword.intern(null, kw.getName()), val); - } else { - m = m.assoc(kw, val); + key = Keyword.intern(null, kw.getName()); } } else if(key instanceof Symbol) { Symbol s = (Symbol) key; if (s.getNamespace() == null) { - m = m.assoc(Symbol.intern(ns, s.getName()), val); + key = Symbol.intern(ns, s.getName()); } else if (s.getNamespace().equals("_")) { - m = m.assoc(Symbol.intern(null, s.getName()), val); - } else { - m = m.assoc(s, val); + key = Symbol.intern(null, s.getName()); } - } else { - m = m.assoc(key, val); } + a[i] = key; + a[i+1] = val; } - return m; + return RT.map(a); } } @@ -709,6 +706,26 @@ } } + +public static class SymbolicValueReader extends AFn{ + + static IPersistentMap specials = PersistentHashMap.create(Symbol.intern("Inf"), Double.POSITIVE_INFINITY, + Symbol.intern("-Inf"), Double.NEGATIVE_INFINITY, + Symbol.intern("NaN"), Double.NaN); + + public Object invoke(Object reader, Object quote, Object opts) { + PushbackReader r = (PushbackReader) reader; + Object o = read(r, true, null, true, opts); + + if (!(o instanceof Symbol)) + throw Util.runtimeException("Invalid token: ##" + o); + if (!(specials.containsKey(o))) + throw Util.runtimeException("Unknown symbolic value: ##" + o); + + return specials.valAt(o); + } +} + public static List readDelimitedList(char delim, PushbackReader r, boolean isRecursive, Object opts) { final int firstline = (r instanceof LineNumberingPushbackReader) ? @@ -789,4 +806,3 @@ } } - diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/IAtom2.java clojure-1.9.0/src/jvm/clojure/lang/IAtom2.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/IAtom2.java 1970-01-01 00:00:00.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/IAtom2.java 2017-12-08 13:59:39.000000000 +0000 @@ -0,0 +1,23 @@ +/** + * Copyright (c) Rich Hickey. All rights reserved. + * The use and distribution terms for this software are covered by the + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) + * which can be found in the file epl-v10.html at the root of this distribution. + * By using this software in any fashion, you are agreeing to be bound by + * the terms of this license. + * You must not remove this notice, or any other, from this software. + **/ + +package clojure.lang; + +public interface IAtom2 extends IAtom { +IPersistentVector swapVals(IFn f); + +IPersistentVector swapVals(IFn f, Object arg); + +IPersistentVector swapVals(IFn f, Object arg1, Object arg2); + +IPersistentVector swapVals(IFn f, Object x, Object y, ISeq args); + +IPersistentVector resetVals(Object newv); +} diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/ITransientAssociative2.java clojure-1.9.0/src/jvm/clojure/lang/ITransientAssociative2.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/ITransientAssociative2.java 1970-01-01 00:00:00.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/ITransientAssociative2.java 2017-12-08 13:59:39.000000000 +0000 @@ -0,0 +1,16 @@ +/** + * Copyright (c) Rich Hickey. All rights reserved. + * The use and distribution terms for this software are covered by the + * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) + * which can be found in the file epl-v10.html at the root of this distribution. + * By using this software in any fashion, you are agreeing to be bound by + * the terms of this license. + * You must not remove this notice, or any other, from this software. + **/ + +package clojure.lang; + +public interface ITransientAssociative2 extends ITransientAssociative { + boolean containsKey(Object key); + IMapEntry entryAt(Object key); +} diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/LispReader.java clojure-1.9.0/src/jvm/clojure/lang/LispReader.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/LispReader.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/LispReader.java 2017-12-08 13:59:39.000000000 +0000 @@ -107,6 +107,7 @@ dispatchMacros['^'] = new MetaReader(); + dispatchMacros['#'] = new SymbolicValueReader(); dispatchMacros['\''] = new VarReader(); dispatchMacros['"'] = new RegexReader(); dispatchMacros['('] = new FnReader(); @@ -119,6 +120,13 @@ dispatchMacros[':'] = new NamespaceMapReader(); } +public static interface Resolver{ + Symbol currentNS(); + Symbol resolveClass(Symbol sym); + Symbol resolveAlias(Symbol sym); + Symbol resolveVar(Symbol sym); +} + static boolean isWhitespace(int ch){ return Character.isWhitespace(ch) || ch == ','; } @@ -195,11 +203,11 @@ static public Object read(PushbackReader r, boolean eofIsError, Object eofValue, boolean isRecursive, Object opts) { // start with pendingForms null as reader conditional splicing is not allowed at top level - return read(r, eofIsError, eofValue, null, null, isRecursive, opts, null); + return read(r, eofIsError, eofValue, null, null, isRecursive, opts, null, (Resolver) RT.READER_RESOLVER.deref()); } static private Object read(PushbackReader r, boolean eofIsError, Object eofValue, boolean isRecursive, Object opts, Object pendingForms) { - return read(r, eofIsError, eofValue, null, null, isRecursive, opts, ensurePending(pendingForms)); + return read(r, eofIsError, eofValue, null, null, isRecursive, opts, ensurePending(pendingForms), (Resolver) RT.READER_RESOLVER.deref()); } static private Object ensurePending(Object pendingForms) { @@ -222,7 +230,9 @@ } } -static private Object read(PushbackReader r, boolean eofIsError, Object eofValue, Character returnOn, Object returnOnValue, boolean isRecursive, Object opts, Object pendingForms) +static private Object read(PushbackReader r, boolean eofIsError, Object eofValue, Character returnOn, + Object returnOnValue, boolean isRecursive, Object opts, Object pendingForms, + Resolver resolver) { if(RT.READEVAL.deref() == UNKNOWN) throw Util.runtimeException("Reading disallowed - *read-eval* bound to :unknown"); @@ -282,7 +292,7 @@ } String token = readToken(r, (char) ch); - return interpretToken(token); + return interpretToken(token, resolver); } } catch(Exception e) @@ -370,7 +380,7 @@ return uc; } -static private Object interpretToken(String s) { +static private Object interpretToken(String s, Resolver resolver) { if(s.equals("nil")) { return null; @@ -385,7 +395,7 @@ } Object ret = null; - ret = matchSymbol(s); + ret = matchSymbol(s, resolver); if(ret != null) return ret; @@ -393,7 +403,7 @@ } -private static Object matchSymbol(String s){ +private static Object matchSymbol(String s, Resolver resolver){ Matcher m = symbolPat.matcher(s); if(m.matches()) { @@ -407,17 +417,33 @@ if(s.startsWith("::")) { Symbol ks = Symbol.intern(s.substring(2)); - Namespace kns; - if(ks.ns != null) - kns = Compiler.namespaceFor(ks); - else - kns = Compiler.currentNS(); - //auto-resolving keyword - if (kns != null) - return Keyword.intern(kns.name.name,ks.name); - else - return null; - } + if(resolver != null) + { + Symbol nsym; + if(ks.ns != null) + nsym = resolver.resolveAlias(Symbol.intern(ks.ns)); + else + nsym = resolver.currentNS(); + //auto-resolving keyword + if(nsym != null) + return Keyword.intern(nsym.name, ks.name); + else + return null; + } + else + { + Namespace kns; + if(ks.ns != null) + kns = Compiler.currentNS().lookupAlias(Symbol.intern(ks.ns)); + else + kns = Compiler.currentNS(); + //auto-resolving keyword + if(kns != null) + return Keyword.intern(kns.name.name, ks.name); + else + return null; + } + } boolean isKeyword = s.charAt(0) == ':'; Symbol sym = Symbol.intern(s.substring(isKeyword ? 1 : 0)); if(isKeyword) @@ -640,19 +666,27 @@ // Resolve autoresolved ns String ns; if (auto) { + Resolver resolver = (Resolver) RT.READER_RESOLVER.deref(); if (sym == null) { - ns = Compiler.currentNS().getName().getName(); + if(resolver != null) + ns = resolver.currentNS().name; + else + ns = Compiler.currentNS().getName().getName(); } else if (!(sym instanceof Symbol) || ((Symbol)sym).getNamespace() != null) { throw Util.runtimeException("Namespaced map must specify a valid namespace: " + sym); } else { - Namespace resolvedNS = Compiler.currentNS().lookupAlias((Symbol)sym); - if(resolvedNS == null) - resolvedNS = Namespace.find((Symbol)sym); + Symbol resolvedNS; + if (resolver != null) + resolvedNS = resolver.resolveAlias((Symbol) sym); + else{ + Namespace rns = Compiler.currentNS().lookupAlias((Symbol)sym); + resolvedNS = rns != null?rns.getName():null; + } if(resolvedNS == null) { throw Util.runtimeException("Unknown auto-resolved namespace alias: " + sym); } else { - ns = resolvedNS.getName().getName(); + ns = resolvedNS.getName(); } } } else if (!(sym instanceof Symbol) || ((Symbol)sym).getNamespace() != null) { @@ -667,35 +701,51 @@ throw Util.runtimeException("Namespaced map literal must contain an even number of forms"); // Construct output map - IPersistentMap m = RT.map(); + Object[] a = new Object[kvs.size()]; Iterator iter = kvs.iterator(); - while(iter.hasNext()) { + for(int i = 0; iter.hasNext(); i += 2) { Object key = iter.next(); Object val = iter.next(); if(key instanceof Keyword) { Keyword kw = (Keyword) key; if (kw.getNamespace() == null) { - m = m.assoc(Keyword.intern(ns, kw.getName()), val); + key = Keyword.intern(ns, kw.getName()); } else if (kw.getNamespace().equals("_")) { - m = m.assoc(Keyword.intern(null, kw.getName()), val); - } else { - m = m.assoc(kw, val); + key = Keyword.intern(null, kw.getName()); } } else if(key instanceof Symbol) { Symbol s = (Symbol) key; if (s.getNamespace() == null) { - m = m.assoc(Symbol.intern(ns, s.getName()), val); + key = Symbol.intern(ns, s.getName()); } else if (s.getNamespace().equals("_")) { - m = m.assoc(Symbol.intern(null, s.getName()), val); - } else { - m = m.assoc(s, val); + key = Symbol.intern(null, s.getName()); } - } else { - m = m.assoc(key, val); } + a[i] = key; + a[i+1] = val; } - return m; + return RT.map(a); + } +} + + +public static class SymbolicValueReader extends AFn{ + + static IPersistentMap specials = PersistentHashMap.create(Symbol.intern("Inf"), Double.POSITIVE_INFINITY, + Symbol.intern("-Inf"), Double.NEGATIVE_INFINITY, + Symbol.intern("NaN"), Double.NaN); + + public Object invoke(Object reader, Object quote, Object opts, Object pendingForms) { + PushbackReader r = (PushbackReader) reader; + Object o = read(r, true, null, true, opts, ensurePending(pendingForms)); + + if (!(o instanceof Symbol)) + throw Util.runtimeException("Invalid token: ##" + o); + if (!(specials.containsKey(o))) + throw Util.runtimeException("Unknown symbolic value: ##" + o); + + return specials.valAt(o); } } @@ -862,7 +912,7 @@ PushbackReader r = (PushbackReader) reader; if(ARG_ENV.deref() == null) { - return interpretToken(readToken(r, '%')); + return interpretToken(readToken(r, '%'), null); } int ch = read1(r); unread(r, ch); @@ -947,6 +997,7 @@ ret = RT.list(Compiler.QUOTE, form); else if(form instanceof Symbol) { + Resolver resolver = (Resolver) RT.READER_RESOLVER.deref(); Symbol sym = (Symbol) form; if(sym.ns == null && sym.name.endsWith("#")) { @@ -963,13 +1014,43 @@ else if(sym.ns == null && sym.name.endsWith(".")) { Symbol csym = Symbol.intern(null, sym.name.substring(0, sym.name.length() - 1)); - csym = Compiler.resolveSymbol(csym); + if(resolver != null){ + Symbol rc = resolver.resolveClass(csym); + if(rc != null) + csym = rc; + } + else + csym = Compiler.resolveSymbol(csym); sym = Symbol.intern(null, csym.name.concat(".")); } else if(sym.ns == null && sym.name.startsWith(".")) { // Simply quote method names. } + else if(resolver != null) + { + Symbol nsym = null; + if(sym.ns != null){ + Symbol alias = Symbol.intern(null, sym.ns); + nsym = resolver.resolveClass(alias); + if(nsym == null) + nsym = resolver.resolveAlias(alias); + } + if(nsym != null){ + // Classname/foo -> package.qualified.Classname/foo + sym = Symbol.intern(nsym.name, sym.name); + } + else if(sym.ns == null){ + Symbol rsym = resolver.resolveClass(sym); + if(rsym == null) + rsym = resolver.resolveVar(sym); + if(rsym != null) + sym = rsym; + else + sym = Symbol.intern(resolver.currentNS().name,sym.name); + } + //leave alone if qualified + } else { Object maybeClass = null; @@ -1296,10 +1377,12 @@ ((LineNumberingPushbackReader) r).getLineNumber() : -1; ArrayList a = new ArrayList(); + Resolver resolver = (Resolver) RT.READER_RESOLVER.deref(); for(; ;) { - Object form = read(r, false, READ_EOF, delim, READ_FINISHED, isRecursive, opts, pendingForms); + Object form = read(r, false, READ_EOF, delim, READ_FINISHED, isRecursive, opts, pendingForms, + resolver); if (form == READ_EOF) { if (firstline < 0) @@ -1445,7 +1528,7 @@ for(; ;) { if(result == READ_STARTED) { // Read the next feature - form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms); + form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms, null); if (form == READ_EOF) { if (firstline < 0) @@ -1463,7 +1546,7 @@ //Read the form corresponding to the feature, and assign it to result if everything is kosher - form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms); + form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms, (Resolver) RT.READER_RESOLVER.deref()); if (form == READ_EOF) { if (firstline < 0) @@ -1484,7 +1567,7 @@ // When we already have a result, or when the feature didn't match, discard the next form in the reader try { Var.pushThreadBindings(RT.map(RT.SUPPRESS_READ, RT.T)); - form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms); + form = read(r, false, READ_EOF, ')', READ_FINISHED, true, opts, pendingForms, (Resolver) RT.READER_RESOLVER.deref()); if (form == READ_EOF) { if (firstline < 0) diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/Numbers.java clojure-1.9.0/src/jvm/clojure/lang/Numbers.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/Numbers.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/Numbers.java 2017-12-08 13:59:39.000000000 +0000 @@ -153,6 +153,11 @@ } static public Number divide(Object x, Object y){ + if (isNaN(x)){ + return (Number)x; + } else if(isNaN(y)){ + return (Number)y; + } Ops yops = ops(y); if(yops.isZero((Number)y)) throw new ArithmeticException("Divide by zero"); @@ -1033,21 +1038,18 @@ } @WarnBoxedMath(false) -static int hasheq(Number x){ - Class xc = x.getClass(); - - if(xc == Long.class - || xc == Integer.class - || xc == Short.class - || xc == Byte.class - || (xc == BigInteger.class && lte(x, Long.MAX_VALUE) && gte(x,Long.MIN_VALUE))) - { +static int hasheqFrom(Number x, Class xc){ + if(xc == Integer.class + || xc == Short.class + || xc == Byte.class + || (xc == BigInteger.class && lte(x, Long.MAX_VALUE) && gte(x,Long.MIN_VALUE))) + { long lpart = x.longValue(); return Murmur3.hashLong(lpart); //return (int) (lpart ^ (lpart >>> 32)); - } + } if(xc == BigDecimal.class) - { + { // stripTrailingZeros() to make all numerically equal // BigDecimal values come out the same before calling // hashCode. Special check for 0 because @@ -1056,14 +1058,37 @@ if (isZero(x)) return BigDecimal.ZERO.hashCode(); else - { + { BigDecimal tmp = ((BigDecimal) x).stripTrailingZeros(); return tmp.hashCode(); - } } + } + if(xc == Float.class && x.equals(-0.0f)) + { + return 0; // match 0.0f + } return x.hashCode(); } +@WarnBoxedMath(false) +static int hasheq(Number x){ + Class xc = x.getClass(); + + if(xc == Long.class) + { + long lpart = x.longValue(); + return Murmur3.hashLong(lpart); + //return (int) (lpart ^ (lpart >>> 32)); + } + if(xc == Double.class) + { + if(x.equals(-0.0)) + return 0; // match 0.0 + return x.hashCode(); + } + return hasheqFrom(x, xc); +} + static Category category(Object x){ Class xc = x.getClass(); diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/PersistentQueue.java clojure-1.9.0/src/jvm/clojure/lang/PersistentQueue.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/PersistentQueue.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/PersistentQueue.java 2017-12-08 13:59:39.000000000 +0000 @@ -31,8 +31,8 @@ final ISeq f; final PersistentVector r; //static final int INITIAL_REAR_SIZE = 4; -int _hash = -1; -int _hasheq = -1; +int _hash; +int _hasheq; PersistentQueue(IPersistentMap meta, int cnt, ISeq f, PersistentVector r){ super(meta); @@ -70,30 +70,32 @@ } public int hashCode(){ - if(_hash == -1) + int hash = this._hash; + if(hash == 0) { - int hash = 1; + hash = 1; for(ISeq s = seq(); s != null; s = s.next()) { hash = 31 * hash + (s.first() == null ? 0 : s.first().hashCode()); } this._hash = hash; } - return _hash; + return hash; } public int hasheq() { - if(_hasheq == -1) - { + int cached = this._hasheq; + if(cached == 0) + { // int hash = 1; // for(ISeq s = seq(); s != null; s = s.next()) // { // hash = 31 * hash + Util.hasheq(s.first()); // } // this._hasheq = hash; - _hasheq = Murmur3.hashOrdered(this); + this._hasheq = cached = Murmur3.hashOrdered(this); } - return _hasheq; + return cached; } public Object peek(){ diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/PersistentVector.java clojure-1.9.0/src/jvm/clojure/lang/PersistentVector.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/PersistentVector.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/PersistentVector.java 2017-12-08 13:59:39.000000000 +0000 @@ -515,7 +515,7 @@ } } -static final class TransientVector extends AFn implements ITransientVector, Counted{ +static final class TransientVector extends AFn implements ITransientVector, ITransientAssociative2, Counted{ volatile int cnt; volatile int shift; volatile Node root; @@ -678,6 +678,18 @@ return notFound; } + private static final Object NOT_FOUND = new Object(); + public final boolean containsKey(Object key){ + return valAt(key, NOT_FOUND) != NOT_FOUND; + } + + public final IMapEntry entryAt(Object key){ + Object v = valAt(key, NOT_FOUND); + if(v != NOT_FOUND) + return MapEntry.create(key, v); + return null; + } + public Object invoke(Object arg1) { //note - relies on ensureEditable in nth if(Util.isInteger(arg1)) diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/RT.java clojure-1.9.0/src/jvm/clojure/lang/RT.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/RT.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/RT.java 2017-12-08 13:59:39.000000000 +0000 @@ -36,7 +36,7 @@ static final public String LOADER_SUFFIX = "__init"; //simple-symbol->class -final static IPersistentMap DEFAULT_IMPORTS = map( +final static public IPersistentMap DEFAULT_IMPORTS = map( // Symbol.intern("RT"), "clojure.lang.RT", // Symbol.intern("Num"), "clojure.lang.Num", // Symbol.intern("Symbol"), "clojure.lang.Symbol", @@ -227,6 +227,7 @@ final static Var PRINT_DUP = Var.intern(CLOJURE_NS, Symbol.intern("*print-dup*"), F).setDynamic(); final static Var WARN_ON_REFLECTION = Var.intern(CLOJURE_NS, Symbol.intern("*warn-on-reflection*"), F).setDynamic(); final static Var ALLOW_UNRESOLVED_VARS = Var.intern(CLOJURE_NS, Symbol.intern("*allow-unresolved-vars*"), F).setDynamic(); +final static Var READER_RESOLVER = Var.intern(CLOJURE_NS, Symbol.intern("*reader-resolver*"), null).setDynamic(); final static Var IN_NS_VAR = Var.intern(CLOJURE_NS, Symbol.intern("in-ns"), F); final static Var NS_VAR = Var.intern(CLOJURE_NS, Symbol.intern("ns"), F); @@ -299,6 +300,8 @@ } public static boolean checkSpecAsserts = Boolean.getBoolean("clojure.spec.check-asserts"); +public static boolean instrumentMacros = ! Boolean.getBoolean("clojure.spec.skip-macros"); +static volatile boolean CHECK_SPECS = false; static{ Keyword arglistskw = Keyword.intern(null, "arglists"); @@ -335,6 +338,8 @@ catch(Exception e) { throw Util.sneakyThrow(e); } + + CHECK_SPECS = RT.instrumentMacros; } static public Keyword keyword(String ns, String name){ @@ -461,8 +466,6 @@ static void doInit() throws ClassNotFoundException, IOException{ load("clojure/core"); - load("clojure/spec"); - load("clojure/core/specs"); Var.pushThreadBindings( RT.mapUniqueKeys(CURRENT_NS, CURRENT_NS.deref(), @@ -768,6 +771,10 @@ return nth(coll, n); return null; } + else if(coll instanceof ITransientSet) { + ITransientSet set = (ITransientSet) coll; + return set.get(key); + } return null; } @@ -797,6 +804,12 @@ int n = ((Number) key).intValue(); return n >= 0 && n < count(coll) ? nth(coll, n) : notFound; } + else if(coll instanceof ITransientSet) { + ITransientSet set = (ITransientSet) coll; + if(set.contains(key)) + return set.get(key); + return notFound; + } return notFound; } @@ -826,6 +839,10 @@ int n = ((Number) key).intValue(); return n >= 0 && n < count(coll); } + else if(coll instanceof ITransientSet) + return ((ITransientSet)coll).contains(key) ? T : F; + else if(coll instanceof ITransientAssociative2) + return (((ITransientAssociative2)coll).containsKey(key)) ? T : F; throw new IllegalArgumentException("contains? not supported on type: " + coll.getClass().getName()); } @@ -834,12 +851,16 @@ return null; else if(coll instanceof Associative) return ((Associative) coll).entryAt(key); - else { + else if(coll instanceof Map) { Map m = (Map) coll; if(m.containsKey(key)) return MapEntry.create(key, m.get(key)); return null; } + else if(coll instanceof ITransientAssociative2) { + return ((ITransientAssociative2) coll).entryAt(key); + } + throw new IllegalArgumentException("find not supported on type: " + coll.getClass().getName()); } //takes a seq of key,val,key,val diff -Nru clojure-1.9.0~alpha15/src/jvm/clojure/lang/Var.java clojure-1.9.0/src/jvm/clojure/lang/Var.java --- clojure-1.9.0~alpha15/src/jvm/clojure/lang/Var.java 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/src/jvm/clojure/lang/Var.java 2017-12-08 13:59:39.000000000 +0000 @@ -12,10 +12,12 @@ package clojure.lang; +import java.io.ObjectStreamException; +import java.io.Serializable; import java.util.concurrent.atomic.AtomicBoolean; -public final class Var extends ARef implements IFn, IRef, Settable{ +public final class Var extends ARef implements IFn, IRef, Settable, Serializable{ static class TBox{ @@ -712,4 +714,28 @@ return RT.dissoc(c, k); } }; + + +/*** + Note - serialization only supports reconnecting the Var identity on the deserializing end + Neither the value in the var nor any of its properties are serialized +***/ + +private static class Serialized implements Serializable{ + public Serialized(Symbol nsName, Symbol sym){ + this.nsName = nsName; + this.sym = sym; + } + + private Symbol nsName; + private Symbol sym; + + private Object readResolve() throws ObjectStreamException{ + return intern(nsName, sym); + } +} + +private Object writeReplace() throws ObjectStreamException{ + return new Serialized(ns.getName(), sym); +} } diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/atoms.clj clojure-1.9.0/test/clojure/test_clojure/atoms.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/atoms.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/atoms.clj 2017-12-08 13:59:39.000000000 +0000 @@ -18,3 +18,27 @@ ; swap! reset! ; compare-and-set! +(deftest swap-vals-returns-old-value + (let [a (atom 0)] + (is (= [0 1] (swap-vals! a inc))) + (is (= [1 2] (swap-vals! a inc))) + (is (= 2 @a)))) + +(deftest deref-swap-arities + (binding [*warn-on-reflection* true] + (let [a (atom 0)] + (is (= [0 1] (swap-vals! a + 1))) + (is (= [1 3] (swap-vals! a + 1 1))) + (is (= [3 6] (swap-vals! a + 1 1 1))) + (is (= [6 10] (swap-vals! a + 1 1 1 1))) + (is (= 10 @a))))) + +(deftest deref-reset-returns-old-value + (let [a (atom 0)] + (is (= [0 :b] (reset-vals! a :b))) + (is (= [:b 45M] (reset-vals! a 45M))) + (is (= 45M @a)))) + +(deftest reset-on-deref-reset-equality + (let [a (atom :usual-value)] + (is (= :usual-value (reset! a (first (reset-vals! a :almost-never-seen-value))))))) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/compilation.clj clojure-1.9.0/test/clojure/test_clojure/compilation.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/compilation.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/compilation.clj 2017-12-08 13:59:39.000000000 +0000 @@ -354,6 +354,33 @@ ;; throws an exception on failure (is (eval `(fn [] ~(CLJ1399. 1))))) +(deftest CLJ-1250-this-clearing + (testing "clearing during try/catch/finally" + (let [closed-over-in-catch (let [x :foo] + (fn [] + (try + (throw (Exception. "boom")) + (catch Exception e + x)))) ;; x should remain accessible to the fn + + a (atom nil) + closed-over-in-finally (fn [] + (try + :ret + (finally + (reset! a :run))))] + (is (= :foo (closed-over-in-catch))) + (is (= :ret (closed-over-in-finally))) + (is (= :run @a)))) + (testing "no clearing when loop not in return context" + (let [x (atom 5) + bad (fn [] + (loop [] (System/getProperties)) + (swap! x dec) + (when (pos? @x) + (recur)))] + (is (nil? (bad)))))) + (deftest CLJ-1586-lazyseq-literals-preserve-metadata (should-not-reflect (eval (list '.substring (with-meta (concat '(identity) '("foo")) {:tag 'String}) 0)))) @@ -395,3 +422,9 @@ ;; eventually call `load` and reset called?. (require 'clojure.repl :reload)) (is @called?))) + +(deftest clj-1714 + (testing "CLJ-1714 Classes shouldn't have their static initialisers called simply by type hinting or importing" + ;; ClassWithFailingStaticInitialiser will throw if its static initialiser is called + (is (eval '(fn [^compilation.ClassWithFailingStaticInitialiser c]))) + (is (eval '(import (compilation ClassWithFailingStaticInitialiser)))))) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/delays.clj clojure-1.9.0/test/clojure/test_clojure/delays.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/delays.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/delays.clj 2017-12-08 13:59:39.000000000 +0000 @@ -1,5 +1,6 @@ (ns clojure.test-clojure.delays - (:use clojure.test)) + (:use clojure.test) + (:import [java.util.concurrent CyclicBarrier])) (deftest calls-once (let [a (atom 0) @@ -9,6 +10,27 @@ (is (= 1 @d)) (is (= 1 @a)))) +(deftest calls-once-in-parallel + (let [a (atom 0) + d (delay (swap! a inc)) + threads 100 + ^CyclicBarrier barrier (CyclicBarrier. (+ threads 1))] + (is (= 0 @a)) + (dotimes [_ threads] + (-> + (Thread. + (fn [] + (.await barrier) + (dotimes [_ 10000] + (is (= 1 @d))) + (.await barrier))) + (.start))) + (.await barrier) + (.await barrier) + (is (= 1 @d)) + (is (= 1 @d)) + (is (= 1 @a)))) + (deftest saves-exceptions (let [f #(do (throw (Exception. "broken")) 1) @@ -19,3 +41,28 @@ first-result (try-call)] (is (instance? Exception first-result)) (is (identical? first-result (try-call))))) + +(deftest saves-exceptions-in-parallel + (let [f #(do (throw (Exception. "broken")) + 1) + d (delay (f)) + try-call #(try + @d + (catch Exception e e)) + threads 100 + ^CyclicBarrier barrier (CyclicBarrier. (+ threads 1))] + (dotimes [_ threads] + (-> + (Thread. + (fn [] + (.await barrier) + (let [first-result (try-call)] + (dotimes [_ 10000] + (is (instance? Exception (try-call))) + (is (identical? first-result (try-call))))) + (.await barrier))) + (.start))) + (.await barrier) + (.await barrier) + (is (instance? Exception (try-call))) + (is (identical? (try-call) (try-call))))) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/java_interop.clj clojure-1.9.0/test/clojure/test_clojure/java_interop.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/java_interop.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/java_interop.clj 2017-12-08 13:59:39.000000000 +0000 @@ -10,7 +10,8 @@ (ns clojure.test-clojure.java-interop - (:use clojure.test)) + (:use clojure.test) + (:require [clojure.inspector])) ; http://clojure.org/java_interop ; http://clojure.org/compilation @@ -150,8 +151,10 @@ (:class b) java.awt.Color ))) (deftest test-iterable-bean - (is (.iterator ^Iterable (bean (java.util.Date.)))) - (is (hash (bean (java.util.Date.))))) + (let [b (bean (java.util.Date.))] + (is (.iterator ^Iterable b)) + (is (= (into [] b) (into [] (seq b)))) + (is (hash b)))) ; proxy, proxy-super @@ -171,6 +174,34 @@ "chain chain chain"))) +;; serialized-proxy can be regenerated using a modified version of +;; Clojure with the proxy serialization prohibition disabled and the +;; following code: +#_(let [baos (java.io.ByteArrayOutputStream.) ] + (with-open [baos baos] + (.writeObject (java.io.ObjectOutputStream. baos) (clojure.inspector/list-model nil))) + (println (apply str (for [c (String. (.toByteArray baos) "ISO-8859-1")] + (if (<= 32 (int c) (int \z)) c (format "\\%03o" (int c))))))) +(def serialized-proxy "\254\355\000\005sr\000Eclojure.inspector.proxy$javax.swing.table.AbstractTableModel$ff19274art\330\266_\010ME\002\000\001L\000\016__clojureFnMapt\000\035Lclojure/lang/IPersistentMap;xr\000$javax.swing.table.AbstractTableModelr\313\3538\256\001\377\276\002\000\001L\000\014listenerListt\000%Ljavax/swing/event/EventListenerList;xpsr\000#javax.swing.event.EventListenerList\2616\306\175\204\352\326D\003\000\000xppxsr\000\037clojure.lang.PersistentArrayMap\3437p\017\230\305\364\337\002\000\002L\000\005_metaq\000\176\000\001[\000\005arrayt\000\023[Ljava/lang/Object;xr\000\033clojure.lang.APersistentMap]\174/\003t r\173\002\000\002I\000\005_hashI\000\007_hasheqxp\000\000\000\000\000\000\000\000pur\000\023[Ljava.lang.Object;\220\316X\237\020s)l\002\000\000xp\000\000\000\006t\000\016getColumnCountsr\000%clojure.inspector$list_model$fn__8816H\252\320\325b\371!+\002\000\000xr\000\026clojure.lang.AFunction>\006p\234\236F\375\313\002\000\001L\000\021__methodImplCachet\000\036Lclojure/lang/MethodImplCache;xppt\000\013getRowCountsr\000%clojure.inspector$list_model$fn__8818-\037I\247\234/U\226\002\000\001L\000\005nrowst\000\022Ljava/lang/Object;xq\000\176\000\017ppt\000\012getValueAtsr\000%clojure.inspector$list_model$fn__8820\323\331\174ke\233\370\034\002\000\002L\000\011get_labelq\000\176\000\024L\000\011get_valueq\000\176\000\024xq\000\176\000\017ppp") + +(deftest test-proxy-non-serializable + (testing "That proxy classes refuse serialization and deserialization" + ;; Serializable listed directly in interface list: + (is (thrown? java.io.NotSerializableException + (-> (java.io.ByteArrayOutputStream.) + (java.io.ObjectOutputStream.) + (.writeObject (proxy [Object java.io.Serializable] []))))) + ;; Serializable included via inheritence: + (is (thrown? java.io.NotSerializableException + (-> (java.io.ByteArrayOutputStream.) + (java.io.ObjectOutputStream.) + (.writeObject (clojure.inspector/list-model nil))))) + ;; Deserialization also prohibited: + (is (thrown? java.io.NotSerializableException + (-> serialized-proxy (.getBytes "ISO-8859-1") + java.io.ByteArrayInputStream. java.io.ObjectInputStream. + .readObject))))) + (deftest test-bases (are [x y] (= x y) (bases java.lang.Math) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/numbers.clj clojure-1.9.0/test/clojure/test_clojure/numbers.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/numbers.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/numbers.clj 2017-12-08 13:59:39.000000000 +0000 @@ -72,6 +72,7 @@ (all-pairs-equal #'= [(byte 2) (short 2) (int 2) (long 2) (bigint 2) (biginteger 2)]) (all-pairs-equal #'= [(float 2.0) (double 2.0)]) + (all-pairs-equal #'= [(float 0.0) (double 0.0) (float -0.0) (double -0.0)]) (all-pairs-equal #'= [2.0M 2.00M]) (all-pairs-equal #'= [(float 1.5) (double 1.5)]) (all-pairs-equal #'= [1.50M 1.500M]) @@ -85,12 +86,13 @@ (bigint 2) (double 2.0) 2.0M 2.00M]) (all-pairs-hash-consistent-with-= [(/ 3 2) (double 1.5) 1.50M 1.500M]) - (all-pairs-hash-consistent-with-= [(double 0.0) 0.0M 0.00M]) + (all-pairs-hash-consistent-with-= [(double -0.0) (double 0.0) -0.0M -0.00M 0.0M 0.00M (float -0.0) (float 0.0)]) ;; == tests for numerical equality, returning true even for numbers ;; in different categories. (all-pairs-equal #'== [(byte 0) (short 0) (int 0) (long 0) (bigint 0) (biginteger 0) + (float -0.0) (double -0.0) -0.0M -0.00M (float 0.0) (double 0.0) 0.0M 0.00M]) (all-pairs-equal #'== [(byte 2) (short 2) (int 2) (long 2) (bigint 2) (biginteger 2) @@ -807,3 +809,73 @@ (<= 1000 Double/NaN) (<= 1000 (Double. Double/NaN)) (> 1000 Double/NaN) (> 1000 (Double. Double/NaN)) (>= 1000 Double/NaN) (>= 1000 (Double. Double/NaN)))) + +(deftest test-nan-as-operand + (testing "All numeric operations with NaN as an operand produce NaN as a result" + (let [nan Double/NaN + onan (cast Object Double/NaN)] + (are [x] (Double/isNaN x) + (+ nan 1) + (+ nan 0) + (+ nan 0.0) + (+ 1 nan) + (+ 0 nan) + (+ 0.0 nan) + (+ nan nan) + (- nan 1) + (- nan 0) + (- nan 0.0) + (- 1 nan) + (- 0 nan) + (- 0.0 nan) + (- nan nan) + (* nan 1) + (* nan 0) + (* nan 0.0) + (* 1 nan) + (* 0 nan) + (* 0.0 nan) + (* nan nan) + (/ nan 1) + (/ nan 0) + (/ nan 0.0) + (/ 1 nan) + (/ 0 nan) + (/ 0.0 nan) + (/ nan nan) + (+ onan 1) + (+ onan 0) + (+ onan 0.0) + (+ 1 onan) + (+ 0 onan) + (+ 0.0 onan) + (+ onan onan) + (- onan 1) + (- onan 0) + (- onan 0.0) + (- 1 onan) + (- 0 onan) + (- 0.0 onan) + (- onan onan) + (* onan 1) + (* onan 0) + (* onan 0.0) + (* 1 onan) + (* 0 onan) + (* 0.0 onan) + (* onan onan) + (/ onan 1) + (/ onan 0) + (/ onan 0.0) + (/ 1 onan) + (/ 0 onan) + (/ 0.0 onan) + (/ onan onan) + (+ nan onan) + (+ onan nan) + (- nan onan) + (- onan nan) + (* nan onan) + (* onan nan) + (/ nan onan) + (/ onan nan) )))) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/other_functions.clj clojure-1.9.0/test/clojure/test_clojure/other_functions.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/other_functions.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/other_functions.clj 2017-12-08 13:59:39.000000000 +0000 @@ -328,6 +328,19 @@ (apply (apply some-fn (repeat i (comp not boolean))) (range i)))) true)))) + +(deftest test-max-min-key + (are [k coll min-item max-item] (and (= min-item (apply min-key k coll)) + (= max-item (apply max-key k coll))) + count ["longest" "a" "xy" "foo" "bar"] "a" "longest" + - [5 10 15 20 25] 25 5 + #(if (neg? %) (- %) %) [-2 -1 0 1 2 3 4] 0 4 + {nil 1 false -1 true 0} [true true false nil] false nil) + (are [f k coll expected] (= expected (apply f k coll)) + min-key :x [{:x 1000} {:x 1001} {:x 1002} {:x 1000 :second true}] {:x 1000 :second true} + max-key :x [{:x 1000} {:x 999} {:x 998} {:x 1000 :second true}] {:x 1000 :second true})) + + ; Printing ; pr prn print println newline ; pr-str prn-str print-str println-str [with-out-str (vars.clj)] diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/predicates.clj clojure-1.9.0/test/clojure/test_clojure/predicates.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/predicates.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/predicates.clj 2017-12-08 13:59:39.000000000 +0000 @@ -147,23 +147,23 @@ barray (byte-array 0) uri (java.net.URI. "http://clojure.org")] [' - [identity int? pos-int? neg-int? nat-int? double? boolean? indexed? seqable? ident? uuid? bigdec? inst? uri? bytes?] - [0 true false false true false false false false false false false false false false] - [1 true true false true false false false false false false false false false false] - [-1 true false true false false false false false false false false false false false] - [1.0 false false false false true false false false false false false false false false] - [true false false false false false true false false false false false false false false] - [[] false false false false false false true true false false false false false false] - [nil false false false false false false false true false false false false false false] - [{} false false false false false false false true false false false false false false] - [:foo false false false false false false false false true false false false false false] - ['foo false false false false false false false false true false false false false false] - [0.0M false false false false false false false false false false true false false false] - [0N false false false false false false false false false false false false false false] - [uuid false false false false false false false false false true false false false false] - [uri false false false false false false false false false false false false true false] - [now false false false false false false false false false false false true false false] - [barray false false false false false false false true false false false false false true]])) + [identity int? pos-int? neg-int? nat-int? double? boolean? indexed? seqable? ident? uuid? decimal? inst? uri? bytes?] + [0 true false false true false false false false false false false false false false] + [1 true true false true false false false false false false false false false false] + [-1 true false true false false false false false false false false false false false] + [1.0 false false false false true false false false false false false false false false] + [true false false false false false true false false false false false false false false] + [[] false false false false false false true true false false false false false false] + [nil false false false false false false false true false false false false false false] + [{} false false false false false false false true false false false false false false] + [:foo false false false false false false false false true false false false false false] + ['foo false false false false false false false false true false false false false false] + [0.0M false false false false false false false false false false true false false false] + [0N false false false false false false false false false false false false false false] + [uuid false false false false false false false false false true false false false false] + [uri false false false false false false false false false false false false true false] + [now false false false false false false false false false false false true false false] + [barray false false false false false false false true false false false false false true]])) (deftest test-preds (let [[preds & rows] pred-val-table] diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/printer.clj clojure-1.9.0/test/clojure/test_clojure/printer.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/printer.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/printer.clj 2017-12-08 13:59:39.000000000 +0000 @@ -140,3 +140,12 @@ (let [date-map (bean (java.util.Date. 0))] (is (= (binding [*print-namespace-maps* true] (pr-str date-map)) (binding [*print-namespace-maps* false] (pr-str date-map)))))) + +(deftest print-symbol-values + (are [s v] (= s (pr-str v)) + "##Inf" Double/POSITIVE_INFINITY + "##-Inf" Double/NEGATIVE_INFINITY + "##NaN" Double/NaN + "##Inf" Float/POSITIVE_INFINITY + "##-Inf" Float/NEGATIVE_INFINITY + "##NaN" Float/NaN)) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/reader.cljc clojure-1.9.0/test/clojure/test_clojure/reader.cljc --- clojure-1.9.0~alpha15/test/clojure/test_clojure/reader.cljc 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/reader.cljc 2017-12-08 13:59:39.000000000 +0000 @@ -213,6 +213,10 @@ (is (instance? Double -1.0)) (is (instance? Double -1.)) + (is (= Double/POSITIVE_INFINITY ##Inf)) + (is (= Double/NEGATIVE_INFINITY ##-Inf)) + (is (and (instance? Double ##NaN) (.isNaN ##NaN))) + ; Read BigDecimal (is (instance? BigDecimal 9223372036854775808M)) (is (instance? BigDecimal -9223372036854775809M)) @@ -727,24 +731,27 @@ (is (= #::s{1 nil, :a nil, :a/b nil, :_/d nil} #::s {1 nil, :a nil, :a/b nil, :_/d nil} {1 nil, :clojure.string/a nil, :a/b nil, :d nil})) - (is (= #::clojure.core{1 nil, :a nil, :a/b nil, :_/d nil} {1 nil, :clojure.core/a nil, :a/b nil, :d nil})) (is (= (read-string "#:a{b 1 b/c 2}") {'a/b 1, 'b/c 2})) (is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::{b 1, b/c 2, _/d 3}")) {'clojure.test-clojure.reader/b 1, 'b/c 2, 'd 3})) - (is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::s{b 1, b/c 2, _/d 3}")) {'clojure.string/b 1, 'b/c 2, 'd 3})) - (is (= (read-string "#::clojure.core{b 1, b/c 2, _/d 3}") {'clojure.core/b 1, 'b/c 2, 'd 3}))) + (is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::s{b 1, b/c 2, _/d 3}")) {'clojure.string/b 1, 'b/c 2, 'd 3}))) (deftest namespaced-map-errors (are [err msg form] (thrown-with-msg? err msg (read-string form)) Exception #"Invalid token" "#:::" Exception #"Namespaced map literal must contain an even number of forms" "#:s{1}" Exception #"Namespaced map must specify a valid namespace" "#:s/t{1 2}" - Exception #"Namespaced map literal must contain an even number of forms" "#::clojure.core{1}" - Exception #"Namespaced map must specify a valid namespace" "#::clojure.core/t{1 2}" Exception #"Unknown auto-resolved namespace alias" "#::BOGUS{1 2}" - Exception #"Namespaced map must specify a namespace" "#:: clojure.core{:a 1}" - Exception #"Namespaced map must specify a namespace" "#: clojure.core{:a 1}")) + Exception #"Namespaced map must specify a namespace" "#: s{:a 1}" + Exception #"Duplicate key: :user/a" "#::{:a 1 :a 2}" + Exception #"Duplicate key: user/a" "#::{a 1 a 2}")) (deftest namespaced-map-edn (is (= {1 1, :a/b 2, :b/c 3, :d 4} (edn/read-string "#:a{1 1, :b 2, :b/c 3, :_/d 4}") - (edn/read-string "#:a {1 1, :b 2, :b/c 3, :_/d 4}")))) \ No newline at end of file + (edn/read-string "#:a {1 1, :b 2, :b/c 3, :_/d 4}")))) + +(deftest invalid-symbol-value + (is (thrown-with-msg? Exception #"Invalid token" (read-string "##5"))) + (is (thrown-with-msg? Exception #"Invalid token" (edn/read-string "##5"))) + (is (thrown-with-msg? Exception #"Unknown symbolic value" (read-string "##Foo"))) + (is (thrown-with-msg? Exception #"Unknown symbolic value" (edn/read-string "##Foo")))) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/reducers.clj clojure-1.9.0/test/clojure/test_clojure/reducers.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/reducers.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/reducers.clj 2017-12-08 13:59:39.000000000 +0000 @@ -89,3 +89,7 @@ ([ret k v] (when (= k k-fail) (throw (IndexOutOfBoundsException.))))) (zipmap (range test-map-count) (repeat :dummy))))))) + +(deftest test-closed-over-clearing + ;; this will throw OutOfMemory without proper reference clearing + (is (number? (reduce + 0 (r/map identity (range 1e8)))))) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/repl.clj clojure-1.9.0/test/clojure/test_clojure/repl.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/repl.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/repl.clj 2017-12-08 13:59:39.000000000 +0000 @@ -8,7 +8,9 @@ (deftest test-doc (testing "with namespaces" (is (= "clojure.pprint" - (second (str/split-lines (with-out-str (doc clojure.pprint)))))))) + (second (str/split-lines (with-out-str (doc clojure.pprint))))))) + (testing "with special cases" + (is (= (with-out-str (doc catch)) (with-out-str (doc try)))))) (deftest test-source (is (= "(defn foo [])" (source-fn 'clojure.test-clojure.repl.example/foo))) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/serialization.clj clojure-1.9.0/test/clojure/test_clojure/serialization.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/serialization.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/serialization.clj 2017-12-08 13:59:39.000000000 +0000 @@ -169,7 +169,7 @@ (atom nil) (ref nil) (agent nil) - #'+ + ;;#'+ ;; stateful seqs (enumeration-seq (java.util.Collections/enumeration (range 50))) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/spec.clj clojure-1.9.0/test/clojure/test_clojure/spec.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/spec.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/spec.clj 1970-01-01 00:00:00.000000000 +0000 @@ -1,201 +0,0 @@ -(ns clojure.test-clojure.spec - (:require [clojure.spec :as s] - [clojure.spec.gen :as gen] - [clojure.spec.test :as stest] - [clojure.test :refer :all])) - -(set! *warn-on-reflection* true) - -(defmacro result-or-ex [x] - `(try - ~x - (catch Throwable t# - (.getName (class t#))))) - -(def even-count? #(even? (count %))) - -(defn submap? - "Is m1 a subset of m2?" - [m1 m2] - (if (and (map? m1) (map? m2)) - (every? (fn [[k v]] (and (contains? m2 k) - (submap? v (get m2 k)))) - m1) - (= m1 m2))) - -(deftest conform-explain - (let [a (s/and #(> % 5) #(< % 10)) - o (s/or :s string? :k keyword?) - c (s/cat :a string? :b keyword?) - either (s/alt :a string? :b keyword?) - star (s/* keyword?) - plus (s/+ keyword?) - opt (s/? keyword?) - andre (s/& (s/* keyword?) even-count?) - m (s/map-of keyword? string?) - mkeys (s/map-of (s/and keyword? (s/conformer name)) any?) - mkeys2 (s/map-of (s/and keyword? (s/conformer name)) any? :conform-keys true) - s (s/coll-of (s/spec (s/cat :tag keyword? :val any?)) :kind list?) - v (s/coll-of keyword? :kind vector?) - coll (s/coll-of keyword?) - lrange (s/int-in 7 42) - drange (s/double-in :infinite? false :NaN? false :min 3.1 :max 3.2) - irange (s/inst-in #inst "1939" #inst "1946") - ] - (are [spec x conformed ed] - (let [co (result-or-ex (s/conform spec x)) - e (result-or-ex (::s/problems (s/explain-data spec x)))] - (when (not= conformed co) (println "conform fail\n\texpect=" conformed "\n\tactual=" co)) - (when (not (every? true? (map submap? ed e))) - (println "explain failures\n\texpect=" ed "\n\tactual failures=" e "\n\tsubmap?=" (map submap? ed e))) - (and (= conformed co) (every? true? (map submap? ed e)))) - - lrange 7 7 nil - lrange 8 8 nil - lrange 42 ::s/invalid [{:pred '(int-in-range? 7 42 %), :val 42}] - - irange #inst "1938" ::s/invalid [{:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1938"}] - irange #inst "1942" #inst "1942" nil - irange #inst "1946" ::s/invalid [{:pred '(inst-in-range? #inst "1939-01-01T00:00:00.000-00:00" #inst "1946-01-01T00:00:00.000-00:00" %), :val #inst "1946"}] - - drange 3.0 ::s/invalid [{:pred '(<= 3.1 %), :val 3.0}] - drange 3.1 3.1 nil - drange 3.2 3.2 nil - drange Double/POSITIVE_INFINITY ::s/invalid [{:pred '(not (isInfinite %)), :val Double/POSITIVE_INFINITY}] - ;; can't use equality-based test for Double/NaN - ;; drange Double/NaN ::s/invalid {[] {:pred '(not (isNaN %)), :val Double/NaN}} - - keyword? :k :k nil - keyword? nil ::s/invalid [{:pred ::s/unknown :val nil}] - keyword? "abc" ::s/invalid [{:pred ::s/unknown :val "abc"}] - - a 6 6 nil - a 3 ::s/invalid '[{:pred (> % 5), :val 3}] - a 20 ::s/invalid '[{:pred (< % 10), :val 20}] - a nil "java.lang.NullPointerException" "java.lang.NullPointerException" - a :k "java.lang.ClassCastException" "java.lang.ClassCastException" - - o "a" [:s "a"] nil - o :a [:k :a] nil - o 'a ::s/invalid '[{:pred string?, :val a, :path [:s]} {:pred keyword?, :val a :path [:k]}] - - c nil ::s/invalid '[{:reason "Insufficient input", :pred string?, :val (), :path [:a]}] - c [] ::s/invalid '[{:reason "Insufficient input", :pred string?, :val (), :path [:a]}] - c [:a] ::s/invalid '[{:pred string?, :val :a, :path [:a], :in [0]}] - c ["a"] ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val (), :path [:b]}] - c ["s" :k] '{:a "s" :b :k} nil - c ["s" :k 5] ::s/invalid '[{:reason "Extra input", :pred (cat :a string? :b keyword?), :val (5)}] - (s/cat) nil {} nil - (s/cat) [5] ::s/invalid '[{:reason "Extra input", :pred (cat), :val (5), :in [0]}] - - either nil ::s/invalid '[{:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}] - either [] ::s/invalid '[{:reason "Insufficient input", :pred (alt :a string? :b keyword?), :val () :via []}] - either [:k] [:b :k] nil - either ["s"] [:a "s"] nil - either [:b "s"] ::s/invalid '[{:reason "Extra input", :pred (alt :a string? :b keyword?), :val ("s") :via []}] - - star nil [] nil - star [] [] nil - star [:k] [:k] nil - star [:k1 :k2] [:k1 :k2] nil - star [:k1 :k2 "x"] ::s/invalid '[{:pred keyword?, :val "x" :via []}] - star ["a"] ::s/invalid '[{:pred keyword?, :val "a" :via []}] - - plus nil ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val () :via []}] - plus [] ::s/invalid '[{:reason "Insufficient input", :pred keyword?, :val () :via []}] - plus [:k] [:k] nil - plus [:k1 :k2] [:k1 :k2] nil - plus [:k1 :k2 "x"] ::s/invalid '[{:pred keyword?, :val "x", :in [2]}] - plus ["a"] ::s/invalid '[{:pred keyword?, :val "a" :via []}] - - opt nil nil nil - opt [] nil nil - opt :k ::s/invalid '[{:pred (? keyword?), :val :k}] - opt [:k] :k nil - opt [:k1 :k2] ::s/invalid '[{:reason "Extra input", :pred (? keyword?), :val (:k2)}] - opt [:k1 :k2 "x"] ::s/invalid '[{:reason "Extra input", :pred (? keyword?), :val (:k2 "x")}] - opt ["a"] ::s/invalid '[{:pred keyword?, :val "a"}] - - andre nil nil nil - andre [] nil nil - andre :k :clojure.spec/invalid '[{:pred (& (* keyword?) even-count?), :val :k}] - andre [:k] ::s/invalid '[{:pred even-count?, :val [:k]}] - andre [:j :k] [:j :k] nil - - m nil ::s/invalid '[{:pred map?, :val nil}] - m {} {} nil - m {:a "b"} {:a "b"} nil - - mkeys nil ::s/invalid '[{:pred map?, :val nil}] - mkeys {} {} nil - mkeys {:a 1 :b 2} {:a 1 :b 2} nil - - mkeys2 nil ::s/invalid '[{:pred map?, :val nil}] - mkeys2 {} {} nil - mkeys2 {:a 1 :b 2} {"a" 1 "b" 2} nil - - s '([:a 1] [:b "2"]) '({:tag :a :val 1} {:tag :b :val "2"}) nil - - v [:a :b] [:a :b] nil - v '(:a :b) ::s/invalid '[{:pred vector? :val (:a :b)}] - - coll nil ::s/invalid '[{:path [], :pred coll?, :val nil, :via [], :in []}] - coll [] [] nil - coll [:a] [:a] nil - coll [:a :b] [:a :b] nil - coll (map identity [:a :b]) '(:a :b) nil - ;;coll [:a "b"] ::s/invalid '[{:pred (coll-checker keyword?), :val [:a b]}] - ))) - -(defn check-conform-unform [spec vals expected-conforms] - (let [actual-conforms (map #(s/conform spec %) vals) - unforms (map #(s/unform spec %) actual-conforms)] - (is (= actual-conforms expected-conforms)) - (is (= vals unforms)))) - -(deftest nilable-conform-unform - (check-conform-unform - (s/nilable int?) - [5 nil] - [5 nil]) - (check-conform-unform - (s/nilable (s/or :i int? :s string?)) - [5 "x" nil] - [[:i 5] [:s "x"] nil])) - -(deftest nonconforming-conform-unform - (check-conform-unform - (s/nonconforming (s/or :i int? :s string?)) - [5 "x"] - [5 "x"])) - -(deftest coll-form - (are [spec form] - (= (s/form spec) form) - (s/map-of int? any?) - '(clojure.spec/map-of clojure.core/int? clojure.core/any?) - - (s/coll-of int?) - '(clojure.spec/coll-of clojure.core/int?) - - (s/every-kv int? int?) - '(clojure.spec/every-kv clojure.core/int? clojure.core/int?) - - (s/every int?) - '(clojure.spec/every clojure.core/int?) - - (s/coll-of (s/tuple (s/tuple int?))) - '(clojure.spec/coll-of (clojure.spec/tuple (clojure.spec/tuple clojure.core/int?))) - - (s/coll-of int? :kind vector?) - '(clojure.spec/coll-of clojure.core/int? :kind clojure.core/vector?) - - (s/coll-of int? :gen #(gen/return [1 2])) - '(clojure.spec/coll-of clojure.core/int? :gen (fn* [] (gen/return [1 2]))))) - -(comment - (require '[clojure.test :refer (run-tests)]) - (in-ns 'clojure.test-clojure.spec) - (run-tests) - - ) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/transients.clj clojure-1.9.0/test/clojure/test_clojure/transients.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/transients.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/transients.clj 2017-12-08 13:59:39.000000000 +0000 @@ -53,3 +53,30 @@ t2 @(future (conj! t 4)) p (persistent! t2)] (is (= [1 2 3 4] p)))) + +(deftest transient-lookups + (let [tv (transient [1 2 3])] + (is (= 1 (get tv 0))) + (is (= :foo (get tv 4 :foo))) + (is (= true (contains? tv 0))) + (is (= [0 1] (find tv 0))) + (is (= nil (find tv -1)))) + (let [ts (transient #{1 2})] + (is (= true (contains? ts 1))) + (is (= false (contains? ts 99))) + (is (= 1 (get ts 1))) + (is (= nil (get ts 99)))) + (let [tam (transient (array-map :a 1 :b 2))] + (is (= true (contains? tam :a))) + (is (= false (contains? tam :x))) + (is (= 1 (get tam :a))) + (is (= nil (get tam :x))) + (is (= [:a 1] (find tam :a))) + (is (= nil (find tam :x)))) + (let [thm (transient (hash-map :a 1 :b 2))] + (is (= true (contains? thm :a))) + (is (= false (contains? thm :x))) + (is (= 1 (get thm :a))) + (is (= nil (get thm :x))) + (is (= [:a 1] (find thm :a))) + (is (= nil (find thm :x))))) diff -Nru clojure-1.9.0~alpha15/test/clojure/test_clojure/vectors.clj clojure-1.9.0/test/clojure/test_clojure/vectors.clj --- clojure-1.9.0~alpha15/test/clojure/test_clojure/vectors.clj 2017-03-14 15:52:23.000000000 +0000 +++ clojure-1.9.0/test/clojure/test_clojure/vectors.clj 2017-12-08 13:59:39.000000000 +0000 @@ -322,10 +322,11 @@ (vector-of :double) (vector-of :char)) (testing "with invalid type argument" - (are [x] (thrown? NullPointerException x) + (are [x] (thrown? IllegalArgumentException x) (vector-of nil) (vector-of Float/TYPE) (vector-of 'int) + (vector-of :integer) (vector-of "")))) (testing "vector-like (vector-of :type x1 x2 x3 … xn)" (are [vec gvec] (and (instance? clojure.core.Vec gvec) @@ -360,7 +361,15 @@ (vector-of :int #{1 2 3 4}) (vector-of :int (sorted-set 1 2 3 4)) (vector-of :int 1 2 "3") - (vector-of :int "1" "2" "3"))))) + (vector-of :int "1" "2" "3"))) + (testing "instances of IPersistentVector" + (are [gvec] (instance? clojure.lang.IPersistentVector gvec) + (vector-of :int 1 2 3) + (vector-of :double 1 2 3))) + (testing "fully implements IPersistentVector" + (are [gvec] (= 3 (.length gvec)) + (vector-of :int 1 2 3) + (vector-of :double 1 2 3))))) (deftest empty-vector-equality (let [colls [[] (vector-of :long) '()]] diff -Nru clojure-1.9.0~alpha15/test/java/compilation/ClassWithFailingStaticInitialiser.java clojure-1.9.0/test/java/compilation/ClassWithFailingStaticInitialiser.java --- clojure-1.9.0~alpha15/test/java/compilation/ClassWithFailingStaticInitialiser.java 1970-01-01 00:00:00.000000000 +0000 +++ clojure-1.9.0/test/java/compilation/ClassWithFailingStaticInitialiser.java 2017-12-08 13:59:39.000000000 +0000 @@ -0,0 +1,13 @@ +package compilation; + +public class ClassWithFailingStaticInitialiser { + static { + // Static analysis refuses to compile a static initialiser + // which will always throw, so we pretend to branch. This may + // need updating if the static analysis gets cleverer in the + // future + if(true) { + throw new AssertionError("Static Initialiser was run when it shouldn't have been"); + } + } +}