1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/test_contrib/pprint/test_pretty.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,127 @@
     1.4 +;;; pretty.clj -- part of the pretty printer for Clojure
     1.5 +
     1.6 +;; by Tom Faulhaber
     1.7 +;; April 3, 2009
     1.8 +
     1.9 +;   Copyright (c) Tom Faulhaber, Feb 2009. All rights reserved.
    1.10 +;   The use and distribution terms for this software are covered by the
    1.11 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    1.12 +;   which can be found in the file epl-v10.html at the root of this distribution.
    1.13 +;   By using this software in any fashion, you are agreeing to be bound by
    1.14 +;   the terms of this license.
    1.15 +;   You must not remove this notice, or any other, from this software.
    1.16 +
    1.17 +(ns clojure.contrib.pprint.test-pretty
    1.18 +  (:use [clojure.test :only (deftest are run-tests)]
    1.19 +        clojure.contrib.pprint.test-helper
    1.20 +        clojure.contrib.pprint))
    1.21 +
    1.22 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.23 +;;;
    1.24 +;;; Unit tests for the pretty printer
    1.25 +;;;
    1.26 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.27 +
    1.28 +(simple-tests xp-fill-test
    1.29 +  (binding [*print-pprint-dispatch* *simple-dispatch*
    1.30 +            *print-right-margin* 38
    1.31 +            *print-miser-width* nil]
    1.32 +    (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%"
    1.33 +               '((x 4) (*print-length* nil) (z 2) (list nil))))
    1.34 +  "(let ((x 4) (*print-length* nil)\n      (z 2) (list nil))\n ...)\n"
    1.35 +
    1.36 +  (binding [*print-pprint-dispatch* *simple-dispatch*
    1.37 +            *print-right-margin* 22]
    1.38 +    (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%"
    1.39 +               '((x 4) (*print-length* nil) (z 2) (list nil))))
    1.40 +  "(let ((x 4)\n      (*print-length*\n       nil)\n      (z 2)\n      (list nil))\n ...)\n")
    1.41 +
    1.42 +(simple-tests xp-miser-test
    1.43 +  (binding [*print-pprint-dispatch* *simple-dispatch*
    1.44 +            *print-right-margin* 10, *print-miser-width* 9]
    1.45 +    (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third)))
    1.46 +  "(LIST\n first\n second\n third)"
    1.47 +
    1.48 +  (binding [*print-pprint-dispatch* *simple-dispatch*
    1.49 +            *print-right-margin* 10, *print-miser-width* 8]
    1.50 +    (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third)))
    1.51 +  "(LIST first second third)")
    1.52 +
    1.53 +(simple-tests mandatory-fill-test
    1.54 +  (cl-format nil
    1.55 +             "<pre>~%~<Usage: ~:I~@{*~a*~^~:@_~}~:>~%</pre>~%"
    1.56 +             [ "hello" "gooodbye" ])
    1.57 +  "<pre>
    1.58 +Usage: *hello*
    1.59 +       *gooodbye*
    1.60 +</pre>
    1.61 +")
    1.62 +
    1.63 +(simple-tests prefix-suffix-test
    1.64 +  (binding [*print-pprint-dispatch* *simple-dispatch*
    1.65 +            *print-right-margin* 10, *print-miser-width* 10]
    1.66 +    (cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third)))
    1.67 +  "{LIST\n first\n second\n third}")
    1.68 +
    1.69 +(simple-tests pprint-test
    1.70 +  (binding [*print-pprint-dispatch* *simple-dispatch*]
    1.71 +    (write '(defn foo [x y] 
    1.72 +              (let [result (* x y)] 
    1.73 +                (if (> result 400) 
    1.74 +                  (cl-format true "That number is too big")
    1.75 +                  (cl-format true "The  result of ~d x ~d is ~d" x y result))))
    1.76 +           :stream nil))
    1.77 +  "(defn
    1.78 + foo
    1.79 + [x y]
    1.80 + (let
    1.81 +  [result (* x y)]
    1.82 +  (if
    1.83 +   (> result 400)
    1.84 +   (cl-format true \"That number is too big\")
    1.85 +   (cl-format true \"The  result of ~d x ~d is ~d\" x y result))))"
    1.86 +
    1.87 +  (with-pprint-dispatch *code-dispatch*
    1.88 +    (write '(defn foo [x y] 
    1.89 +              (let [result (* x y)] 
    1.90 +                (if (> result 400) 
    1.91 +                  (cl-format true "That number is too big")
    1.92 +                  (cl-format true "The  result of ~d x ~d is ~d" x y result))))
    1.93 +           :stream nil))
    1.94 +  "(defn foo [x y]
    1.95 +  (let [result (* x y)]
    1.96 +    (if (> result 400)
    1.97 +      (cl-format true \"That number is too big\")
    1.98 +      (cl-format true \"The  result of ~d x ~d is ~d\" x y result))))"
    1.99 +
   1.100 +  (binding [*print-pprint-dispatch* *simple-dispatch*
   1.101 +            *print-right-margin* 15] 
   1.102 +    (write '(fn (cons (car x) (cdr y))) :stream nil))
   1.103 +  "(fn\n (cons\n  (car x)\n  (cdr y)))"
   1.104 +
   1.105 +  (with-pprint-dispatch *code-dispatch*
   1.106 +    (binding [*print-right-margin* 52] 
   1.107 +      (write 
   1.108 +       '(add-to-buffer this (make-buffer-blob (str (char c)) nil))
   1.109 +       :stream nil)))
   1.110 +  "(add-to-buffer\n  this\n  (make-buffer-blob (str (char c)) nil))"
   1.111 +  )
   1.112 +
   1.113 +
   1.114 +
   1.115 +(simple-tests pprint-reader-macro-test
   1.116 +  (with-pprint-dispatch *code-dispatch*
   1.117 +    (write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])")
   1.118 +	   :stream nil))
   1.119 +  "(map #(first %) [[1 2 3] [4 5 6] [7]])"
   1.120 +
   1.121 +  (with-pprint-dispatch *code-dispatch*
   1.122 +    (write (read-string "@@(ref (ref 1))")
   1.123 +	   :stream nil))
   1.124 +  "@@(ref (ref 1))"
   1.125 +
   1.126 +  (with-pprint-dispatch *code-dispatch*
   1.127 +    (write (read-string "'foo")
   1.128 +	   :stream nil))
   1.129 +  "'foo"
   1.130 +)