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