|
rlm@10
|
1 ;;; pretty.clj -- part of the pretty printer for Clojure
|
|
rlm@10
|
2
|
|
rlm@10
|
3 ;; by Tom Faulhaber
|
|
rlm@10
|
4 ;; April 3, 2009
|
|
rlm@10
|
5
|
|
rlm@10
|
6 ; Copyright (c) Tom Faulhaber, Feb 2009. All rights reserved.
|
|
rlm@10
|
7 ; The use and distribution terms for this software are covered by the
|
|
rlm@10
|
8 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
|
rlm@10
|
9 ; which can be found in the file epl-v10.html at the root of this distribution.
|
|
rlm@10
|
10 ; By using this software in any fashion, you are agreeing to be bound by
|
|
rlm@10
|
11 ; the terms of this license.
|
|
rlm@10
|
12 ; You must not remove this notice, or any other, from this software.
|
|
rlm@10
|
13
|
|
rlm@10
|
14 (ns clojure.contrib.pprint.test-pretty
|
|
rlm@10
|
15 (:use [clojure.test :only (deftest are run-tests)]
|
|
rlm@10
|
16 clojure.contrib.pprint.test-helper
|
|
rlm@10
|
17 clojure.contrib.pprint))
|
|
rlm@10
|
18
|
|
rlm@10
|
19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
20 ;;;
|
|
rlm@10
|
21 ;;; Unit tests for the pretty printer
|
|
rlm@10
|
22 ;;;
|
|
rlm@10
|
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
24
|
|
rlm@10
|
25 (simple-tests xp-fill-test
|
|
rlm@10
|
26 (binding [*print-pprint-dispatch* *simple-dispatch*
|
|
rlm@10
|
27 *print-right-margin* 38
|
|
rlm@10
|
28 *print-miser-width* nil]
|
|
rlm@10
|
29 (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%"
|
|
rlm@10
|
30 '((x 4) (*print-length* nil) (z 2) (list nil))))
|
|
rlm@10
|
31 "(let ((x 4) (*print-length* nil)\n (z 2) (list nil))\n ...)\n"
|
|
rlm@10
|
32
|
|
rlm@10
|
33 (binding [*print-pprint-dispatch* *simple-dispatch*
|
|
rlm@10
|
34 *print-right-margin* 22]
|
|
rlm@10
|
35 (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%"
|
|
rlm@10
|
36 '((x 4) (*print-length* nil) (z 2) (list nil))))
|
|
rlm@10
|
37 "(let ((x 4)\n (*print-length*\n nil)\n (z 2)\n (list nil))\n ...)\n")
|
|
rlm@10
|
38
|
|
rlm@10
|
39 (simple-tests xp-miser-test
|
|
rlm@10
|
40 (binding [*print-pprint-dispatch* *simple-dispatch*
|
|
rlm@10
|
41 *print-right-margin* 10, *print-miser-width* 9]
|
|
rlm@10
|
42 (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third)))
|
|
rlm@10
|
43 "(LIST\n first\n second\n third)"
|
|
rlm@10
|
44
|
|
rlm@10
|
45 (binding [*print-pprint-dispatch* *simple-dispatch*
|
|
rlm@10
|
46 *print-right-margin* 10, *print-miser-width* 8]
|
|
rlm@10
|
47 (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third)))
|
|
rlm@10
|
48 "(LIST first second third)")
|
|
rlm@10
|
49
|
|
rlm@10
|
50 (simple-tests mandatory-fill-test
|
|
rlm@10
|
51 (cl-format nil
|
|
rlm@10
|
52 "<pre>~%~<Usage: ~:I~@{*~a*~^~:@_~}~:>~%</pre>~%"
|
|
rlm@10
|
53 [ "hello" "gooodbye" ])
|
|
rlm@10
|
54 "<pre>
|
|
rlm@10
|
55 Usage: *hello*
|
|
rlm@10
|
56 *gooodbye*
|
|
rlm@10
|
57 </pre>
|
|
rlm@10
|
58 ")
|
|
rlm@10
|
59
|
|
rlm@10
|
60 (simple-tests prefix-suffix-test
|
|
rlm@10
|
61 (binding [*print-pprint-dispatch* *simple-dispatch*
|
|
rlm@10
|
62 *print-right-margin* 10, *print-miser-width* 10]
|
|
rlm@10
|
63 (cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third)))
|
|
rlm@10
|
64 "{LIST\n first\n second\n third}")
|
|
rlm@10
|
65
|
|
rlm@10
|
66 (simple-tests pprint-test
|
|
rlm@10
|
67 (binding [*print-pprint-dispatch* *simple-dispatch*]
|
|
rlm@10
|
68 (write '(defn foo [x y]
|
|
rlm@10
|
69 (let [result (* x y)]
|
|
rlm@10
|
70 (if (> result 400)
|
|
rlm@10
|
71 (cl-format true "That number is too big")
|
|
rlm@10
|
72 (cl-format true "The result of ~d x ~d is ~d" x y result))))
|
|
rlm@10
|
73 :stream nil))
|
|
rlm@10
|
74 "(defn
|
|
rlm@10
|
75 foo
|
|
rlm@10
|
76 [x y]
|
|
rlm@10
|
77 (let
|
|
rlm@10
|
78 [result (* x y)]
|
|
rlm@10
|
79 (if
|
|
rlm@10
|
80 (> result 400)
|
|
rlm@10
|
81 (cl-format true \"That number is too big\")
|
|
rlm@10
|
82 (cl-format true \"The result of ~d x ~d is ~d\" x y result))))"
|
|
rlm@10
|
83
|
|
rlm@10
|
84 (with-pprint-dispatch *code-dispatch*
|
|
rlm@10
|
85 (write '(defn foo [x y]
|
|
rlm@10
|
86 (let [result (* x y)]
|
|
rlm@10
|
87 (if (> result 400)
|
|
rlm@10
|
88 (cl-format true "That number is too big")
|
|
rlm@10
|
89 (cl-format true "The result of ~d x ~d is ~d" x y result))))
|
|
rlm@10
|
90 :stream nil))
|
|
rlm@10
|
91 "(defn foo [x y]
|
|
rlm@10
|
92 (let [result (* x y)]
|
|
rlm@10
|
93 (if (> result 400)
|
|
rlm@10
|
94 (cl-format true \"That number is too big\")
|
|
rlm@10
|
95 (cl-format true \"The result of ~d x ~d is ~d\" x y result))))"
|
|
rlm@10
|
96
|
|
rlm@10
|
97 (binding [*print-pprint-dispatch* *simple-dispatch*
|
|
rlm@10
|
98 *print-right-margin* 15]
|
|
rlm@10
|
99 (write '(fn (cons (car x) (cdr y))) :stream nil))
|
|
rlm@10
|
100 "(fn\n (cons\n (car x)\n (cdr y)))"
|
|
rlm@10
|
101
|
|
rlm@10
|
102 (with-pprint-dispatch *code-dispatch*
|
|
rlm@10
|
103 (binding [*print-right-margin* 52]
|
|
rlm@10
|
104 (write
|
|
rlm@10
|
105 '(add-to-buffer this (make-buffer-blob (str (char c)) nil))
|
|
rlm@10
|
106 :stream nil)))
|
|
rlm@10
|
107 "(add-to-buffer\n this\n (make-buffer-blob (str (char c)) nil))"
|
|
rlm@10
|
108 )
|
|
rlm@10
|
109
|
|
rlm@10
|
110
|
|
rlm@10
|
111
|
|
rlm@10
|
112 (simple-tests pprint-reader-macro-test
|
|
rlm@10
|
113 (with-pprint-dispatch *code-dispatch*
|
|
rlm@10
|
114 (write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])")
|
|
rlm@10
|
115 :stream nil))
|
|
rlm@10
|
116 "(map #(first %) [[1 2 3] [4 5 6] [7]])"
|
|
rlm@10
|
117
|
|
rlm@10
|
118 (with-pprint-dispatch *code-dispatch*
|
|
rlm@10
|
119 (write (read-string "@@(ref (ref 1))")
|
|
rlm@10
|
120 :stream nil))
|
|
rlm@10
|
121 "@@(ref (ref 1))"
|
|
rlm@10
|
122
|
|
rlm@10
|
123 (with-pprint-dispatch *code-dispatch*
|
|
rlm@10
|
124 (write (read-string "'foo")
|
|
rlm@10
|
125 :stream nil))
|
|
rlm@10
|
126 "'foo"
|
|
rlm@10
|
127 )
|
