From a08eac88766fa5eca96d7daf66addc00b70fd1bc Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 23 Jun 2010 08:52:52 -0400 Subject: disable direct binding (and internal reduce with it, for now) --- src/clj/clojure/core.clj | 2 +- src/jvm/clojure/lang/Compiler.java | 20 +++++++++----------- 2 files changed, 10 insertions(+), 12 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 2a2563f5..5ad60614 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -5321,7 +5321,7 @@ (load "gvec") ;; redefine reduce with internal-reduce -(defn 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 applying f to that result and the 3rd item, etc. If coll contains no diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index 3aae49f8..f5684f1b 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -2878,17 +2878,15 @@ static class InvokeExpr implements Expr{ this.onMethod = (java.lang.reflect.Method) methods.get(0); } } - else if(pvar == null && VAR_CALLSITES.isBound() - && fvar.ns.name.name.startsWith("clojure") - && !RT.booleanCast(RT.get(RT.meta(fvar),dynamicKey)) -// && !fvar.sym.name.equals("report") -// && fvar.isBound() && fvar.get() instanceof IFn - ) - { - //todo - more specific criteria for binding these - this.isDirect = true; - this.siteIndex = registerVarCallsite(((VarExpr) fexpr).var); - } +// else if(pvar == null && VAR_CALLSITES.isBound() +// && fvar.ns.name.name.startsWith("clojure") +// && !RT.booleanCast(RT.get(RT.meta(fvar),dynamicKey)) +// ) +// { +// //todo - more specific criteria for binding these +// this.isDirect = true; +// this.siteIndex = registerVarCallsite(((VarExpr) fexpr).var); +// } } this.tag = tag != null ? tag : (fexpr instanceof VarExpr ? ((VarExpr) fexpr).tag : null); } -- cgit v1.2.3-70-g09d2 From a642708b6e9a1718b74248cc28a467bd53afc81f Mon Sep 17 00:00:00 2001 From: Tom Faulhaber Date: Tue, 15 Jun 2010 11:34:34 -0700 Subject: Support logical-block macro working correctly in external namespaces. Signed-off-by: Stuart Halloway --- src/clj/clojure/pprint/pprint_base.clj | 19 +++++++++++------ test/clojure/test_clojure/pprint/test_pretty.clj | 27 +++++++++++++++++++++++- 2 files changed, 38 insertions(+), 8 deletions(-) (limited to 'src') 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/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" +) -- cgit v1.2.3-70-g09d2 From a1eff35124b923ef8539a35e7a292813ba54a0e0 Mon Sep 17 00:00:00 2001 From: Tom Faulhaber Date: Sat, 19 Jun 2010 23:45:48 -0700 Subject: Convert arg to a string before calling write (and document options arg) Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 5ad60614..fdfd37a8 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -5367,11 +5367,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 -- cgit v1.2.3-70-g09d2 From 04764db9b213687dd5d4325c67291f0b0ef3ff33 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Wed, 23 Jun 2010 17:10:45 -0400 Subject: automatically use pp and pprint at the default repl --- src/clj/clojure/main.clj | 1 + 1 file changed, 1 insertion(+) (limited to 'src') diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj index 31cdd957..46b81f3e 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 [] -- cgit v1.2.3-70-g09d2 From 0f4b6495347dc7d9601cc0907d5d08dd861bb3aa Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 30 Jun 2010 15:05:23 -0400 Subject: clean out dead entries in dynamic class cache --- src/jvm/clojure/lang/DynamicClassLoader.java | 40 +++++++++++++++------------- 1 file changed, 22 insertions(+), 18 deletions(-) (limited to 'src') diff --git a/src/jvm/clojure/lang/DynamicClassLoader.java b/src/jvm/clojure/lang/DynamicClassLoader.java index 3f3ab35e..d27e9c86 100644 --- a/src/jvm/clojure/lang/DynamicClassLoader.java +++ b/src/jvm/clojure/lang/DynamicClassLoader.java @@ -19,14 +19,17 @@ import java.util.concurrent.ConcurrentHashMap; import java.net.URLClassLoader; import java.net.URL; import java.lang.ref.WeakReference; +import java.lang.ref.ReferenceQueue; public class DynamicClassLoader extends URLClassLoader{ HashMap constantVals = new HashMap(); -static ConcurrentHashMap,Object> >classCache = - new ConcurrentHashMap,Object> >(); +static ConcurrentHashMap >classCache = + new ConcurrentHashMap >(); 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 +42,30 @@ public DynamicClassLoader(ClassLoader parent){ } public Class defineClass(String name, byte[] bytes, Object srcForm){ -// Map.Entry,Object> ce = classCache.get(name); -// if(ce != null) -// { -// WeakReference cr = ce.getKey(); -// Class c = cr.get(); -// if((c != null) && srcForm.equals(ce.getValue())) -// return c; -// } Class c = defineClass(name, bytes, 0, bytes.length); - classCache.put(name, new MapEntry(new WeakReference(c), null)); + classCache.put(name, new WeakReference(c,rq)); + //cleanup any dead entries + if(rq.poll() != null) + { + while(rq.poll() != null) + ; + for(Map.Entry> e : classCache.entrySet()) + { + if(e.getValue().get() == null) + classCache.remove(e.getKey(), e.getValue()); + } + } return c; } protected Class findClass(String name) throws ClassNotFoundException{ - Map.Entry,Object> ce = classCache.get(name); - if(ce != null) - { - WeakReference cr = ce.getKey(); - Class c = cr.get(); + WeakReference cr = classCache.get(name); + if(cr != null) + { + Class c = cr.get(); if(c != null) return c; - classCache.remove(name); - } + } return super.findClass(name); } -- cgit v1.2.3-70-g09d2 From daed9dfb86a34c362a614f29c259a35d781d6b1e Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Tue, 29 Jun 2010 23:03:05 -0400 Subject: #391 ok for namespaces to replace their own vars Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Namespace.java | 9 ++++++--- test/clojure/test_clojure/rt.clj | 10 +++++++++- 2 files changed, 15 insertions(+), 4 deletions(-) (limited to 'src') 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/test/clojure/test_clojure/rt.clj b/test/clojure/test_clojure/rt.clj index 5b7f2493..175bfd82 100644 --- a/test/clojure/test_clojure/rt.clj +++ b/test/clojure/test_clojure/rt.clj @@ -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)] -- cgit v1.2.3-70-g09d2 From a9d9ddb6ad4f86809d44f8e3370ae284f0a084f2 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Tue, 8 Jun 2010 17:29:54 -0400 Subject: #377 test now reports file/line for failures in repl or Ant build Signed-off-by: Stuart Halloway --- src/clj/clojure/test.clj | 88 +++++++++++++++++++++++++++++------------------- 1 file changed, 53 insertions(+), 35 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/test.clj b/src/clj/clojure/test.clj index 5891ae9c..62dba13b 100644 --- a/src/clj/clojure/test.clj +++ b/src/clj/clojure/test.clj @@ -271,14 +271,16 @@ `(binding [*out* *test-out*] ~@body)) - - ;;; UTILITIES FOR REPORTING FUNCTIONS (defn file-position "Returns a vector [filename line-number] for the nth call up the - stack." - {:added "1.1"} + stack. + + Deprecated in 1.2: The information needed for test reporting is + now on :file and :line keys in the result map." + {:added "1.1" + :deprecated "1.2"} [n] (let [^StackTraceElement s (nth (.getStackTrace (new java.lang.Throwable)) n)] [(.getFileName s) (.getLineNumber s)])) @@ -288,8 +290,8 @@ in *testing-vars* as a list, then the source file and line of current assertion." {:added "1.1"} - [] - (let [[file line] (file-position 4)] + [m] + (let [{:keys [file line]} m] (str ;; Uncomment to include namespace in failure report: ;;(ns-name (:ns (meta (first *testing-vars*)))) "/ " @@ -312,8 +314,6 @@ (dosync (commute *report-counters* assoc name (inc (or (*report-counters* name) 0)))))) - - ;;; TEST RESULT REPORTING (defmulti @@ -327,6 +327,24 @@ :added "1.1"} report :type) +(defn- file-and-line + [exception depth] + (let [^StackTraceElement s (nth (.getStackTrace exception) depth)] + {:file (.getFileName s) :line (.getLineNumber s)})) + +(defn do-report + "Add file and line information to a test result and call report. + If you are writing a custom assert-expr method, call this function + to pass test results to report." + {:added "1.2"} + [m] + (report + (case + (:type m) + :fail (merge (file-and-line (new java.lang.Throwable) 1) m) + :error (merge (file-and-line (:actual m) 0) m) + m))) + (defmethod report :default [m] (with-test-out (prn m))) @@ -335,17 +353,17 @@ (defmethod report :fail [m] (with-test-out - (inc-report-counter :fail) - (println "\nFAIL in" (testing-vars-str)) - (when (seq *testing-contexts*) (println (testing-contexts-str))) - (when-let [message (:message m)] (println message)) - (println "expected:" (pr-str (:expected m))) - (println " actual:" (pr-str (:actual m))))) + (inc-report-counter :fail) + (println "\nFAIL in" (testing-vars-str m)) + (when (seq *testing-contexts*) (println (testing-contexts-str))) + (when-let [message (:message m)] (println message)) + (println "expected:" (pr-str (:expected m))) + (println " actual:" (pr-str (:actual m))))) (defmethod report :error [m] (with-test-out (inc-report-counter :error) - (println "\nERROR in" (testing-vars-str)) + (println "\nERROR in" (testing-vars-str m)) (when (seq *testing-contexts*) (println (testing-contexts-str))) (when-let [message (:message m)] (println message)) (println "expected:" (pr-str (:expected m))) @@ -407,9 +425,9 @@ `(let [values# (list ~@args) result# (apply ~pred values#)] (if result# - (report {:type :pass, :message ~msg, + (do-report {:type :pass, :message ~msg, :expected '~form, :actual (cons ~pred values#)}) - (report {:type :fail, :message ~msg, + (do-report {:type :fail, :message ~msg, :expected '~form, :actual (list '~'not (cons '~pred values#))})) result#))) @@ -420,9 +438,9 @@ [msg form] `(let [value# ~form] (if value# - (report {:type :pass, :message ~msg, + (do-report {:type :pass, :message ~msg, :expected '~form, :actual value#}) - (report {:type :fail, :message ~msg, + (do-report {:type :fail, :message ~msg, :expected '~form, :actual value#})) value#)) @@ -443,7 +461,7 @@ (defmethod assert-expr :always-fail [msg form] ;; nil test: always fail - `(report {:type :fail, :message ~msg})) + `(do-report {:type :fail, :message ~msg})) (defmethod assert-expr :default [msg form] (if (and (sequential? form) (function? (first form))) @@ -456,9 +474,9 @@ object# ~(nth form 2)] (let [result# (instance? klass# object#)] (if result# - (report {:type :pass, :message ~msg, + (do-report {:type :pass, :message ~msg, :expected '~form, :actual (class object#)}) - (report {:type :fail, :message ~msg, + (do-report {:type :fail, :message ~msg, :expected '~form, :actual (class object#)})) result#))) @@ -469,10 +487,10 @@ (let [klass (second form) body (nthnext form 2)] `(try ~@body - (report {:type :fail, :message ~msg, + (do-report {:type :fail, :message ~msg, :expected '~form, :actual nil}) (catch ~klass e# - (report {:type :pass, :message ~msg, + (do-report {:type :pass, :message ~msg, :expected '~form, :actual e#}) e#)))) @@ -485,13 +503,13 @@ re (nth form 2) body (nthnext form 3)] `(try ~@body - (report {:type :fail, :message ~msg, :expected '~form, :actual nil}) + (do-report {:type :fail, :message ~msg, :expected '~form, :actual nil}) (catch ~klass e# (let [m# (.getMessage e#)] (if (re-find ~re m#) - (report {:type :pass, :message ~msg, + (do-report {:type :pass, :message ~msg, :expected '~form, :actual e#}) - (report {:type :fail, :message ~msg, + (do-report {:type :fail, :message ~msg, :expected '~form, :actual e#}))) e#)))) @@ -503,8 +521,8 @@ [msg form] `(try ~(assert-expr msg form) (catch Throwable t# - (report {:type :error, :message ~msg, - :expected '~form, :actual t#})))) + (do-report {:type :error, :message ~msg, + :expected '~form, :actual t#})))) @@ -665,13 +683,13 @@ [v] (when-let [t (:test (meta v))] (binding [*testing-vars* (conj *testing-vars* v)] - (report {:type :begin-test-var, :var v}) + (do-report {:type :begin-test-var, :var v}) (inc-report-counter :test) (try (t) (catch Throwable e - (report {:type :error, :message "Uncaught exception, not in assertion." + (do-report {:type :error, :message "Uncaught exception, not in assertion." :expected nil, :actual e}))) - (report {:type :end-test-var, :var v})))) + (do-report {:type :end-test-var, :var v})))) (defn test-all-vars "Calls test-var on every var interned in the namespace, with fixtures." @@ -697,13 +715,13 @@ [ns] (binding [*report-counters* (ref *initial-report-counters*)] (let [ns-obj (the-ns ns)] - (report {:type :begin-test-ns, :ns ns-obj}) + (do-report {:type :begin-test-ns, :ns ns-obj}) ;; If the namespace has a test-ns-hook function, call that: (if-let [v (find-var (symbol (str (ns-name ns-obj)) "test-ns-hook"))] ((var-get v)) ;; Otherwise, just test every var in the namespace. (test-all-vars ns-obj)) - (report {:type :end-test-ns, :ns ns-obj})) + (do-report {:type :end-test-ns, :ns ns-obj})) @*report-counters*)) @@ -719,7 +737,7 @@ ([& namespaces] (let [summary (assoc (apply merge-with + (map test-ns namespaces)) :type :summary)] - (report summary) + (do-report summary) summary))) (defn run-all-tests -- cgit v1.2.3-70-g09d2 From 4bec81db4ee4e9e4227a66bb1a04ba06e95ea9b6 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Wed, 23 Jun 2010 15:56:13 -0400 Subject: temporary workaround for #388 - note need for full package name (in some places, didn't track down) - note need for redundant hinting (interface hinting flows sometimes?) Signed-off-by: Stuart Halloway --- src/clj/clojure/gvec.clj | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/gvec.clj b/src/clj/clojure/gvec.clj index feff544a..d56e45f7 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] -- cgit v1.2.3-70-g09d2 From 7def88afe28221ad78f8d045ddbd87b5230cb03e Mon Sep 17 00:00:00 2001 From: David Powell Date: Sat, 5 Jun 2010 16:11:07 +0100 Subject: read stdout and stderr simultanously from separate threads to prevent stderr filling the buffer and hanging the process removed stray println use clojure.java.io to copy streams, avoiding byte-at-a-time copying added :inenc option, specifying the input character set renamed :out input option to :outenc changed default encoding to 'platform default encoding'. This matches how we handle *out*. It is much more likely that command-line tools used by sh use platform default encoding. Windows CRT barely supports UTF-8 for example. write to stdin from a separate thread to prevent stdout blocking before we write anything Added support for passing a byte array to :in Signed-off-by: Stuart Halloway --- src/clj/clojure/java/shell.clj | 79 +++++++++++++++++++++++++++--------------- 1 file changed, 51 insertions(+), 28 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/java/shell.clj b/src/clj/clojure/java/shell.clj index 11d908a5..62cabe16 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) @@ -48,7 +49,8 @@ collecting its stdout"} (defn- parse-args [args] - (let [default-opts {:out "UTF-8" :dir *sh-dir* :env *sh-env*} + (let [default-encoding (.name (Charset/defaultCharset)) + default-opts {:outenc default-encoding :inenc default-encoding :dir *sh-dir* :env *sh-env*} [cmd opts] (split-with string? args)] [cmd (merge default-opts (apply hash-map opts))])) @@ -60,22 +62,41 @@ 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 enc] + (with-open [bout (StringWriter.)] + (copy in bout :encoding enc) + (.toString bout))) + (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. + :inenc 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 the platform default encoding. + If the :in option provides a byte array, then the bytes are passed + unencoded, and this option is ignored. + :outenc 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 the platform default + encoding. + :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. @@ -90,23 +111,24 @@ collecting its stdout"} 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))) + (as-file (:dir opts))) + in (:in opts)] + (if in + (future + (if (instance? (class (byte-array 0)) in) + (with-open [osw (OutputStreamWriter. (.getOutputStream proc) (:inenc opts))] + (.write osw in)) + (with-open [os (.getOutputStream proc)] + (.write os 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))))))) + (if (= (:outenc opts) :bytes) + (pmap #(stream-to-bytes %) [stdout stderr]) + (pmap #(stream-to-string % (:outenc opts)) [stdout stderr])) exit-code (.waitFor proc)] - {:exit exit-code :out out :err err})))) + {:exit exit-code :outenc out :err err})))) (comment @@ -115,7 +137,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" :outenc "ISO-8859-1")) ; reads 4 single-byte chars +(println (sh "cat" "myimage.png" :outenc :bytes)) ; reads binary file into bytes[] +(println (sh "cmd" "/c dir 1>&2")) ) -- cgit v1.2.3-70-g09d2 From 31b6fb557a3c524c447d312f5c51b6262ffb9b0f Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Thu, 1 Jul 2010 13:26:47 -0400 Subject: fixes to #392: - correct order for branches for in - :out and :outenc are separate things - stderr always gets platform encoding Signed-off-by: Stuart Halloway --- src/clj/clojure/java/shell.clj | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/java/shell.clj b/src/clj/clojure/java/shell.clj index 62cabe16..f20c72e9 100644 --- a/src/clj/clojure/java/shell.clj +++ b/src/clj/clojure/java/shell.clj @@ -69,10 +69,17 @@ collecting its stdout"} (.toByteArray bout))) (defn- stream-to-string - [in enc] - (with-open [bout (StringWriter.)] - (copy in bout :encoding enc) - (.toString bout))) + ([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. @@ -116,19 +123,17 @@ collecting its stdout"} (if in (future (if (instance? (class (byte-array 0)) in) - (with-open [osw (OutputStreamWriter. (.getOutputStream proc) (:inenc opts))] - (.write osw in)) (with-open [os (.getOutputStream proc)] - (.write os in)))) + (.write os in)) + (with-open [osw (OutputStreamWriter. (.getOutputStream proc) (:inenc opts))] + (.write osw in)))) (.close (.getOutputStream proc))) (with-open [stdout (.getInputStream proc) stderr (.getErrorStream proc)] - (let [[out err] - (if (= (:outenc opts) :bytes) - (pmap #(stream-to-bytes %) [stdout stderr]) - (pmap #(stream-to-string % (:outenc opts)) [stdout stderr])) + (let [out (stream-to-enc stdout (:outenc opts)) + err (stream-to-string stderr) exit-code (.waitFor proc)] - {:exit exit-code :outenc out :err err})))) + {:exit exit-code :out out :err err})))) (comment -- cgit v1.2.3-70-g09d2 From 0d39db4990e5ca2d3f4450f57ab15941e03b2e3b Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Thu, 1 Jul 2010 13:56:35 -0400 Subject: #392 fix reflection warnings and tests + minor cleanup Signed-off-by: Stuart Halloway --- src/clj/clojure/java/io.clj | 4 ++-- src/clj/clojure/java/shell.clj | 21 ++++++++------------- test/clojure/test_clojure/java/shell.clj | 20 +++++++++++--------- 3 files changed, 21 insertions(+), 24 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/java/io.clj b/src/clj/clojure/java/io.clj index 4d6c551f..7af37ccd 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 diff --git a/src/clj/clojure/java/shell.clj b/src/clj/clojure/java/shell.clj index f20c72e9..a0f06f33 100644 --- a/src/clj/clojure/java/shell.clj +++ b/src/clj/clojure/java/shell.clj @@ -32,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] @@ -54,7 +49,7 @@ collecting its stdout"} [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 @@ -116,21 +111,21 @@ collecting its stdout"} [& args] (let [[cmd opts] (parse-args args) proc (.exec (Runtime/getRuntime) - (into-array cmd) - (as-env-string (:env opts)) + ^"[Ljava.lang.String;" (into-array cmd) + (as-env-strings (:env opts)) (as-file (:dir opts))) - in (:in opts)] + {:keys [in inenc outenc]} opts] (if in (future (if (instance? (class (byte-array 0)) in) (with-open [os (.getOutputStream proc)] - (.write os in)) - (with-open [osw (OutputStreamWriter. (.getOutputStream proc) (:inenc opts))] - (.write osw in)))) + (.write os ^"[B" in)) + (with-open [osw (OutputStreamWriter. (.getOutputStream proc) ^String inenc)] + (.write osw ^String in)))) (.close (.getOutputStream proc))) (with-open [stdout (.getInputStream proc) stderr (.getErrorStream proc)] - (let [out (stream-to-enc stdout (:outenc opts)) + (let [out (stream-to-enc stdout outenc) err (stream-to-string stderr) exit-code (.waitFor proc)] {:exit exit-code :out out :err err})))) diff --git a/test/clojure/test_clojure/java/shell.clj b/test/clojure/test_clojure/java/shell.clj index 777698e2..964e68c2 100644 --- a/test/clojure/test_clojure/java/shell.clj +++ b/test/clojure/test_clojure/java/shell.clj @@ -11,12 +11,14 @@ [clojure.java.shell :as sh]) (:import (java.io File))) +(def platform-enc (.name (java.nio.charset.Charset/defaultCharset))) + (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"]))) + [[] {:inenc platform-enc :outenc platform-enc :dir nil :env nil}] (#'sh/parse-args []) + [["ls"] {:inenc platform-enc :outenc platform-enc :dir nil :env nil}] (#'sh/parse-args ["ls"]) + [["ls" "-l"] {:inenc platform-enc :outenc platform-enc :dir nil :env nil}] (#'sh/parse-args ["ls" "-l"]) + [["ls"] {:inenc platform-enc :outenc "ISO-8859-1" :dir nil :env nil}] (#'sh/parse-args ["ls" :outenc "ISO-8859-1"]))) (deftest test-with-sh-dir (are [x y] (= x y) @@ -28,10 +30,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"})))) -- cgit v1.2.3-70-g09d2 From 836bc44afff8ac17233565447e8a289aea3203c4 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Wed, 7 Jul 2010 10:01:11 -0400 Subject: #392 de-uglify option names for sh Signed-off-by: Stuart Halloway --- src/clj/clojure/java/shell.clj | 23 +++++++++++------------ test/clojure/test_clojure/java/shell.clj | 8 ++++---- 2 files changed, 15 insertions(+), 16 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/java/shell.clj b/src/clj/clojure/java/shell.clj index a0f06f33..72f0311b 100644 --- a/src/clj/clojure/java/shell.clj +++ b/src/clj/clojure/java/shell.clj @@ -45,7 +45,7 @@ collecting its stdout"} (defn- parse-args [args] (let [default-encoding (.name (Charset/defaultCharset)) - default-opts {:outenc default-encoding :inenc default-encoding :dir *sh-dir* :env *sh-env*} + 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))])) @@ -83,19 +83,18 @@ collecting its stdout"} :in may be given followed by a String or byte array specifying input to be fed to the sub-process's stdin. - :inenc option may be given followed by a String, used as a character + :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 the platform default encoding. + 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. - :outenc option may be given followed by :bytes or a String. If a + :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 the platform default - encoding. + 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. @@ -106,7 +105,7 @@ 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) @@ -114,18 +113,18 @@ collecting its stdout"} ^"[Ljava.lang.String;" (into-array cmd) (as-env-strings (:env opts)) (as-file (:dir opts))) - {:keys [in inenc outenc]} 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 inenc)] + (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 (stream-to-enc stdout outenc) + (let [out (stream-to-enc stdout out-enc) err (stream-to-string stderr) exit-code (.waitFor proc)] {:exit exit-code :out out :err err})))) @@ -137,8 +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" :outenc "ISO-8859-1")) ; reads 4 single-byte chars -(println (sh "cat" "myimage.png" :outenc :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/test/clojure/test_clojure/java/shell.clj b/test/clojure/test_clojure/java/shell.clj index 964e68c2..d3db7db0 100644 --- a/test/clojure/test_clojure/java/shell.clj +++ b/test/clojure/test_clojure/java/shell.clj @@ -15,10 +15,10 @@ (deftest test-parse-args (are [x y] (= x y) - [[] {:inenc platform-enc :outenc platform-enc :dir nil :env nil}] (#'sh/parse-args []) - [["ls"] {:inenc platform-enc :outenc platform-enc :dir nil :env nil}] (#'sh/parse-args ["ls"]) - [["ls" "-l"] {:inenc platform-enc :outenc platform-enc :dir nil :env nil}] (#'sh/parse-args ["ls" "-l"]) - [["ls"] {:inenc platform-enc :outenc "ISO-8859-1" :dir nil :env nil}] (#'sh/parse-args ["ls" :outenc "ISO-8859-1"]))) + [[] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args []) + [["ls"] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args ["ls"]) + [["ls" "-l"] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args ["ls" "-l"]) + [["ls"] {:in-enc platform-enc :out-enc "ISO-8859-1" :dir nil :env nil}] (#'sh/parse-args ["ls" :out-enc "ISO-8859-1"]))) (deftest test-with-sh-dir (are [x y] (= x y) -- cgit v1.2.3-70-g09d2 From a07040032714a2f88c23b76c6484c1b8acd462b0 Mon Sep 17 00:00:00 2001 From: Allen Rohner Date: Wed, 30 Jun 2010 18:54:15 -0500 Subject: Fix rename-keys to work with defrecords Signed-off-by: Stuart Halloway --- src/clj/clojure/set.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') 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)) -- cgit v1.2.3-70-g09d2 From d184ed95817c5ddfd5874ea75e83e0df7e753c24 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Sat, 10 Jul 2010 10:31:58 -0400 Subject: fix reduce metadata --- src/clj/clojure/core.clj | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index fdfd37a8..ade4405c 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -770,7 +770,19 @@ [x] (. clojure.lang.Numbers (inc x))) ;; reduce is defined again later after InternalReduce loads -(def reduce +(def + ^{:arglists '([f coll] [f val coll]) + :doc "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 + applying f to that result and the 3rd item, etc. If coll contains no + items, f must accept no arguments as well, and reduce returns the + result of calling f with no arguments. If coll has only 1 item, it + is returned and f is not called. If val is supplied, returns the + result of applying f to val and the first item in coll, then + applying f to that result and the 2nd item, etc. If coll contains no + items, returns val and f is not called." + :added "1.0"} + reduce (fn r ([f coll] (let [s (seq coll)] -- cgit v1.2.3-70-g09d2 From 85e99ee9c00e0f39cb8a960ba8e66d81e23ff49d Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 16 Jul 2010 08:11:04 -0400 Subject: switch to soft refs in DynamicClassLoader --- src/jvm/clojure/lang/DynamicClassLoader.java | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/jvm/clojure/lang/DynamicClassLoader.java b/src/jvm/clojure/lang/DynamicClassLoader.java index d27e9c86..fd2824ac 100644 --- a/src/jvm/clojure/lang/DynamicClassLoader.java +++ b/src/jvm/clojure/lang/DynamicClassLoader.java @@ -14,17 +14,16 @@ 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 constantVals = new HashMap(); -static ConcurrentHashMap >classCache = - new ConcurrentHashMap >(); +static ConcurrentHashMap>classCache = + new ConcurrentHashMap >(); static final URL[] EMPTY_URLS = new URL[]{}; @@ -43,13 +42,13 @@ public DynamicClassLoader(ClassLoader parent){ public Class defineClass(String name, byte[] bytes, Object srcForm){ Class c = defineClass(name, bytes, 0, bytes.length); - classCache.put(name, new WeakReference(c,rq)); + classCache.put(name, new SoftReference(c,rq)); //cleanup any dead entries if(rq.poll() != null) { while(rq.poll() != null) ; - for(Map.Entry> e : classCache.entrySet()) + for(Map.Entry> e : classCache.entrySet()) { if(e.getValue().get() == null) classCache.remove(e.getKey(), e.getValue()); @@ -59,7 +58,7 @@ public Class defineClass(String name, byte[] bytes, Object srcForm){ } protected Class findClass(String name) throws ClassNotFoundException{ - WeakReference cr = classCache.get(name); + SoftReference cr = classCache.get(name); if(cr != null) { Class c = cr.get(); -- cgit v1.2.3-70-g09d2 From da14cbb99fd5a3ccb4092fe629822a86065e6fb9 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 16 Jul 2010 08:25:26 -0400 Subject: factor out cache clearing to Util helper --- src/jvm/clojure/lang/DynamicClassLoader.java | 12 +----------- src/jvm/clojure/lang/Util.java | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+), 11 deletions(-) (limited to 'src') diff --git a/src/jvm/clojure/lang/DynamicClassLoader.java b/src/jvm/clojure/lang/DynamicClassLoader.java index fd2824ac..8719dc18 100644 --- a/src/jvm/clojure/lang/DynamicClassLoader.java +++ b/src/jvm/clojure/lang/DynamicClassLoader.java @@ -41,19 +41,9 @@ public DynamicClassLoader(ClassLoader parent){ } public Class defineClass(String name, byte[] bytes, Object srcForm){ + Util.clearCache(rq, classCache); Class c = defineClass(name, bytes, 0, bytes.length); classCache.put(name, new SoftReference(c,rq)); - //cleanup any dead entries - if(rq.poll() != null) - { - while(rq.poll() != null) - ; - for(Map.Entry> e : classCache.entrySet()) - { - if(e.getValue().get() == null) - classCache.remove(e.getKey(), e.getValue()); - } - } return c; } diff --git a/src/jvm/clojure/lang/Util.java b/src/jvm/clojure/lang/Util.java index 0070264c..8ef2c637 100644 --- a/src/jvm/clojure/lang/Util.java +++ b/src/jvm/clojure/lang/Util.java @@ -13,6 +13,11 @@ 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; +import java.lang.ref.Reference; public class Util{ static public boolean equiv(Object k1, Object k2){ @@ -89,4 +94,17 @@ static public ISeq ret1(ISeq ret, Object nil){ return ret; } +static public void clearCache(ReferenceQueue rq, ConcurrentHashMap> cache){ + //cleanup any dead entries + if(rq.poll() != null) + { + while(rq.poll() != null) + ; + for(Map.Entry> e : cache.entrySet()) + { + if(e.getValue().get() == null) + cache.remove(e.getKey(), e.getValue()); + } + } +} } -- cgit v1.2.3-70-g09d2 From 02559a4aad442253b601870f7c9aa04c91baf235 Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Fri, 16 Jul 2010 08:40:53 -0400 Subject: use soft refs for keyword intern table --- src/jvm/clojure/lang/Keyword.java | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) (limited to 'src') 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 table = new ConcurrentHashMap(); +private static ConcurrentHashMap> 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 existingRef = table.putIfAbsent(sym, new SoftReference(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){ -- cgit v1.2.3-70-g09d2 From befba000e922dc261e8a23a826505847c2d4d01c Mon Sep 17 00:00:00 2001 From: Fogus Date: Wed, 5 May 2010 12:07:25 -0400 Subject: Fixes missing this arg on the reify and defprotocol docstrings #340 Signed-off-by: Stuart Halloway --- src/clj/clojure/core_deftype.clj | 42 +++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 20 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj index ffe3298f..b0604c9e 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] @@ -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)) -- cgit v1.2.3-70-g09d2 From 1f6834c3d8cf001c6bb4d52ab4221855989d7e8a Mon Sep 17 00:00:00 2001 From: David Powell Date: Tue, 13 Jul 2010 23:43:20 +0100 Subject: read stdout and stderr in parallel (using futures) Signed-off-by: Stuart Halloway --- src/clj/clojure/java/shell.clj | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/java/shell.clj b/src/clj/clojure/java/shell.clj index 72f0311b..fa553671 100644 --- a/src/clj/clojure/java/shell.clj +++ b/src/clj/clojure/java/shell.clj @@ -124,10 +124,10 @@ collecting its stdout"} (.close (.getOutputStream proc))) (with-open [stdout (.getInputStream proc) stderr (.getErrorStream proc)] - (let [out (stream-to-enc stdout out-enc) - err (stream-to-string stderr) + (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 -- cgit v1.2.3-70-g09d2 From ec2037e5d93b6634d890d0a1266481aa224932d0 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Wed, 14 Jul 2010 13:41:16 -0400 Subject: fix degenerate defrecords, #402 Signed-off-by: Stuart Halloway --- src/clj/clojure/core_deftype.clj | 6 +++--- test/clojure/test_clojure/protocols.clj | 5 +++++ 2 files changed, 8 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj index b0604c9e..3b531f05 100644 --- a/src/clj/clojure/core_deftype.clj +++ b/src/clj/clojure/core_deftype.clj @@ -195,8 +195,8 @@ `(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.))) diff --git a/test/clojure/test_clojure/protocols.clj b/test/clojure/test_clojure/protocols.clj index 257a73d8..d8d2ac7f 100644 --- a/test/clojure/test_clojure/protocols.clj +++ b/test/clojure/test_clojure/protocols.clj @@ -192,6 +192,11 @@ (is (= {:foo 1 :b 2} (set/rename-keys rec {:a :foo}))) (is (= {: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" (let [rec (r 1 2)] -- cgit v1.2.3-70-g09d2 From 4d8932507a4f914d3bbdab738aa2decad1403d03 Mon Sep 17 00:00:00 2001 From: David Powell Date: Wed, 14 Jul 2010 22:28:21 +0100 Subject: fixed extend-protocol doc Signed-off-by: Stuart Halloway --- src/clj/clojure/core_deftype.clj | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj index 3b531f05..c14f82f3 100644 --- a/src/clj/clojure/core_deftype.clj +++ b/src/clj/clojure/core_deftype.clj @@ -731,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 @@ -750,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 -- cgit v1.2.3-70-g09d2 From 278af620d00907c24999b69131adaef95f804988 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sun, 25 Jul 2010 10:45:12 +0200 Subject: ♯413 parse-args defaults in-enc and out-enc to UTF-8, as required by sh MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previously parse-args was defaulting in-enc and out-enc to the platform default charset. This contradicted the intent of sh, which is to default to UTF-8 on all platforms. This appears not to have been noticed because the unit tests were still testing for the previous behavior of defaulting to platform encoding. (As it turns out the old behavior of using Charset/defaultCharset would have been wrong on Mac OS X since it claims "Mac Roman" here despite the fact that Mac OS X uses UTF-8 throughout, including in Terminal.app, shell and file system.) Signed-off-by: Stuart Halloway --- src/clj/clojure/java/shell.clj | 2 +- test/clojure/test_clojure/java/shell.clj | 10 ++++++---- 2 files changed, 7 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/java/shell.clj b/src/clj/clojure/java/shell.clj index fa553671..004629df 100644 --- a/src/clj/clojure/java/shell.clj +++ b/src/clj/clojure/java/shell.clj @@ -44,7 +44,7 @@ collecting its stdout"} (defn- parse-args [args] - (let [default-encoding (.name (Charset/defaultCharset)) + (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))])) diff --git a/test/clojure/test_clojure/java/shell.clj b/test/clojure/test_clojure/java/shell.clj index d3db7db0..56e3ff04 100644 --- a/test/clojure/test_clojure/java/shell.clj +++ b/test/clojure/test_clojure/java/shell.clj @@ -12,13 +12,15 @@ (: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) - [[] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args []) - [["ls"] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args ["ls"]) - [["ls" "-l"] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args ["ls" "-l"]) - [["ls"] {:in-enc platform-enc :out-enc "ISO-8859-1" :dir nil :env nil}] (#'sh/parse-args ["ls" :out-enc "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) -- cgit v1.2.3-70-g09d2 From 57c364136c9bc45e481c57546b9179afcc2bb75f Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Thu, 29 Jul 2010 15:27:13 -0400 Subject: #407 use munge as cheap validity test for Java method names Signed-off-by: Stuart Halloway --- src/clj/clojure/genclass.clj | 11 +++++++++++ test/clojure/test_clojure/genclass.clj | 17 +++++------------ test/clojure/test_clojure/helpers.clj | 12 ++++++++++++ 3 files changed, 28 insertions(+), 12 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/genclass.clj b/src/clj/clojure/genclass.clj index fbc7dfe8..e998d996 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/test/clojure/test_clojure/genclass.clj b/test/clojure/test_clojure/genclass.clj index cab1f595..f0a69c4f 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.)] @@ -70,3 +59,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..89a075fc 100644 --- a/test/clojure/test_clojure/helpers.clj +++ b/test/clojure/test_clojure/helpers.clj @@ -49,3 +49,15 @@ (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)))) + + -- cgit v1.2.3-70-g09d2 From ac484ba40cc1d94d42ce59e9df92b13e98ed0b6e Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 4 Aug 2010 14:44:24 -0400 Subject: fix record equality with other maps, = includes type, .equals doesn't. see #418 --- src/clj/clojure/core_deftype.clj | 18 ++++++++-------- src/jvm/clojure/lang/APersistentMap.java | 37 ++++++++++++++++++++------------ src/jvm/clojure/lang/MapEquivalence.java | 17 +++++++++++++++ src/jvm/clojure/lang/Util.java | 10 +++++++-- test/clojure/test_clojure/protocols.clj | 20 ++++++----------- 5 files changed, 64 insertions(+), 38 deletions(-) create mode 100644 src/jvm/clojure/lang/MapEquivalence.java (limited to 'src') diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj index c14f82f3..b9960c82 100644 --- a/src/clj/clojure/core_deftype.clj +++ b/src/clj/clojure/core_deftype.clj @@ -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,7 +184,13 @@ `(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#) diff --git a/src/jvm/clojure/lang/APersistentMap.java b/src/jvm/clojure/lang/APersistentMap.java index 0fe08cae..50092ba6 100644 --- a/src/jvm/clojure/lang/APersistentMap.java +++ b/src/jvm/clojure/lang/APersistentMap.java @@ -13,7 +13,7 @@ package clojure.lang; import java.io.Serializable; import java.util.*; -public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable { +public abstract class APersistentMap extends AFn implements IPersistentMap, Map, Iterable, Serializable, MapEquivalence { int _hash = -1; public String toString(){ @@ -45,15 +45,19 @@ public IPersistentCollection cons(Object o){ } public boolean equals(Object obj){ - if(this == obj) return true; + 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() != size() || m.hashCode() != hashCode()) + if(m.size() != m1.count() || m.hashCode() != m1.hashCode()) return false; - for(ISeq s = seq(); s != null; s = s.next()) + for(ISeq s = m1.seq(); s != null; s = s.next()) { Map.Entry e = (Map.Entry) s.first(); boolean found = m.containsKey(e.getKey()); @@ -68,6 +72,9 @@ public boolean equals(Object obj){ 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()) @@ -87,20 +94,22 @@ public boolean equiv(Object obj){ 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; + 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; 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/Util.java b/src/jvm/clojure/lang/Util.java index 8ef2c637..338c60a8 100644 --- a/src/jvm/clojure/lang/Util.java +++ b/src/jvm/clojure/lang/Util.java @@ -27,13 +27,19 @@ static public boolean equiv(Object k1, Object k2){ { if(k1 instanceof Number && k2 instanceof Number) return Numbers.equiv(k1, 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; diff --git a/test/clojure/test_clojure/protocols.clj b/test/clojure/test_clojure/protocols.clj index d8d2ac7f..ea9c5130 100644 --- a/test/clojure/test_clojure/protocols.clj +++ b/test/clojure/test_clojure/protocols.clj @@ -175,22 +175,16 @@ (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 (= {:foo 1 :b 2} (set/rename-keys rec {:a :foo}))) - (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.)] -- cgit v1.2.3-70-g09d2 From 0c0e9c5a0bd5ec511462553298e67b816a9284cc Mon Sep 17 00:00:00 2001 From: Rich Hickey Date: Wed, 11 Aug 2010 22:18:33 -0400 Subject: make sure future clears closed-overs, fixes #423 Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index ade4405c..5115954e 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -5410,7 +5410,7 @@ return it on all subsequent calls to deref/@. If the computation has not yet finished, calls to deref/@ will block." {:added "1.1"} - [& body] `(future-call (fn [] ~@body))) + [& body] `(future-call (^{:once true} fn* [] ~@body))) (defn future-cancel -- cgit v1.2.3-70-g09d2 From c897f1314c948e0bee82111ce6b422a258c56bfc Mon Sep 17 00:00:00 2001 From: Rasmus Svensson Date: Sun, 8 Aug 2010 00:13:16 +0200 Subject: Fix and tests for issue #404 Signed-off-by: Stuart Halloway --- src/clj/clojure/java/io.clj | 2 +- test/clojure/test_clojure/java/io.clj | 17 ++++++++++++++--- 2 files changed, 15 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/java/io.clj b/src/clj/clojure/java/io.clj index 7af37ccd..f5c3d010 100644 --- a/src/clj/clojure/java/io.clj +++ b/src/clj/clojure/java/io.clj @@ -260,7 +260,7 @@ 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-output-stream (fn [^Socket x opts] (.getOutputStream x)))) (extend byte-array-type IOFactory diff --git a/test/clojure/test_clojure/java/io.clj b/test/clojure/test_clojure/java/io.clj index 05055c3f..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] @@ -193,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))))) -- cgit v1.2.3-70-g09d2 From 62b9066a1f545b7457fb6e806acd946ce8bc3ab0 Mon Sep 17 00:00:00 2001 From: Stuart Halloway Date: Wed, 11 Aug 2010 11:05:03 -0400 Subject: preserve opts when creating socket reader, writer Signed-off-by: Stuart Halloway --- src/clj/clojure/java/io.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/java/io.clj b/src/clj/clojure/java/io.clj index f5c3d010..5f36755e 100644 --- a/src/clj/clojure/java/io.clj +++ b/src/clj/clojure/java/io.clj @@ -259,8 +259,8 @@ (extend Socket IOFactory (assoc default-streams-impl - :make-input-stream (fn [^Socket x opts] (.getInputStream x)) - :make-output-stream (fn [^Socket x opts] (.getOutputStream x)))) + :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 -- cgit v1.2.3-70-g09d2 From 5d4022276177d562906700c428f544110a0d0f1f Mon Sep 17 00:00:00 2001 From: Chouser Date: Wed, 11 Aug 2010 09:44:08 -0400 Subject: Emit finally exception table entry for each try/catch clause. Refs #422 Signed-off-by: Stuart Halloway --- src/jvm/clojure/lang/Compiler.java | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index f5684f1b..130ed5d8 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -1719,7 +1719,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(); @@ -1755,7 +1754,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); @@ -1775,7 +1773,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); -- cgit v1.2.3-70-g09d2 From 97c4c58a1c2d760c558880d347e60763282f0e97 Mon Sep 17 00:00:00 2001 From: Robert Lachlan Date: Fri, 30 Jul 2010 22:50:25 -0700 Subject: Fixing underive issues, adding tests Signed-off-by: Stuart Halloway --- src/clj/clojure/core.clj | 28 ++++---- test/clojure/test_clojure/multimethods.clj | 101 ++++++++++++++++++++++++++++- 2 files changed, 114 insertions(+), 15 deletions(-) (limited to 'src') diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 5115954e..1fbfe74a 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -4495,6 +4495,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 @@ -4502,20 +4504,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] - (reduce - (fn [ret k] - (assoc ret k - (reduce 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) + (reduce #(apply derive %1 %2) (make-hierarchy) + (partition 2 deriv-seq)) + h)))) (defn distinct? diff --git a/test/clojure/test_clojure/multimethods.clj b/test/clojure/test_clojure/multimethods.clj index 8c27034a..67747800 100644 --- a/test/clojure/test_clojure/multimethods.clj +++ b/test/clojure/test_clojure/multimethods.clj @@ -6,7 +6,7 @@ ; 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)) @@ -20,8 +20,107 @@ ; methods ; prefers + +;hierarchies for tests below, generated and literal +(def h1 (reduce #(apply derive (cons %1 %2)) (make-hierarchy) + [[:p1 :a1] [:p1 :a2] [:p2 :a2] [:c :p2] [:c :p1]])) +(def h2 (reduce #(apply derive (cons %1 %2)) (make-hierarchy) + [[:p1 :a1] [:p1 :a2] [:p2 :a2] [:c :p2]])) +(def h3 (reduce #(apply derive (cons %1 %2)) (make-hierarchy) + [[:p1 :a1] [:p2 :a2] [:c :p2] [:c :p1]])) +(def h4 {:parents {:x8 #{:x6 :x7}, :x7 #{:x5}, :x6 #{:x5}, :x5 #{:x4}, + :x4 #{:x3 :x2}, :x3 #{:x1}, :x2 #{:x1}}, + :ancestors {:x8 #{:x4 :x5 :x6 :x7 :x3 :x2 :x1}, + :x7 #{:x4 :x5 :x3 :x2 :x1}, :x6 #{:x4 :x5 :x3 :x2 :x1}, + :x5 #{:x4 :x3 :x2 :x1}, :x4 #{:x3 :x2 :x1}, :x3 #{:x1}, + :x2 #{:x1}}, + :descendants {:x7 #{:x8}, :x6 #{:x8}, :x5 #{:x8 :x6 :x7}, + :x4 #{:x8 :x5 :x6 :x7}, :x3 #{:x8 :x4 :x5 :x6 :x7}, + :x2 #{:x8 :x4 :x5 :x6 :x7}, + :x1 #{:x8 :x4 :x5 :x6 :x7 :x3 :x2}}}) +(def h5 {:parents {:x2 #{:x1}, :x3 #{:x1}, :x4 #{:x3 :x2}, :x6 #{:x5}, + :x7 #{:x5}, :x8 #{:x6 :x7}}, + :ancestors {:x2 #{:x1}, :x3 #{:x1}, :x4 #{:x3 :x2 :x1}, :x6 #{:x5}, + :x7 #{:x5}, :x8 #{:x5 :x6 :x7}}, + :descendants {:x1 #{:x4 :x3 :x2}, :x2 #{:x4}, :x3 #{:x4}, + :x5 #{:x8 :x6 :x7}, :x7 #{:x8}, :x6 #{:x8}}}) +(def h6 {:parents {:a #{:b}}, :ancestors {:a #{:b}}, :descendants {:b #{:a}}}) +(def h7 {:parents {java.util.Map #{::maps}}, + :ancestors {java.util.Map #{::maps}}, + :descendants {::maps #{java.util.Map}}}) + + ; derive, [underive] +(deftest derive-test + (is (= (derive h5 :x5 :x4) h4)) + (is (= (derive (make-hierarchy) :a :b) h6)) + (is (= (derive (make-hierarchy) java.util.Map ::maps) h7))) + + + +(deftest underive-test + (is (= (underive (make-hierarchy) :x :y) (make-hierarchy))) + (is (= (underive (derive (make-hierarchy) ::a ::b) ::a ::b) + (make-hierarchy))) + (is (= (underive h1 :c :p1) h2)) + (is (= (underive h1 :p1 :a2) h3)) + (is (= (underive h4 :x5 :x4) h5)) + (is (= (underive h5 :x5 :x4) h5)) + (is (= (underive h4 :x8 :x1) h4)) + (is (= (underive h4 :x9 :x4) h4)) + (is (= (underive h4 :x5 :x10) h4)) + (is (= (underive h7 java.util.Map ::maps) (make-hierarchy))) + (is (= (underive h7 java.util.HashMap ::maps) h7))) + + + ; isa? +(deftest isa-test + (is (isa? h4 :x5 :x4)) + (is (not (isa? h5 :x5 :x4))) + (is (isa? h4 :x8 :x1)) + (is (not (isa? h5 :x8 :x1))) + (is (isa? java.util.HashMap java.util.Map)) + (is (isa? h7 java.util.Map ::maps)) + (is (not (isa? (make-hierarchy) java.util.Map ::a)))) + + + ; parents, ancestors, descendants +(deftest family-relation + (is (= (parents h4 :x1) nil)) + (is (= (parents h4 :x4) #{:x2 :x3})) + (is (= (ancestors h5 :x1) nil)) + (is (= (ancestors h4 :x4) #{:x1 :x2 :x3})) + (is (= (descendants h4 :y) nil)) + (is (= (descendants h5 :x5) #{:x6 :x7 :x8}))) + +; some simple global hierarchy tests + +(derive ::y1 ::y2) +(derive ::y3 ::y4) + +(deftest global-isa1 + (derive ::y4 ::y1) + (is (isa? ::y1 ::y2)) + (not (isa? ::y3 ::y2))) + + +(derive java.util.HashMap ::y4) + +(deftest global-isa2 + (is (isa? ::y3 ::y2)) + (is (isa? java.util.HashMap ::y2))) + + +(deftest global-underive + (derive ::y4 ::y1) + (underive ::y4 ::y1) + (is (not (isa? ::y3 ::y1))) + (is (not (isa? java.util.HashMap ::y2)))) + + ; make-hierarchy +(deftest make-hierarchy-test + (is (= {:parents {} :descendants {} :ancestors {}} (make-hierarchy)))) -- cgit v1.2.3-70-g09d2