diff options
| -rw-r--r-- | src/clj/clojure/pprint/pprint_base.clj | 19 | ||||
| -rw-r--r-- | test/clojure/test_clojure/pprint/test_pretty.clj | 27 |
2 files changed, 38 insertions, 8 deletions
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" +) |