Mercurial > lasercutter

     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 )
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children