summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRich Hickey <richhickey@gmail.com>2010-08-22 14:12:05 -0400
committerRich Hickey <richhickey@gmail.com>2010-08-22 14:12:05 -0400
commitc6fddcabebd1dec50ea535d7576615da57fc0112 (patch)
treee197a4af918f6b6150337fcdea0c2805c190f350
parent07f05862c2362f6b51e7c92ccd9476c45c9dff6e (diff)
parent77be185a6ca00a338a6647462e14206bad0e9802 (diff)
Merged branch 'master' into equivmerge
Conflicts were: src/clj/clojure/core.clj src/jvm/clojure/lang/Compiler.java src/jvm/clojure/lang/Util.java test/clojure/test_clojure/protocols.clj
-rw-r--r--clojure.iml4
-rw-r--r--src/clj/clojure/core.clj62
-rw-r--r--src/clj/clojure/core_deftype.clj78
-rw-r--r--src/clj/clojure/genclass.clj11
-rw-r--r--src/clj/clojure/gvec.clj31
-rw-r--r--src/clj/clojure/java/io.clj8
-rw-r--r--src/clj/clojure/java/shell.clj98
-rw-r--r--src/clj/clojure/main.clj1
-rw-r--r--src/clj/clojure/pprint/pprint_base.clj19
-rw-r--r--src/clj/clojure/set.clj2
-rw-r--r--src/jvm/clojure/lang/APersistentMap.java759
-rw-r--r--src/jvm/clojure/lang/Compiler.java11
-rw-r--r--src/jvm/clojure/lang/DynamicClassLoader.java33
-rw-r--r--src/jvm/clojure/lang/Keyword.java16
-rw-r--r--src/jvm/clojure/lang/MapEquivalence.java17
-rw-r--r--src/jvm/clojure/lang/Namespace.java9
-rw-r--r--src/jvm/clojure/lang/Util.java77
-rw-r--r--test/clojure/test_clojure/control.clj2
-rw-r--r--test/clojure/test_clojure/genclass.clj17
-rw-r--r--test/clojure/test_clojure/helpers.clj35
-rw-r--r--test/clojure/test_clojure/java/io.clj22
-rw-r--r--test/clojure/test_clojure/java/shell.clj22
-rw-r--r--test/clojure/test_clojure/logic.clj2
-rw-r--r--test/clojure/test_clojure/main.clj2
-rw-r--r--test/clojure/test_clojure/multimethods.clj145
-rw-r--r--test/clojure/test_clojure/pprint/test_pretty.clj27
-rw-r--r--test/clojure/test_clojure/protocols.clj25
-rw-r--r--test/clojure/test_clojure/rt.clj20
-rw-r--r--test/clojure/test_clojure/test_utils.clj33
29 files changed, 906 insertions, 682 deletions
diff --git a/clojure.iml b/clojure.iml
index 83686b75..183e1ddd 100644
--- a/clojure.iml
+++ b/clojure.iml
@@ -36,9 +36,5 @@
</library>
</orderEntry>
</component>
- <component name="VcsManagerConfiguration">
- <option name="ACTIVE_VCS_NAME" value="svn" />
- <option name="USE_PROJECT_VCS" value="false" />
- </component>
</module>
diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index 55d4d588..eaab3aaf 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -847,19 +847,19 @@
;; reduce is defined again later after InternalReduce loads
(defn ^:private ^:static
reduce1
- ([f coll]
- (let [s (seq coll)]
- (if s
+ ([f coll]
+ (let [s (seq coll)]
+ (if s
(reduce1 f (first s) (next s))
- (f))))
- ([f val coll]
- (let [s (seq coll)]
- (if s
- (if (chunked-seq? s)
- (recur f
- (.reduce (chunk-first s) f val)
- (chunk-next s))
- (recur f (f val (first s)) (next s)))
+ (f))))
+ ([f val coll]
+ (let [s (seq coll)]
+ (if s
+ (if (chunked-seq? s)
+ (recur f
+ (.reduce (chunk-first s) f val)
+ (chunk-next s))
+ (recur f (f val (first s)) (next s)))
val))))
(defn reverse
@@ -4884,6 +4884,8 @@
:descendants (tf (:descendants h) parent ta tag td)})
h))))
+(declare flatten)
+
(defn underive
"Removes a parent/child relationship between parent and
tag. h must be a hierarchy obtained from make-hierarchy, if not
@@ -4891,20 +4893,18 @@
{:added "1.0"}
([tag parent] (alter-var-root #'global-hierarchy underive tag parent) nil)
([h tag parent]
- (let [tp (:parents h)
- td (:descendants h)
- ta (:ancestors h)
- tf (fn [m source sources target targets]
- (reduce1
- (fn [ret k]
- (assoc ret k
- (reduce1 disj (get targets k) (cons target (targets target)))))
- m (cons source (sources source))))]
- (if (contains? (tp tag) parent)
- {:parent (assoc (:parents h) tag (disj (get tp tag) parent))
- :ancestors (tf (:ancestors h) tag td parent ta)
- :descendants (tf (:descendants h) parent ta tag td)}
- h))))
+ (let [parentMap (:parents h)
+ childsParents (if (parentMap tag)
+ (disj (parentMap tag) parent) #{})
+ newParents (if (not-empty childsParents)
+ (assoc parentMap tag childsParents)
+ (dissoc parentMap tag))
+ deriv-seq (flatten (map #(cons (key %) (interpose (key %) (val %)))
+ (seq newParents)))]
+ (if (contains? (parentMap tag) parent)
+ (reduce1 #(apply derive %1 %2) (make-hierarchy)
+ (partition 2 deriv-seq))
+ h))))
(defn distinct?
@@ -5745,7 +5745,6 @@
(load "gvec")
;; redefine reduce with internal-reduce
-
(defn reduce
"f should be a function of 2 arguments. If val is not supplied,
returns the result of applying f to the first 2 items in coll, then
@@ -5802,11 +5801,11 @@
(defn spit
"Opposite of slurp. Opens f with writer, writes content, then
- closes f."
+ closes f. Options passed to clojure.java.io/writer."
{:added "1.2"}
[f content & options]
(with-open [#^java.io.Writer w (apply jio/writer f options)]
- (.write w content)))
+ (.write w (str content))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; futures (needs proxy);;;;;;;;;;;;;;;;;;
(defn future-call
@@ -5833,9 +5832,8 @@
invoke the body in another thread, and will cache the result and
return it on all subsequent calls to deref/@. If the computation has
not yet finished, calls to deref/@ will block."
- {:added "1.1"
- :static true}
- [& body] `(future-call (fn [] ~@body)))
+ {:added "1.1"}
+ [& body] `(future-call (^{:once true} fn* [] ~@body)))
(defn future-cancel
diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj
index f556f25a..344f9811 100644
--- a/src/clj/clojure/core_deftype.clj
+++ b/src/clj/clojure/core_deftype.clj
@@ -70,11 +70,11 @@
or more method bodies:
protocol-or-interface-or-Object
- (methodName [args*] body)*
+ (methodName [args+] body)*
Methods should be supplied for all methods of the desired
protocol(s) and interface(s). You can also define overrides for
- methods of Object. Note that a parameter must be supplied to
+ methods of Object. Note that the first parameter must be supplied to
correspond to the target object ('this' in Java parlance). Thus
methods for interfaces will take one more argument than do the
interface declarations. Note also that recur calls to the method
@@ -97,12 +97,12 @@
(str (let [f \"foo\"]
(reify Object
- (toString [] f))))
+ (toString [this] f))))
== \"foo\"
(seq (let [f \"foo\"]
(reify clojure.lang.Seqable
- (seq [] (seq f)))))
+ (seq [this] (seq f)))))
== (\\f \\o \\o))"
{:added "1.2"}
[& opts+specs]
@@ -151,14 +151,8 @@
[(eqhash [[i m]]
[i
(conj m
- `(hashCode [this#] (-> ~tag hash ~@(map #(list `hash-combine %) (remove #{'__meta} fields))))
- `(equals [this# ~gs]
- (boolean
- (or (identical? this# ~gs)
- (when (identical? (class this#) (class ~gs))
- (let [~gs ~(with-meta gs {:tag tagname})]
- (and ~@(map (fn [fld] `(= ~fld (. ~gs ~fld))) base-fields)
- (= ~'__extmap (. ~gs ~'__extmap)))))))))])
+ `(hashCode [this#] (clojure.lang.APersistentMap/mapHash this#))
+ `(equals [this# ~gs] (clojure.lang.APersistentMap/mapEquals this# ~gs)))])
(iobj [[i m]]
[(conj i 'clojure.lang.IObj)
(conj m `(meta [this#] ~'__meta)
@@ -190,13 +184,19 @@
`(count [this#] (+ ~(count base-fields) (count ~'__extmap)))
`(empty [this#] (throw (UnsupportedOperationException. (str "Can't create empty: " ~(str classname)))))
`(cons [this# e#] ((var imap-cons) this# e#))
- `(equiv [this# o#] (.equals this# o#))
+ `(equiv [this# ~gs]
+ (boolean
+ (or (identical? this# ~gs)
+ (when (identical? (class this#) (class ~gs))
+ (let [~gs ~(with-meta gs {:tag tagname})]
+ (and ~@(map (fn [fld] `(= ~fld (. ~gs ~fld))) base-fields)
+ (= ~'__extmap (. ~gs ~'__extmap))))))))
`(containsKey [this# k#] (not (identical? this# (.valAt this# k# this#))))
`(entryAt [this# k#] (let [v# (.valAt this# k# this#)]
(when-not (identical? this# v#)
(clojure.lang.MapEntry. k# v#))))
- `(seq [this#] (concat [~@(map #(list `new `clojure.lang.MapEntry (keyword %) %) base-fields)]
- ~'__extmap))
+ `(seq [this#] (seq (concat [~@(map #(list `new `clojure.lang.MapEntry (keyword %) %) base-fields)]
+ ~'__extmap)))
`(assoc [this# k# ~gs]
(condp identical? k#
~@(mapcat (fn [fld]
@@ -212,7 +212,7 @@
(conj m
`(size [this#] (.count this#))
`(isEmpty [this#] (= 0 (.count this#)))
- `(containsValue [this# v#] (-> this# vals (.contains v#)))
+ `(containsValue [this# v#] (boolean (some #{v#} (vals this#))))
`(get [this# k#] (.valAt this# k#))
`(put [this# k# v#] (throw (UnsupportedOperationException.)))
`(remove [this# k#] (throw (UnsupportedOperationException.)))
@@ -581,18 +581,18 @@
\"A doc string for AProtocol abstraction\"
;method signatures
- (bar [a b] \"bar docs\")
- (baz [a] [a b] [a b c] \"baz docs\"))
+ (bar [this a b] \"bar docs\")
+ (baz [this a] [this a b] [this a b c] \"baz docs\"))
No implementations are provided. Docs can be specified for the
protocol overall and for each method. The above yields a set of
polymorphic functions and a protocol object. All are
namespace-qualified by the ns enclosing the definition The resulting
- functions dispatch on the type of their first argument, and thus
- must have at least one argument. defprotocol is dynamic, has no
- special compile-time effect, and defines no new types or classes
- Implementations of the protocol methods can be provided using
- extend.
+ functions dispatch on the type of their first argument, which is
+ required and corresponds to the implicit target object ('this' in
+ Java parlance). defprotocol is dynamic, has no special compile-time
+ effect, and defines no new types or classes. Implementations of
+ the protocol methods can be provided using extend.
defprotocol will automatically generate a corresponding interface,
with the same name as the protocol, i.e. given a protocol:
@@ -604,23 +604,25 @@
reify, as they support the protocol directly:
(defprotocol P
- (foo [x])
- (bar-me [x] [x y]))
+ (foo [this])
+ (bar-me [this] [this y]))
(deftype Foo [a b c]
P
- (foo [] a)
- (bar-me [] b)
- (bar-me [y] (+ c y)))
+ (foo [this] a)
+ (bar-me [this] b)
+ (bar-me [this y] (+ c y)))
- (bar-me (Foo 1 2 3) 42)
+ (bar-me (Foo. 1 2 3) 42)
+ => 45
(foo
(let [x 42]
(reify P
- (foo [] 17)
- (bar-me [] x)
- (bar-me [y] x))))"
+ (foo [this] 17)
+ (bar-me [this] x)
+ (bar-me [this y] x))))
+ => 17"
{:added "1.2"}
[name & opts+sigs]
(emit-protocol name opts+sigs))
@@ -729,13 +731,13 @@
"Useful when you want to provide several implementations of the same
protocol all at once. Takes a single protocol and the implementation
of that protocol for one or more types. Expands into calls to
- extend-type and extend-class:
+ extend-type:
(extend-protocol Protocol
- ::AType
+ AType
(foo [x] ...)
(bar [x y] ...)
- ::BType
+ BType
(foo [x] ...)
(bar [x y] ...)
AClass
@@ -748,13 +750,13 @@
expands into:
(do
- (clojure.core/extend-type ::AType Protocol
+ (clojure.core/extend-type AType Protocol
(foo [x] ...)
(bar [x y] ...))
- (clojure.core/extend-type ::BType Protocol
+ (clojure.core/extend-type BType Protocol
(foo [x] ...)
(bar [x y] ...))
- (clojure.core/extend-class AClass Protocol
+ (clojure.core/extend-type AClass Protocol
(foo [x] ...)
(bar [x y] ...))
(clojure.core/extend-type nil Protocol
diff --git a/src/clj/clojure/genclass.clj b/src/clj/clojure/genclass.clj
index a1e0fcdb..052d0cbb 100644
--- a/src/clj/clojure/genclass.clj
+++ b/src/clj/clojure/genclass.clj
@@ -90,7 +90,18 @@
strx
(str "java.lang." strx))))))
+;; someday this can be made codepoint aware
+(defn- valid-java-method-name
+ [^String s]
+ (= s (clojure.lang.Compiler/munge s)))
+
+(defn- validate-generate-class-options
+ [{:keys [methods]}]
+ (let [[mname] (remove valid-java-method-name (map (comp str first) methods))]
+ (when mname (throw (IllegalArgumentException. (str "Not a valid method name: " mname))))))
+
(defn- generate-class [options-map]
+ (validate-generate-class-options options-map)
(let [default-options {:prefix "-" :load-impl-ns true :impl-ns (ns-name *ns*)}
{:keys [name extends implements constructors methods main factory state init exposes
exposes-methods prefix load-impl-ns impl-ns post-init]}
diff --git a/src/clj/clojure/gvec.clj b/src/clj/clojure/gvec.clj
index 1b3443a5..fa1ba03e 100644
--- a/src/clj/clojure/gvec.clj
+++ b/src/clj/clojure/gvec.clj
@@ -19,7 +19,7 @@
(definterface IVecImpl
(^int tailoff [])
(arrayFor [^int i])
- (pushTail [^int level parent tailnode])
+ (pushTail [^int level ^clojure.core.VecNode parent ^clojure.core.VecNode tailnode])
(popTail [^int level node])
(newPath [edit ^int level node])
(doAssoc [^int level node ^int i val]))
@@ -119,7 +119,7 @@
(defmethod print-method ::VecSeq [v w]
((get (methods print-method) clojure.lang.ISeq) v w))
-(deftype Vec [^clojure.core.ArrayManager am ^int cnt ^int shift root tail _meta]
+(deftype Vec [^clojure.core.ArrayManager am ^int cnt ^int shift ^clojure.core.VecNode root tail _meta]
Object
(equals [this o]
(cond
@@ -212,7 +212,7 @@
(new Vec am (dec cnt) shift root new-tail (meta this)))
:else
(let [new-tail (.arrayFor this (- cnt 2))
- new-root (.popTail this shift root)]
+ new-root ^clojure.core.VecNode (.popTail this shift root)]
(cond
(nil? new-root)
(new Vec am (dec cnt) shift EMPTY-NODE new-tail (meta this))
@@ -300,6 +300,7 @@
(pushTail [this level parent tailnode]
(let [subidx (bit-and (bit-shift-right (dec cnt) level) (int 0x1f))
+ parent ^clojure.core.VecNode parent
ret (VecNode. (.edit parent) (aclone ^objects (.arr parent)))
node-to-insert (if (= level (int 5))
tailnode
@@ -311,7 +312,8 @@
ret))
(popTail [this level node]
- (let [subidx (bit-and (bit-shift-right (- cnt 2) level) (int 0x1f))]
+ (let [node ^clojure.core.VecNode node
+ subidx (bit-and (bit-shift-right (- cnt (int 2)) level) (int 0x1f))]
(cond
(> level 5)
(let [new-child (.popTail this (- level 5) (aget ^objects (.arr node) subidx))]
@@ -332,16 +334,17 @@
(aset ^objects (.arr ret) 0 (.newPath this edit (- level (int 5)) node))
ret)))
- (doAssoc [this level node i val]
- (if (zero? level)
- ;on this branch, array will need val type
- (let [arr (.aclone am (.arr node))]
- (.aset am arr (bit-and i (int 0x1f)) val)
- (VecNode. (.edit node) arr))
- (let [arr (aclone ^objects (.arr node))
- subidx (bit-and (bit-shift-right i level) (int 0x1f))]
- (aset arr subidx (.doAssoc this (- level (int 5)) (aget arr subidx) i val))
- (VecNode. (.edit node) arr))))
+ (doAssoc [this level node i val]
+ (let [node ^clojure.core.VecNode node]
+ (if (zero? level)
+ ;on this branch, array will need val type
+ (let [arr (.aclone am (.arr node))]
+ (.aset am arr (bit-and i (int 0x1f)) val)
+ (VecNode. (.edit node) arr))
+ (let [arr (aclone ^objects (.arr node))
+ subidx (bit-and (bit-shift-right i level) (int 0x1f))]
+ (aset arr subidx (.doAssoc this (- level (int 5)) (aget arr subidx) i val))
+ (VecNode. (.edit node) arr)))))
java.lang.Comparable
(compareTo [this o]
diff --git a/src/clj/clojure/java/io.clj b/src/clj/clojure/java/io.clj
index 4d6c551f..5f36755e 100644
--- a/src/clj/clojure/java/io.clj
+++ b/src/clj/clojure/java/io.clj
@@ -33,8 +33,8 @@
(defprotocol ^{:added "1.2"} Coercions
"Coerce between various 'resource-namish' things."
- (^{:tag File, :added "1.2"} as-file [x] "Coerce argument to a file.")
- (^{:tag URL, :added "1.2"} as-url [x] "Coerce argument to a URL."))
+ (^{:tag java.io.File, :added "1.2"} as-file [x] "Coerce argument to a file.")
+ (^{:tag java.net.URL, :added "1.2"} as-url [x] "Coerce argument to a URL."))
(extend-protocol Coercions
nil
@@ -259,8 +259,8 @@
(extend Socket
IOFactory
(assoc default-streams-impl
- :make-input-stream (fn [^Socket x opts] (.getInputStream x))
- :output-stream (fn [^Socket x opts] (output-stream (.getOutputStream x) opts))))
+ :make-input-stream (fn [^Socket x opts] (make-input-stream (.getInputStream x) opts))
+ :make-output-stream (fn [^Socket x opts] (make-output-stream (.getOutputStream x) opts))))
(extend byte-array-type
IOFactory
diff --git a/src/clj/clojure/java/shell.clj b/src/clj/clojure/java/shell.clj
index 11d908a5..004629df 100644
--- a/src/clj/clojure/java/shell.clj
+++ b/src/clj/clojure/java/shell.clj
@@ -11,8 +11,9 @@
:doc "Conveniently launch a sub-process providing its stdin and
collecting its stdout"}
clojure.java.shell
- (:use [clojure.java.io :only (as-file)])
- (:import (java.io InputStreamReader OutputStreamWriter)))
+ (:use [clojure.java.io :only (as-file copy)])
+ (:import (java.io OutputStreamWriter ByteArrayOutputStream StringWriter)
+ (java.nio.charset Charset)))
(def *sh-dir* nil)
(def *sh-env* nil)
@@ -31,11 +32,6 @@ collecting its stdout"}
`(binding [*sh-env* ~env]
~@forms))
-(defn- stream-seq
- "Takes an InputStream and returns a lazy seq of integers from the stream."
- [stream]
- (take-while #(>= % 0) (repeatedly #(.read stream))))
-
(defn- aconcat
"Concatenates arrays of given type."
[type & xs]
@@ -48,11 +44,12 @@ collecting its stdout"}
(defn- parse-args
[args]
- (let [default-opts {:out "UTF-8" :dir *sh-dir* :env *sh-env*}
+ (let [default-encoding "UTF-8" ;; see sh doc string
+ default-opts {:out-enc default-encoding :in-enc default-encoding :dir *sh-dir* :env *sh-env*}
[cmd opts] (split-with string? args)]
[cmd (merge default-opts (apply hash-map opts))]))
-(defn- as-env-string
+(defn- ^"[Ljava.lang.String;" as-env-strings
"Helper so that callers can pass a Clojure map for the :env to sh."
[arg]
(cond
@@ -60,22 +57,47 @@ collecting its stdout"}
(map? arg) (into-array String (map (fn [[k v]] (str (name k) "=" v)) arg))
true arg))
+(defn- stream-to-bytes
+ [in]
+ (with-open [bout (ByteArrayOutputStream.)]
+ (copy in bout)
+ (.toByteArray bout)))
+
+(defn- stream-to-string
+ ([in] (stream-to-string in (.name (Charset/defaultCharset))))
+ ([in enc]
+ (with-open [bout (StringWriter.)]
+ (copy in bout :encoding enc)
+ (.toString bout))))
+
+(defn- stream-to-enc
+ [stream enc]
+ (if (= enc :bytes)
+ (stream-to-bytes stream)
+ (stream-to-string stream enc)))
+
(defn sh
"Passes the given strings to Runtime.exec() to launch a sub-process.
Options are
- :in may be given followed by a String specifying text to be fed to the
- sub-process's stdin.
- :out option may be given followed by :bytes or a String. If a String
- is given, it will be used as a character encoding name (for
- example \"UTF-8\" or \"ISO-8859-1\") to convert the
- sub-process's stdout to a String which is returned.
- If :bytes is given, the sub-process's stdout will be stored in
- a byte array and returned. Defaults to UTF-8.
- :env override the process env with a map (or the underlying Java
- String[] if you are a masochist).
- :dir override the process dir with a String or java.io.File.
+ :in may be given followed by a String or byte array specifying input
+ to be fed to the sub-process's stdin.
+ :in-enc option may be given followed by a String, used as a character
+ encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to
+ convert the input string specified by the :in option to the
+ sub-process's stdin. Defaults to UTF-8.
+ If the :in option provides a byte array, then the bytes are passed
+ unencoded, and this option is ignored.
+ :out-enc option may be given followed by :bytes or a String. If a
+ String is given, it will be used as a character encoding
+ name (for example \"UTF-8\" or \"ISO-8859-1\") to convert
+ the sub-process's stdout to a String which is returned.
+ If :bytes is given, the sub-process's stdout will be stored
+ in a byte array and returned. Defaults to UTF-8.
+ :env override the process env with a map (or the underlying Java
+ String[] if you are a masochist).
+ :dir override the process dir with a String or java.io.File.
You can bind :env or :dir for multiple operations using with-sh-env
and with-sh-dir.
@@ -83,30 +105,29 @@ collecting its stdout"}
sh returns a map of
:exit => sub-process's exit code
:out => sub-process's stdout (as byte[] or String)
- :err => sub-process's stderr (as byte[] or String)"
+ :err => sub-process's stderr (String via platform default encoding)"
{:added "1.2"}
[& args]
(let [[cmd opts] (parse-args args)
proc (.exec (Runtime/getRuntime)
- (into-array cmd)
- (as-env-string (:env opts))
- (as-file (:dir opts)))]
- (println opts)
- (if (:in opts)
- (with-open [osw (OutputStreamWriter. (.getOutputStream proc))]
- (.write osw (:in opts)))
+ ^"[Ljava.lang.String;" (into-array cmd)
+ (as-env-strings (:env opts))
+ (as-file (:dir opts)))
+ {:keys [in in-enc out-enc]} opts]
+ (if in
+ (future
+ (if (instance? (class (byte-array 0)) in)
+ (with-open [os (.getOutputStream proc)]
+ (.write os ^"[B" in))
+ (with-open [osw (OutputStreamWriter. (.getOutputStream proc) ^String in-enc)]
+ (.write osw ^String in))))
(.close (.getOutputStream proc)))
(with-open [stdout (.getInputStream proc)
stderr (.getErrorStream proc)]
- (let [[out err]
- (if (= (:out opts) :bytes)
- (for [strm [stdout stderr]]
- (into-array Byte/TYPE (map byte (stream-seq strm))))
- (for [strm [stdout stderr]]
- (apply str (map char (stream-seq
- (InputStreamReader. strm (:out opts)))))))
+ (let [out (future (stream-to-enc stdout out-enc))
+ err (future (stream-to-string stderr))
exit-code (.waitFor proc)]
- {:exit exit-code :out out :err err}))))
+ {:exit exit-code :out @out :err @err}))))
(comment
@@ -115,7 +136,8 @@ collecting its stdout"}
(println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n"))
(println (sh "cat" :in "x\u25bax\n"))
(println (sh "echo" "x\u25bax"))
-(println (sh "echo" "x\u25bax" :out "ISO-8859-1")) ; reads 4 single-byte chars
-(println (sh "cat" "myimage.png" :out :bytes)) ; reads binary file into bytes[]
+(println (sh "echo" "x\u25bax" :out-enc "ISO-8859-1")) ; reads 4 single-byte chars
+(println (sh "cat" "myimage.png" :out-enc :bytes)) ; reads binary file into bytes[]
+(println (sh "cmd" "/c dir 1>&2"))
)
diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj
index 61fcae75..18bd932f 100644
--- a/src/clj/clojure/main.clj
+++ b/src/clj/clojure/main.clj
@@ -196,6 +196,7 @@
(set! *e e)))
(use '[clojure.repl :only (source apropos dir)])
(use '[clojure.java.javadoc :only (javadoc)])
+ (use '[clojure.pprint :only (pp pprint)])
(prompt)
(flush)
(loop []
diff --git a/src/clj/clojure/pprint/pprint_base.clj b/src/clj/clojure/pprint/pprint_base.clj
index 88e032d8..9ff74e85 100644
--- a/src/clj/clojure/pprint/pprint_base.clj
+++ b/src/clj/clojure/pprint/pprint_base.clj
@@ -311,14 +311,19 @@ and :suffix."
{:added "1.2", :arglists '[[options* body]]}
[& args]
(let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)]
- `(do (if (level-exceeded)
+ `(do (if (#'clojure.pprint/level-exceeded)
(.write ^java.io.Writer *out* "#")
- (binding [*current-level* (inc *current-level*)
- *current-length* 0]
- (start-block *out*
- ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options))
- ~@body
- (end-block *out*)))
+ (do
+ (push-thread-bindings {#'clojure.pprint/*current-level*
+ (inc (var-get #'clojure.pprint/*current-level*))
+ #'clojure.pprint/*current-length* 0})
+ (try
+ (#'clojure.pprint/start-block *out*
+ ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options))
+ ~@body
+ (#'clojure.pprint/end-block *out*)
+ (finally
+ (pop-thread-bindings)))))
nil)))
(defn pprint-newline
diff --git a/src/clj/clojure/set.clj b/src/clj/clojure/set.clj
index 835e6063..af0f65f6 100644
--- a/src/clj/clojure/set.clj
+++ b/src/clj/clojure/set.clj
@@ -82,7 +82,7 @@
(fn [m [old new]]
(if (and (not= old new)
(contains? m old))
- (-> m (assoc new (m old)) (dissoc old))
+ (-> m (assoc new (get m old)) (dissoc old))
m))
map kmap))
diff --git a/src/jvm/clojure/lang/APersistentMap.java b/src/jvm/clojure/lang/APersistentMap.java
index 0fe08cae..d27dcb0f 100644
--- a/src/jvm/clojure/lang/APersistentMap.java
+++ b/src/jvm/clojure/lang/APersistentMap.java
@@ -1,375 +1,384 @@
-/**
- * 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;
-
-import java.io.Serializable;
-import java.util.*;
-
-public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable {
-int _hash = -1;
-
-public String toString(){
- return RT.printString(this);
-}
-
-public IPersistentCollection cons(Object o){
- if(o instanceof Map.Entry)
- {
- Map.Entry e = (Map.Entry) o;
-
- return assoc(e.getKey(), e.getValue());
- }
- else if(o instanceof IPersistentVector)
- {
- IPersistentVector v = (IPersistentVector) o;
- if(v.count() != 2)
- throw new IllegalArgumentException("Vector arg to map conj must be a pair");
- return assoc(v.nth(0), v.nth(1));
- }
-
- IPersistentMap ret = this;
- for(ISeq es = RT.seq(o); es != null; es = es.next())
- {
- Map.Entry e = (Map.Entry) es.first();
- ret = ret.assoc(e.getKey(), e.getValue());
- }
- return ret;
-}
-
-public boolean equals(Object obj){
- if(this == obj) return true;
- if(!(obj instanceof Map))
- return false;
- Map m = (Map) obj;
-
- if(m.size() != size() || m.hashCode() != hashCode())
- return false;
-
- for(ISeq s = seq(); s != null; s = s.next())
- {
- Map.Entry e = (Map.Entry) s.first();
- boolean found = m.containsKey(e.getKey());
-
- if(!found || !Util.equals(e.getValue(), m.get(e.getKey())))
- return false;
- }
-
- return true;
-}
-
-public boolean equiv(Object obj){
- if(!(obj instanceof Map))
- return false;
- Map m = (Map) obj;
-
- if(m.size() != size())
- return false;
-
- for(ISeq s = seq(); s != null; s = s.next())
- {
- Map.Entry e = (Map.Entry) s.first();
- boolean found = m.containsKey(e.getKey());
-
- if(!found || !Util.equiv(e.getValue(), m.get(e.getKey())))
- return false;
- }
-
- return true;
-}
-public int hashCode(){
- if(_hash == -1)
- {
- //int hash = count();
- int hash = 0;
- for(ISeq s = seq(); s != null; s = s.next())
- {
- Map.Entry e = (Map.Entry) s.first();
- hash += (e.getKey() == null ? 0 : e.getKey().hashCode()) ^
- (e.getValue() == null ? 0 : e.getValue().hashCode());
- //hash ^= Util.hashCombine(Util.hash(e.getKey()), Util.hash(e.getValue()));
- }
- this._hash = hash;
- }
- return _hash;
-}
-
-static public class KeySeq extends ASeq{
- ISeq seq;
-
- static public KeySeq create(ISeq seq){
- if(seq == null)
- return null;
- return new KeySeq(seq);
- }
-
- private KeySeq(ISeq seq){
- this.seq = seq;
- }
-
- private KeySeq(IPersistentMap meta, ISeq seq){
- super(meta);
- this.seq = seq;
- }
-
- public Object first(){
- return ((Map.Entry) seq.first()).getKey();
- }
-
- public ISeq next(){
- return create(seq.next());
- }
-
- public KeySeq withMeta(IPersistentMap meta){
- return new KeySeq(meta, seq);
- }
-}
-
-static public class ValSeq extends ASeq{
- ISeq seq;
-
- static public ValSeq create(ISeq seq){
- if(seq == null)
- return null;
- return new ValSeq(seq);
- }
-
- private ValSeq(ISeq seq){
- this.seq = seq;
- }
-
- private ValSeq(IPersistentMap meta, ISeq seq){
- super(meta);
- this.seq = seq;
- }
-
- public Object first(){
- return ((Map.Entry) seq.first()).getValue();
- }
-
- public ISeq next(){
- return create(seq.next());
- }
-
- public ValSeq withMeta(IPersistentMap meta){
- return new ValSeq(meta, seq);
- }
-}
-
-
-public Object invoke(Object arg1) throws Exception{
- return valAt(arg1);
-}
-
-public Object invoke(Object arg1, Object notFound) throws Exception{
- return valAt(arg1, notFound);
-}
-
-// java.util.Map implementation
-
-public void clear(){
- throw new UnsupportedOperationException();
-}
-
-public boolean containsValue(Object value){
- return values().contains(value);
-}
-
-public Set entrySet(){
- return new AbstractSet(){
-
- public Iterator iterator(){
- return APersistentMap.this.iterator();
- }
-
- public int size(){
- return count();
- }
-
- public int hashCode(){
- return APersistentMap.this.hashCode();
- }
-
- public boolean contains(Object o){
- if(o instanceof Entry)
- {
- Entry e = (Entry) o;
- Entry found = entryAt(e.getKey());
- if(found != null && Util.equals(found.getValue(), e.getValue()))
- return true;
- }
- return false;
- }
- };
-}
-
-public Object get(Object key){
- return valAt(key);
-}
-
-public boolean isEmpty(){
- return count() == 0;
-}
-
-public Set keySet(){
- return new AbstractSet(){
-
- public Iterator iterator(){
- final Iterator mi = APersistentMap.this.iterator();
-
- return new Iterator(){
-
-
- public boolean hasNext(){
- return mi.hasNext();
- }
-
- public Object next(){
- Entry e = (Entry) mi.next();
- return e.getKey();
- }
-
- public void remove(){
- throw new UnsupportedOperationException();
- }
- };
- }
-
- public int size(){
- return count();
- }
-
- public boolean contains(Object o){
- return APersistentMap.this.containsKey(o);
- }
- };
-}
-
-public Object put(Object key, Object value){
- throw new UnsupportedOperationException();
-}
-
-public void putAll(Map t){
- throw new UnsupportedOperationException();
-}
-
-public Object remove(Object key){
- throw new UnsupportedOperationException();
-}
-
-public int size(){
- return count();
-}
-
-public Collection values(){
- return new AbstractCollection(){
-
- public Iterator iterator(){
- final Iterator mi = APersistentMap.this.iterator();
-
- return new Iterator(){
-
-
- public boolean hasNext(){
- return mi.hasNext();
- }
-
- public Object next(){
- Entry e = (Entry) mi.next();
- return e.getValue();
- }
-
- public void remove(){
- throw new UnsupportedOperationException();
- }
- };
- }
-
- public int size(){
- return count();
- }
- };
-}
-
-/*
-// java.util.Collection implementation
-
-public Object[] toArray(){
- return RT.seqToArray(seq());
-}
-
-public boolean add(Object o){
- throw new UnsupportedOperationException();
-}
-
-public boolean remove(Object o){
- throw new UnsupportedOperationException();
-}
-
-public boolean addAll(Collection c){
- throw new UnsupportedOperationException();
-}
-
-public void clear(){
- throw new UnsupportedOperationException();
-}
-
-public boolean retainAll(Collection c){
- throw new UnsupportedOperationException();
-}
-
-public boolean removeAll(Collection c){
- throw new UnsupportedOperationException();
-}
-
-public boolean containsAll(Collection c){
- for(Object o : c)
- {
- if(!contains(o))
- return false;
- }
- return true;
-}
-
-public Object[] toArray(Object[] a){
- if(a.length >= count())
- {
- ISeq s = seq();
- for(int i = 0; s != null; ++i, s = s.rest())
- {
- a[i] = s.first();
- }
- if(a.length > count())
- a[count()] = null;
- return a;
- }
- else
- return toArray();
-}
-
-public int size(){
- return count();
-}
-
-public boolean isEmpty(){
- return count() == 0;
-}
-
-public boolean contains(Object o){
- if(o instanceof Map.Entry)
- {
- Map.Entry e = (Map.Entry) o;
- Map.Entry v = entryAt(e.getKey());
- return (v != null && Util.equal(v.getValue(), e.getValue()));
- }
- return false;
-}
-*/
-}
+/**
+ * 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;
+
+import java.io.Serializable;
+import java.util.*;
+
+public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable, MapEquivalence {
+int _hash = -1;
+
+public String toString(){
+ return RT.printString(this);
+}
+
+public IPersistentCollection cons(Object o){
+ if(o instanceof Map.Entry)
+ {
+ Map.Entry e = (Map.Entry) o;
+
+ return assoc(e.getKey(), e.getValue());
+ }
+ else if(o instanceof IPersistentVector)
+ {
+ IPersistentVector v = (IPersistentVector) o;
+ if(v.count() != 2)
+ throw new IllegalArgumentException("Vector arg to map conj must be a pair");
+ return assoc(v.nth(0), v.nth(1));
+ }
+
+ IPersistentMap ret = this;
+ for(ISeq es = RT.seq(o); es != null; es = es.next())
+ {
+ Map.Entry e = (Map.Entry) es.first();
+ ret = ret.assoc(e.getKey(), e.getValue());
+ }
+ return ret;
+}
+
+public boolean equals(Object obj){
+ return mapEquals(this, obj);
+}
+
+static public boolean mapEquals(IPersistentMap m1, Object obj){
+ if(m1 == obj) return true;
+ if(!(obj instanceof Map))
+ return false;
+ Map m = (Map) obj;
+
+ if(m.size() != m1.count() || m.hashCode() != m1.hashCode())
+ return false;
+
+ for(ISeq s = m1.seq(); s != null; s = s.next())
+ {
+ Map.Entry e = (Map.Entry) s.first();
+ boolean found = m.containsKey(e.getKey());
+
+ if(!found || !Util.equals(e.getValue(), m.get(e.getKey())))
+ return false;
+ }
+
+ return true;
+}
+
+public boolean equiv(Object obj){
+ if(!(obj instanceof Map))
+ return false;
+ if(obj instanceof IPersistentMap && !(obj instanceof MapEquivalence))
+ return false;
+
+ Map m = (Map) obj;
+
+ if(m.size() != size())
+ return false;
+
+ for(ISeq s = seq(); s != null; s = s.next())
+ {
+ Map.Entry e = (Map.Entry) s.first();
+ boolean found = m.containsKey(e.getKey());
+
+ if(!found || !Util.equiv(e.getValue(), m.get(e.getKey())))
+ return false;
+ }
+
+ return true;
+}
+public int hashCode(){
+ if(_hash == -1)
+ {
+ this._hash = mapHash(this);
+ }
+ return _hash;
+}
+
+static public int mapHash(IPersistentMap m){
+ int hash = 0;
+ for(ISeq s = m.seq(); s != null; s = s.next())
+ {
+ Map.Entry e = (Map.Entry) s.first();
+ hash += (e.getKey() == null ? 0 : e.getKey().hashCode()) ^
+ (e.getValue() == null ? 0 : e.getValue().hashCode());
+ }
+ return hash;
+}
+
+static public class KeySeq extends ASeq{
+ ISeq seq;
+
+ static public KeySeq create(ISeq seq){
+ if(seq == null)
+ return null;
+ return new KeySeq(seq);
+ }
+
+ private KeySeq(ISeq seq){
+ this.seq = seq;
+ }
+
+ private KeySeq(IPersistentMap meta, ISeq seq){
+ super(meta);
+ this.seq = seq;
+ }
+
+ public Object first(){
+ return ((Map.Entry) seq.first()).getKey();
+ }
+
+ public ISeq next(){
+ return create(seq.next());
+ }
+
+ public KeySeq withMeta(IPersistentMap meta){
+ return new KeySeq(meta, seq);
+ }
+}
+
+static public class ValSeq extends ASeq{
+ ISeq seq;
+
+ static public ValSeq create(ISeq seq){
+ if(seq == null)
+ return null;
+ return new ValSeq(seq);
+ }
+
+ private ValSeq(ISeq seq){
+ this.seq = seq;
+ }
+
+ private ValSeq(IPersistentMap meta, ISeq seq){
+ super(meta);
+ this.seq = seq;
+ }
+
+ public Object first(){
+ return ((Map.Entry) seq.first()).getValue();
+ }
+
+ public ISeq next(){
+ return create(seq.next());
+ }
+
+ public ValSeq withMeta(IPersistentMap meta){
+ return new ValSeq(meta, seq);
+ }
+}
+
+
+public Object invoke(Object arg1) throws Exception{
+ return valAt(arg1);
+}
+
+public Object invoke(Object arg1, Object notFound) throws Exception{
+ return valAt(arg1, notFound);
+}
+
+// java.util.Map implementation
+
+public void clear(){
+ throw new UnsupportedOperationException();
+}
+
+public boolean containsValue(Object value){
+ return values().contains(value);
+}
+
+public Set entrySet(){
+ return new AbstractSet(){
+
+ public Iterator iterator(){
+ return APersistentMap.this.iterator();
+ }
+
+ public int size(){
+ return count();
+ }
+
+ public int hashCode(){
+ return APersistentMap.this.hashCode();
+ }
+
+ public boolean contains(Object o){
+ if(o instanceof Entry)
+ {
+ Entry e = (Entry) o;
+ Entry found = entryAt(e.getKey());
+ if(found != null && Util.equals(found.getValue(), e.getValue()))
+ return true;
+ }
+ return false;
+ }
+ };
+}
+
+public Object get(Object key){
+ return valAt(key);
+}
+
+public boolean isEmpty(){
+ return count() == 0;
+}
+
+public Set keySet(){
+ return new AbstractSet(){
+
+ public Iterator iterator(){
+ final Iterator mi = APersistentMap.this.iterator();
+
+ return new Iterator(){
+
+
+ public boolean hasNext(){
+ return mi.hasNext();
+ }
+
+ public Object next(){
+ Entry e = (Entry) mi.next();
+ return e.getKey();
+ }
+
+ public void remove(){
+ throw new UnsupportedOperationException();
+ }
+ };
+ }
+
+ public int size(){
+ return count();
+ }
+
+ public boolean contains(Object o){
+ return APersistentMap.this.containsKey(o);
+ }
+ };
+}
+
+public Object put(Object key, Object value){
+ throw new UnsupportedOperationException();
+}
+
+public void putAll(Map t){
+ throw new UnsupportedOperationException();
+}
+
+public Object remove(Object key){
+ throw new UnsupportedOperationException();
+}
+
+public int size(){
+ return count();
+}
+
+public Collection values(){
+ return new AbstractCollection(){
+
+ public Iterator iterator(){
+ final Iterator mi = APersistentMap.this.iterator();
+
+ return new Iterator(){
+
+
+ public boolean hasNext(){
+ return mi.hasNext();
+ }
+
+ public Object next(){
+ Entry e = (Entry) mi.next();
+ return e.getValue();
+ }
+
+ public void remove(){
+ throw new UnsupportedOperationException();
+ }
+ };
+ }
+
+ public int size(){
+ return count();
+ }
+ };
+}
+
+/*
+// java.util.Collection implementation
+
+public Object[] toArray(){
+ return RT.seqToArray(seq());
+}
+
+public boolean add(Object o){
+ throw new UnsupportedOperationException();
+}
+
+public boolean remove(Object o){
+ throw new UnsupportedOperationException();
+}
+
+public boolean addAll(Collection c){
+ throw new UnsupportedOperationException();
+}
+
+public void clear(){
+ throw new UnsupportedOperationException();
+}
+
+public boolean retainAll(Collection c){
+ throw new UnsupportedOperationException();
+}
+
+public boolean removeAll(Collection c){
+ throw new UnsupportedOperationException();
+}
+
+public boolean containsAll(Collection c){
+ for(Object o : c)
+ {
+ if(!contains(o))
+ return false;
+ }
+ return true;
+}
+
+public Object[] toArray(Object[] a){
+ if(a.length >= count())
+ {
+ ISeq s = seq();
+ for(int i = 0; s != null; ++i, s = s.rest())
+ {
+ a[i] = s.first();
+ }
+ if(a.length > count())
+ a[count()] = null;
+ return a;
+ }
+ else
+ return toArray();
+}
+
+public int size(){
+ return count();
+}
+
+public boolean isEmpty(){
+ return count() == 0;
+}
+
+public boolean contains(Object o){
+ if(o instanceof Map.Entry)
+ {
+ Map.Entry e = (Map.Entry) o;
+ Map.Entry v = entryAt(e.getKey());
+ return (v != null && Util.equal(v.getValue(), e.getValue()));
+ }
+ return false;
+}
+*/
+}
diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java
index 1c6bfdc1..d318cde3 100644
--- a/src/jvm/clojure/lang/Compiler.java
+++ b/src/jvm/clojure/lang/Compiler.java
@@ -1831,7 +1831,6 @@ public static class TryExpr implements Expr{
public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
Label startTry = gen.newLabel();
Label endTry = gen.newLabel();
- Label endTryCatch = gen.newLabel();
Label end = gen.newLabel();
Label ret = gen.newLabel();
Label finallyLabel = gen.newLabel();
@@ -1867,7 +1866,6 @@ public static class TryExpr implements Expr{
finallyExpr.emit(C.STATEMENT, objx, gen);
gen.goTo(ret);
}
- gen.mark(endTryCatch);
if(finallyExpr != null)
{
gen.mark(finallyLabel);
@@ -1887,7 +1885,14 @@ public static class TryExpr implements Expr{
gen.visitTryCatchBlock(startTry, endTry, clause.label, clause.c.getName().replace('.', '/'));
}
if(finallyExpr != null)
- gen.visitTryCatchBlock(startTry, endTryCatch, finallyLabel, null);
+ {
+ gen.visitTryCatchBlock(startTry, endTry, finallyLabel, null);
+ for(int i = 0; i < catchExprs.count(); i++)
+ {
+ CatchClause clause = (CatchClause) catchExprs.nth(i);
+ gen.visitTryCatchBlock(clause.label, clause.endLabel, finallyLabel, null);
+ }
+ }
for(int i = 0; i < catchExprs.count(); i++)
{
CatchClause clause = (CatchClause) catchExprs.nth(i);
diff --git a/src/jvm/clojure/lang/DynamicClassLoader.java b/src/jvm/clojure/lang/DynamicClassLoader.java
index 3f3ab35e..8719dc18 100644
--- a/src/jvm/clojure/lang/DynamicClassLoader.java
+++ b/src/jvm/clojure/lang/DynamicClassLoader.java
@@ -14,19 +14,21 @@ package clojure.lang;
import java.util.HashMap;
import java.util.Map;
-import java.util.Arrays;
import java.util.concurrent.ConcurrentHashMap;
import java.net.URLClassLoader;
import java.net.URL;
-import java.lang.ref.WeakReference;
+import java.lang.ref.ReferenceQueue;
+import java.lang.ref.SoftReference;
public class DynamicClassLoader extends URLClassLoader{
HashMap<Integer, Object[]> constantVals = new HashMap<Integer, Object[]>();
-static ConcurrentHashMap<String, Map.Entry<WeakReference<Class>,Object> >classCache =
- new ConcurrentHashMap<String, Map.Entry<WeakReference<Class>,Object> >();
+static ConcurrentHashMap<String, SoftReference<Class>>classCache =
+ new ConcurrentHashMap<String, SoftReference<Class> >();
static final URL[] EMPTY_URLS = new URL[]{};
+static final ReferenceQueue rq = new ReferenceQueue();
+
public DynamicClassLoader(){
//pseudo test in lieu of hasContextClassLoader()
super(EMPTY_URLS,(Thread.currentThread().getContextClassLoader() == null ||
@@ -39,29 +41,20 @@ public DynamicClassLoader(ClassLoader parent){
}
public Class defineClass(String name, byte[] bytes, Object srcForm){
-// Map.Entry<WeakReference<Class>,Object> ce = classCache.get(name);
-// if(ce != null)
-// {
-// WeakReference<Class> cr = ce.getKey();
-// Class c = cr.get();
-// if((c != null) && srcForm.equals(ce.getValue()))
-// return c;
-// }
+ Util.clearCache(rq, classCache);
Class c = defineClass(name, bytes, 0, bytes.length);
- classCache.put(name, new MapEntry(new WeakReference(c), null));
+ classCache.put(name, new SoftReference(c,rq));
return c;
}
protected Class<?> findClass(String name) throws ClassNotFoundException{
- Map.Entry<WeakReference<Class>,Object> ce = classCache.get(name);
- if(ce != null)
- {
- WeakReference<Class> cr = ce.getKey();
- Class c = cr.get();
+ SoftReference<Class> cr = classCache.get(name);
+ if(cr != null)
+ {
+ Class c = cr.get();
if(c != null)
return c;
- classCache.remove(name);
- }
+ }
return super.findClass(name);
}
diff --git a/src/jvm/clojure/lang/Keyword.java b/src/jvm/clojure/lang/Keyword.java
index ac080923..75adcdd7 100644
--- a/src/jvm/clojure/lang/Keyword.java
+++ b/src/jvm/clojure/lang/Keyword.java
@@ -15,18 +15,28 @@ package clojure.lang;
import java.io.ObjectStreamException;
import java.io.Serializable;
import java.util.concurrent.ConcurrentHashMap;
+import java.lang.ref.ReferenceQueue;
+import java.lang.ref.SoftReference;
public final class Keyword implements IFn, Comparable, Named, Serializable {
-private static ConcurrentHashMap<Symbol, Keyword> table = new ConcurrentHashMap();
+private static ConcurrentHashMap<Symbol, SoftReference<Keyword>> table = new ConcurrentHashMap();
+static final ReferenceQueue rq = new ReferenceQueue();
public final Symbol sym;
final int hash;
public static Keyword intern(Symbol sym){
+ Util.clearCache(rq, table);
Keyword k = new Keyword(sym);
- Keyword existingk = table.putIfAbsent(sym, k);
- return existingk == null ? k : existingk;
+ SoftReference<Keyword> existingRef = table.putIfAbsent(sym, new SoftReference<Keyword>(k,rq));
+ if(existingRef == null)
+ return k;
+ Keyword existingk = existingRef.get();
+ if(existingk != null)
+ return existingk;
+ //entry died in the interim, do over
+ return intern(sym);
}
public static Keyword intern(String ns, String name){
diff --git a/src/jvm/clojure/lang/MapEquivalence.java b/src/jvm/clojure/lang/MapEquivalence.java
new file mode 100644
index 00000000..40448425
--- /dev/null
+++ b/src/jvm/clojure/lang/MapEquivalence.java
@@ -0,0 +1,17 @@
+/**
+ * Copyright (c) Rich Hickey. All rights reserved.
+ * The use and distribution terms for this software are covered by the
+ * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+ * which can be found in the file epl-v10.html at the root of this distribution.
+ * By using this software in any fashion, you are agreeing to be bound by
+ * the terms of this license.
+ * You must not remove this notice, or any other, from this software.
+ **/
+
+/* rich Aug 4, 2010 */
+
+package clojure.lang;
+
+//marker interface
+public interface MapEquivalence{
+}
diff --git a/src/jvm/clojure/lang/Namespace.java b/src/jvm/clojure/lang/Namespace.java
index 4c557a9a..19369733 100644
--- a/src/jvm/clojure/lang/Namespace.java
+++ b/src/jvm/clojure/lang/Namespace.java
@@ -79,11 +79,14 @@ public Var intern(Symbol sym){
}
private void warnOrFailOnReplace(Symbol sym, Object o, Object v){
- if (o instanceof Var) {
- if (((Var)o).ns != RT.CLOJURE_NS) {
+ if (o instanceof Var)
+ {
+ Namespace ns = ((Var)o).ns;
+ if (ns == this)
+ return;
+ if (ns != RT.CLOJURE_NS)
throw new IllegalStateException(sym + " already refers to: " + o + " in namespace: " + name);
}
- }
RT.errPrintWriter().println("WARNING: " + sym + " already refers to: " + o + " in namespace: " + name
+ ", being replaced by: " + v);
}
diff --git a/src/jvm/clojure/lang/Util.java b/src/jvm/clojure/lang/Util.java
index 6f21d93e..47366026 100644
--- a/src/jvm/clojure/lang/Util.java
+++ b/src/jvm/clojure/lang/Util.java
@@ -13,6 +13,10 @@
package clojure.lang;
import java.math.BigInteger;
+import java.util.Map;
+import java.util.concurrent.ConcurrentHashMap;
+import java.lang.ref.SoftReference;
+import java.lang.ref.ReferenceQueue;
public class Util{
static public boolean equiv(Object k1, Object k2){
@@ -22,69 +26,25 @@ static public boolean equiv(Object k1, Object k2){
{
if(k1 instanceof Number && k2 instanceof Number)
return Numbers.equal((Number)k1, (Number)k2);
- else if(k1 instanceof IPersistentCollection && k2 instanceof IPersistentCollection)
- return ((IPersistentCollection)k1).equiv(k2);
+ else if(k1 instanceof IPersistentCollection || k2 instanceof IPersistentCollection)
+ return pcequiv(k1,k2);
return k1.equals(k2);
}
return false;
}
+static public boolean pcequiv(Object k1, Object k2){
+ if(k1 instanceof IPersistentCollection)
+ return ((IPersistentCollection)k1).equiv(k2);
+ return ((IPersistentCollection)k2).equiv(k1);
+}
+
static public boolean equals(Object k1, Object k2){
if(k1 == k2)
return true;
return k1 != null && k1.equals(k2);
}
-/*
-static public boolean equals(long x, long y){
- return x == y;
-}
-
-static public boolean equals(double x, double y){
- return x == y;
-}
-
-//static public boolean equals(long x, Object y){
-// return equals(Numbers.num(x),y);
-//}
-//
-//static public boolean equals(Object x, long y){
-// return equals(x,Numbers.num(y));
-//}
-//
-//static public boolean equals(double x, Object y){
-// return equals((Double)x,y);
-//}
-//
-//static public boolean equals(Object x, double y){
-// return equals(x,(Double)y);
-//}
-
-static public boolean equiv(long x, long y){
- return x == y;
-}
-
-static public boolean equiv(double x, double y){
- return x == y;
-}
-
-//static public boolean equiv(long x, Object y){
-// return equiv(Numbers.num(x),y);
-//}
-//
-//static public boolean equiv(Object x, long y){
-// return equiv(x,Numbers.num(y));
-//}
-//
-//static public boolean equiv(double x, Object y){
-// return equiv((Double)x,y);
-//}
-//
-//static public boolean equiv(Object x, double y){
-// return equiv(x,(Double)y);
-//}
-//*/
-
static public boolean identical(Object k1, Object k2){
return k1 == k2;
}
@@ -140,4 +100,17 @@ static public ISeq ret1(ISeq ret, Object nil){
return ret;
}
+static public <K,V> void clearCache(ReferenceQueue rq, ConcurrentHashMap<K, SoftReference<V>> cache){
+ //cleanup any dead entries
+ if(rq.poll() != null)
+ {
+ while(rq.poll() != null)
+ ;
+ for(Map.Entry<K, SoftReference<V>> e : cache.entrySet())
+ {
+ if(e.getValue().get() == null)
+ cache.remove(e.getKey(), e.getValue());
+ }
+ }
+}
}
diff --git a/test/clojure/test_clojure/control.clj b/test/clojure/test_clojure/control.clj
index 26641b3d..746da981 100644
--- a/test/clojure/test_clojure/control.clj
+++ b/test/clojure/test_clojure/control.clj
@@ -14,7 +14,7 @@
(ns clojure.test-clojure.control
(:use clojure.test
- [clojure.test-clojure.test-utils :only (exception)]))
+ [clojure.test-clojure.helpers :only (exception)]))
;; *** Helper functions ***
diff --git a/test/clojure/test_clojure/genclass.clj b/test/clojure/test_clojure/genclass.clj
index 039b0539..20f4a692 100644
--- a/test/clojure/test_clojure/genclass.clj
+++ b/test/clojure/test_clojure/genclass.clj
@@ -9,7 +9,7 @@
(ns ^{:doc "Tests for clojure.core/gen-class"
:author "Stuart Halloway, Daniel Solano Gómez"}
clojure.test-clojure.genclass
- (:use clojure.test)
+ (:use clojure.test clojure.test-clojure.helpers)
(:import [clojure.test_clojure.genclass.examples ExampleClass
ExampleAnnotationClass]
[java.lang.annotation ElementType
@@ -17,17 +17,6 @@
RetentionPolicy
Target]))
-;; pull this up to a suite-wide helper if you find other tests need it!
-(defn get-field
- "Access to private or protected field. field-name is a symbol or
- keyword."
- ([klass field-name]
- (get-field klass field-name nil))
- ([klass field-name inst]
- (-> klass (.getDeclaredField (name field-name))
- (doto (.setAccessible true))
- (.get inst))))
-
(deftest arg-support
(let [example (ExampleClass.)
o (Object.)]
@@ -71,3 +60,7 @@
(let [target (aget first-param-annots 1)]
(is (instance? Target target))
(is (= [ElementType/TYPE ElementType/PARAMETER] (seq (.value target)))))))))))
+
+(deftest genclass-option-validation
+ (is (fails-with-cause? IllegalArgumentException #"Not a valid method name: has-hyphen"
+ (@#'clojure.core/validate-generate-class-options {:methods '[[fine [] void] [has-hyphen [] void]]}))))
diff --git a/test/clojure/test_clojure/helpers.clj b/test/clojure/test_clojure/helpers.clj
index 777b5f64..42fba780 100644
--- a/test/clojure/test_clojure/helpers.clj
+++ b/test/clojure/test_clojure/helpers.clj
@@ -49,3 +49,38 @@
(report {:type :fail, :message ~msg,
:expected '~form, :actual t#})))))
+
+(defn get-field
+ "Access to private or protected field. field-name is a symbol or
+ keyword."
+ ([klass field-name]
+ (get-field klass field-name nil))
+ ([klass field-name inst]
+ (-> klass (.getDeclaredField (name field-name))
+ (doto (.setAccessible true))
+ (.get inst))))
+
+(defn set-var-roots
+ [maplike]
+ (doseq [[var val] maplike]
+ (alter-var-root var (fn [_] val))))
+
+(defn with-var-roots*
+ "Temporarily set var roots, run block, then put original roots back."
+ [root-map f & args]
+ (let [originals (doall (map (fn [[var _]] [var @var]) root-map))]
+ (set-var-roots root-map)
+ (try
+ (apply f args)
+ (finally
+ (set-var-roots originals)))))
+
+(defmacro with-var-roots
+ [root-map & body]
+ `(with-var-roots* ~root-map (fn [] ~@body)))
+
+(defn exception
+ "Use this function to ensure that execution of a program doesn't
+ reach certain point."
+ []
+ (throw (new Exception "Exception which should never occur")))
diff --git a/test/clojure/test_clojure/java/io.clj b/test/clojure/test_clojure/java/io.clj
index 2b831b72..eaaf7891 100644
--- a/test/clojure/test_clojure/java/io.clj
+++ b/test/clojure/test_clojure/java/io.clj
@@ -8,10 +8,11 @@
(ns clojure.test-clojure.java.io
(:use clojure.test clojure.java.io)
- (:import (java.io File FileInputStream BufferedInputStream
- FileOutputStream OutputStreamWriter InputStreamReader
+ (:import (java.io File BufferedInputStream
+ FileInputStream InputStreamReader InputStream
+ FileOutputStream OutputStreamWriter OutputStream
ByteArrayInputStream ByteArrayOutputStream)
- (java.net URL URI)))
+ (java.net URL URI Socket ServerSocket)))
(defn temp-file
[prefix suffix]
@@ -124,7 +125,6 @@
(deftest test-as-url
(are [file-part input] (= (URL. (str "file:" file-part)) (as-url input))
"foo" "file:foo"
- "/foo" (File. "/foo")
"baz" (URL. "file:baz")
"quux" (URI. "file:quux"))
(is (nil? (as-url nil))))
@@ -141,11 +141,11 @@
(testing "strings"
(is (= "foo" (as-relative-path "foo"))))
(testing "absolute path strings are forbidden"
- (is (thrown? IllegalArgumentException (as-relative-path (str File/separator "baz")))))
+ (is (thrown? IllegalArgumentException (as-relative-path (.getAbsolutePath (File. "baz"))))))
(testing "relative File paths"
(is (= "bar" (as-relative-path (File. "bar")))))
(testing "absolute File paths are forbidden"
- (is (thrown? IllegalArgumentException (as-relative-path (File. (str File/separator "quux")))))))
+ (is (thrown? IllegalArgumentException (as-relative-path (File. (.getAbsolutePath (File. "quux"))))))))
(defn stream-should-have [stream expected-bytes msg]
(let [actual-bytes (byte-array (alength expected-bytes))]
@@ -194,3 +194,13 @@
(is (not (.isDirectory (file tmp "test-make-parents" "child" "grandchild"))))
(delete-file (file tmp "test-make-parents" "child"))
(delete-file (file tmp "test-make-parents"))))
+
+(deftest test-socket-iofactory
+ (let [port 65321
+ server-socket (ServerSocket. port)
+ client-socket (Socket. "localhost" port)]
+ (try
+ (is (instance? InputStream (input-stream client-socket)))
+ (is (instance? OutputStream (output-stream client-socket)))
+ (finally (.close server-socket)
+ (.close client-socket)))))
diff --git a/test/clojure/test_clojure/java/shell.clj b/test/clojure/test_clojure/java/shell.clj
index 777698e2..56e3ff04 100644
--- a/test/clojure/test_clojure/java/shell.clj
+++ b/test/clojure/test_clojure/java/shell.clj
@@ -11,12 +11,16 @@
[clojure.java.shell :as sh])
(:import (java.io File)))
+(def platform-enc (.name (java.nio.charset.Charset/defaultCharset)))
+(def default-enc "UTF-8")
+
(deftest test-parse-args
(are [x y] (= x y)
- [[] {:out "UTF-8" :dir nil :env nil}] (#'sh/parse-args [])
- [["ls"] {:out "UTF-8" :dir nil :env nil}] (#'sh/parse-args ["ls"])
- [["ls" "-l"] {:out "UTF-8" :dir nil :env nil}] (#'sh/parse-args ["ls" "-l"])
- [["ls"] {:out "ISO-8859-1" :dir nil :env nil}] (#'sh/parse-args ["ls" :out "ISO-8859-1"])))
+ [[] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args [])
+ [["ls"] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args ["ls"])
+ [["ls" "-l"] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args ["ls" "-l"])
+ [["ls"] {:in-enc default-enc :out-enc "ISO-8859-1" :dir nil :env nil}] (#'sh/parse-args ["ls" :out-enc "ISO-8859-1"])
+ [[] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args [:in-enc platform-enc :out-enc platform-enc])))
(deftest test-with-sh-dir
(are [x y] (= x y)
@@ -28,10 +32,10 @@
nil *sh-env*
{:KEY "VAL"} (with-sh-env {:KEY "VAL"} *sh-env*)))
-(deftest test-as-env-string
+(deftest test-as-env-strings
(are [x y] (= x y)
- nil (#'sh/as-env-string nil)
- ["FOO=BAR"] (seq (#'sh/as-env-string {"FOO" "BAR"}))
- ["FOO_SYMBOL=BAR"] (seq (#'sh/as-env-string {'FOO_SYMBOL "BAR"}))
- ["FOO_KEYWORD=BAR"] (seq (#'sh/as-env-string {:FOO_KEYWORD "BAR"}))))
+ nil (#'sh/as-env-strings nil)
+ ["FOO=BAR"] (seq (#'sh/as-env-strings {"FOO" "BAR"}))
+ ["FOO_SYMBOL=BAR"] (seq (#'sh/as-env-strings {'FOO_SYMBOL "BAR"}))
+ ["FOO_KEYWORD=BAR"] (seq (#'sh/as-env-strings {:FOO_KEYWORD "BAR"}))))
diff --git a/test/clojure/test_clojure/logic.clj b/test/clojure/test_clojure/logic.clj
index 8c7763a6..98f2447a 100644
--- a/test/clojure/test_clojure/logic.clj
+++ b/test/clojure/test_clojure/logic.clj
@@ -13,7 +13,7 @@
(ns clojure.test-clojure.logic
(:use clojure.test
- [clojure.test-clojure.test-utils :only (exception)]))
+ [clojure.test-clojure.helpers :only (exception)]))
;; *** Tests ***
diff --git a/test/clojure/test_clojure/main.clj b/test/clojure/test_clojure/main.clj
index 8c5f098c..0f6ca1d7 100644
--- a/test/clojure/test_clojure/main.clj
+++ b/test/clojure/test_clojure/main.clj
@@ -45,6 +45,6 @@
(deftest repl-exception-safety
(testing "catches and prints exception on bad equals"
- (is (= "java.lang.NullPointerException\n"
+ (is (re-matches #"java\.lang\.NullPointerException\r?\n"
(run-repl-and-return-err
"(proxy [Object] [] (equals [o] (.toString nil)))")))))
diff --git a/test/clojure/test_clojure/multimethods.clj b/test/clojure/test_clojure/multimethods.clj
index 8c27034a..77c5ea7e 100644
--- a/test/clojure/test_clojure/multimethods.clj
+++ b/test/clojure/test_clojure/multimethods.clj
@@ -6,10 +6,11 @@
; the terms of this license.
; You must not remove this notice, or any other, from this software.
-; Author: Frantisek Sodomka
+; Author: Frantisek Sodomka, Robert Lachlan
(ns clojure.test-clojure.multimethods
- (:use clojure.test))
+ (:use clojure.test [clojure.test-clojure.helpers :only (with-var-roots)])
+ (:require [clojure.set :as set]))
; http://clojure.org/multimethods
@@ -20,8 +21,140 @@
; methods
; prefers
-; derive, [underive]
-; isa?
-; parents, ancestors, descendants
-; make-hierarchy
+(defmacro for-all
+ [& args]
+ `(dorun (for ~@args)))
+
+(defn hierarchy-tags
+ "Return all tags in a derivation hierarchy"
+ [h]
+ (set/select
+ #(instance? clojure.lang.Named %)
+ (reduce into #{} (map keys (vals h)))))
+
+(defn transitive-closure
+ "Return all objects reachable by calling f starting with o,
+ not including o itself. f should return a collection."
+ [o f]
+ (loop [results #{}
+ more #{o}]
+ (let [new-objects (set/difference more results)]
+ (if (seq new-objects)
+ (recur (set/union results more) (reduce into #{} (map f new-objects)))
+ (disj results o)))))
+
+(defn tag-descendants
+ "Set of descedants which are tags (i.e. Named)."
+ [& args]
+ (set/select
+ #(instance? clojure.lang.Named %)
+ (or (apply descendants args) #{})))
+
+(defn assert-valid-hierarchy
+ [h]
+ (let [tags (hierarchy-tags h)]
+ (testing "ancestors are the transitive closure of parents"
+ (for-all [tag tags]
+ (is (= (transitive-closure tag #(parents h %))
+ (or (ancestors h tag) #{})))))
+ (testing "ancestors are transitive"
+ (for-all [tag tags]
+ (is (= (transitive-closure tag #(ancestors h %))
+ (or (ancestors h tag) #{})))))
+ (testing "tag descendants are transitive"
+ (for-all [tag tags]
+ (is (= (transitive-closure tag #(tag-descendants h %))
+ (or (tag-descendants h tag) #{})))))
+ (testing "a tag isa? all of its parents"
+ (for-all [tag tags
+ :let [parents (parents h tag)]
+ parent parents]
+ (is (isa? h tag parent))))
+ (testing "a tag isa? all of its ancestors"
+ (for-all [tag tags
+ :let [ancestors (ancestors h tag)]
+ ancestor ancestors]
+ (is (isa? h tag ancestor))))
+ (testing "all my descendants have me as an ancestor"
+ (for-all [tag tags
+ :let [descendants (descendants h tag)]
+ descendant descendants]
+ (is (isa? h descendant tag))))
+ (testing "there are no cycles in parents"
+ (for-all [tag tags]
+ (is (not (contains? (transitive-closure tag #(parents h %)) tag)))))
+ (testing "there are no cycles in descendants"
+ (for-all [tag tags]
+ (is (not (contains? (descendants h tag) tag)))))))
+
+(def family
+ (reduce #(apply derive (cons %1 %2)) (make-hierarchy)
+ [[::parent-1 ::ancestor-1]
+ [::parent-1 ::ancestor-2]
+ [::parent-2 ::ancestor-2]
+ [::child ::parent-2]
+ [::child ::parent-1]]))
+
+(deftest cycles-are-forbidden
+ (testing "a tag cannot be its own parent"
+ (is (thrown-with-msg? Throwable #"\(not= tag parent\)"
+ (derive family ::child ::child))))
+ (testing "a tag cannot be its own ancestor"
+ (is (thrown-with-msg? Throwable #"Cyclic derivation: :clojure.test-clojure.multimethods/child has :clojure.test-clojure.multimethods/ancestor-1 as ancestor"
+ (derive family ::ancestor-1 ::child)))))
+
+(deftest using-diamond-inheritance
+ (let [diamond (reduce #(apply derive (cons %1 %2)) (make-hierarchy)
+ [[::mammal ::animal]
+ [::bird ::animal]
+ [::griffin ::mammal]
+ [::griffin ::bird]])
+ bird-no-more (underive diamond ::griffin ::bird)]
+ (assert-valid-hierarchy diamond)
+ (assert-valid-hierarchy bird-no-more)
+ (testing "a griffin is a mammal, indirectly through mammal and bird"
+ (is (isa? diamond ::griffin ::animal)))
+ (testing "a griffin is a bird"
+ (is (isa? diamond ::griffin ::bird)))
+ (testing "after underive, griffin is no longer a bird"
+ (is (not (isa? bird-no-more ::griffin ::bird))))
+ (testing "but it is still an animal, via mammal"
+ (is (isa? bird-no-more ::griffin ::animal)))))
+
+(deftest derivation-world-bridges-to-java-inheritance
+ (let [h (derive (make-hierarchy) java.util.Map ::map)]
+ (testing "a Java class can be isa? a tag"
+ (is (isa? h java.util.Map ::map)))
+ (testing "if a Java class isa? a tag, so are its subclasses..."
+ (is (isa? h java.util.HashMap ::map)))
+ (testing "...but not its superclasses!"
+ (is (not (isa? h java.util.Collection ::map))))))
+
+(deftest global-hierarchy-test
+ (with-var-roots {#'clojure.core/global-hierarchy (make-hierarchy)}
+ (assert-valid-hierarchy @#'clojure.core/global-hierarchy)
+ (testing "when you add some derivations..."
+ (derive ::lion ::cat)
+ (derive ::manx ::cat)
+ (assert-valid-hierarchy @#'clojure.core/global-hierarchy))
+ (testing "...isa? sees the derivations"
+ (is (isa? ::lion ::cat))
+ (is (not (isa? ::cat ::lion))))
+ (testing "... you can traverse the derivations"
+ (is (= #{::manx ::lion} (descendants ::cat)))
+ (is (= #{::cat} (parents ::manx)))
+ (is (= #{::cat} (ancestors ::manx))))
+ (testing "then, remove a derivation..."
+ (underive ::manx ::cat))
+ (testing "... traversals update accordingly"
+ (is (= #{::lion} (descendants ::cat)))
+ (is (nil? (parents ::manx)))
+ (is (nil? (ancestors ::manx))))))
+
+#_(defmacro for-all
+ "Better than the actual for-all, if only it worked."
+ [& args]
+ `(reduce
+ #(and %1 %2)
+ (map true? (for ~@args))))
diff --git a/test/clojure/test_clojure/pprint/test_pretty.clj b/test/clojure/test_clojure/pprint/test_pretty.clj
index ee328fbc..a012b1d4 100644
--- a/test/clojure/test_clojure/pprint/test_pretty.clj
+++ b/test/clojure/test_clojure/pprint/test_pretty.clj
@@ -245,6 +245,31 @@ Usage: *hello*
)
-
+;;; Some simple tests of dispatch
+
+(defmulti
+ test-dispatch
+ "A test dispatch method"
+ {:added "1.2" :arglists '[[object]]}
+ #(and (seq %) (not (string? %))))
+
+(defmethod test-dispatch true [avec]
+ (pprint-logical-block :prefix "[" :suffix "]"
+ (loop [aseq (seq avec)]
+ (when aseq
+ (write-out (first aseq))
+ (when (next aseq)
+ (.write ^java.io.Writer *out* " ")
+ (pprint-newline :linear)
+ (recur (next aseq)))))))
+
+(defmethod test-dispatch false [aval] (pr aval))
+
+(simple-tests dispatch-tests
+ (with-pprint-dispatch test-dispatch
+ (with-out-str
+ (pprint '("hello" "there"))))
+ "[\"hello\" \"there\"]\n"
+)
diff --git a/test/clojure/test_clojure/protocols.clj b/test/clojure/test_clojure/protocols.clj
index b2f03dd7..44969756 100644
--- a/test/clojure/test_clojure/protocols.clj
+++ b/test/clojure/test_clojure/protocols.clj
@@ -11,6 +11,7 @@
(ns clojure.test-clojure.protocols
(:use clojure.test clojure.test-clojure.protocols.examples)
(:require [clojure.test-clojure.protocols.more-examples :as other]
+ [clojure.set :as set]
clojure.test-clojure.helpers)
(:import [clojure.test_clojure.protocols.examples ExampleInterface]))
@@ -174,21 +175,21 @@
(defrecord DefrecordObjectMethodsWidgetA [a])
(defrecord DefrecordObjectMethodsWidgetB [a])
(deftest defrecord-object-methods-test
- (testing ".equals depends on fields and type"
- (is (true? (.equals (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1))))
- (is (false? (.equals (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2))))
- (is (false? (.equals (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1)))))
- (testing ".hashCode depends on fields and type"
- (is (= (.hashCode (DefrecordObjectMethodsWidgetA. 1)) (.hashCode (DefrecordObjectMethodsWidgetA. 1))))
- (is (= (.hashCode (DefrecordObjectMethodsWidgetA. 2)) (.hashCode (DefrecordObjectMethodsWidgetA. 2))))
- (is (not= (.hashCode (DefrecordObjectMethodsWidgetA. 1)) (.hashCode (DefrecordObjectMethodsWidgetA. 2))))
- (is (= (.hashCode (DefrecordObjectMethodsWidgetB. 1)) (.hashCode (DefrecordObjectMethodsWidgetB. 1))))
- (is (not= (.hashCode (DefrecordObjectMethodsWidgetA. 1)) (.hashCode (DefrecordObjectMethodsWidgetB. 1))))))
+ (testing "= depends on fields and type"
+ (is (true? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1))))
+ (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2))))
+ (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1))))))
(deftest defrecord-acts-like-a-map
(let [rec (r 1 2)]
- (is (= (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4})))
- #_(is (= {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10})))))
+ (is (.equals (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4})))
+ (is (.equals {:foo 1 :b 2} (set/rename-keys rec {:a :foo})))
+ (is (.equals {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10})))))
+
+(deftest degenerate-defrecord-test
+ (let [empty (EmptyRecord.)]
+ (is (nil? (seq empty)))
+ (is (not (.containsValue empty :a)))))
(deftest defrecord-interfaces-test
(testing "java.util.Map"
diff --git a/test/clojure/test_clojure/rt.clj b/test/clojure/test_clojure/rt.clj
index 5b7f2493..f3a9b08b 100644
--- a/test/clojure/test_clojure/rt.clj
+++ b/test/clojure/test_clojure/rt.clj
@@ -55,23 +55,23 @@
(deftest error-messages
(testing "binding a core var that already refers to something"
(should-print-err-message
- #"WARNING: prefers already refers to: #'clojure.core/prefers in namespace: .*\n"
+ #"WARNING: prefers already refers to: #'clojure.core/prefers in namespace: .*\r?\n"
(defn prefers [] (throw (RuntimeException. "rebound!")))))
(testing "reflection cannot resolve field"
(should-print-err-message
- #"Reflection warning, NO_SOURCE_PATH:\d+ - reference to field blah can't be resolved.\n"
+ #"Reflection warning, NO_SOURCE_PATH:\d+ - reference to field blah can't be resolved\.\r?\n"
(defn foo [x] (.blah x))))
(testing "reflection cannot resolve instance method"
(should-print-err-message
- #"Reflection warning, NO_SOURCE_PATH:\d+ - call to zap can't be resolved.\n"
+ #"Reflection warning, NO_SOURCE_PATH:\d+ - call to zap can't be resolved\.\r?\n"
(defn foo [x] (.zap x 1))))
(testing "reflection cannot resolve static method"
(should-print-err-message
- #"Reflection warning, NO_SOURCE_PATH:\d+ - call to valueOf can't be resolved.\n"
+ #"Reflection warning, NO_SOURCE_PATH:\d+ - call to valueOf can't be resolved\.\r?\n"
(defn foo [] (Integer/valueOf #"boom"))))
(testing "reflection cannot resolve constructor"
(should-print-err-message
- #"Reflection warning, NO_SOURCE_PATH:\d+ - call to java.lang.String ctor can't be resolved.\n"
+ #"Reflection warning, NO_SOURCE_PATH:\d+ - call to java.lang.String ctor can't be resolved\.\r?\n"
(defn foo [] (String. 1 2 3)))))
(def example-var)
@@ -83,10 +83,18 @@
(deftest last-var-wins-for-core
(testing "you can replace a core name, with warning"
- (let [ns (temp-ns 'clojure.set)
+ (let [ns (temp-ns)
replacement (gensym)]
(with-err-string-writer (intern ns 'prefers replacement))
(is (= replacement @('prefers (ns-publics ns))))))
+ (testing "you can replace a name you defined before"
+ (let [ns (temp-ns)
+ s (gensym)
+ v1 (intern ns 'foo s)
+ v2 (intern ns 'bar s)]
+ (with-err-string-writer (.refer ns 'flatten v1))
+ (.refer ns 'flatten v2)
+ (is (= v2 (ns-resolve ns 'flatten)))))
(testing "you cannot intern over an existing non-core name"
(let [ns (temp-ns 'clojure.set)
replacement (gensym)]
diff --git a/test/clojure/test_clojure/test_utils.clj b/test/clojure/test_clojure/test_utils.clj
deleted file mode 100644
index d1905100..00000000
--- a/test/clojure/test_clojure/test_utils.clj
+++ /dev/null
@@ -1,33 +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.
-
-; Author: Frantisek Sodomka
-
-
-(ns clojure.test-clojure.test-utils)
-
- (defn exception
- "Use this function to ensure that execution of a program doesn't
- reach certain point."
- []
- (throw (new Exception "Exception which should never occur")))
-
-
-;; (defmacro all-are
-;; "Test all-with-all.
-;; (all-are (= _1 _2)
-;; a b c)
-;; =>
-;; (do
-;; (is (= a b))
-;; (is (= a c))
-;; (is (= b c)))"
-;; [expr & args]
-;; (concat
-;; (list 'clojure.contrib.template/do-template (list 'clojure.test/is expr))
-;; (apply concat (combinations args 2)))))