source: trunk/source/tests/ansi-tests/pprint-fill.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 4.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Jun 25 22:03:01 2004
4;;;; Contains: Tests of PPRINT-FILL
5
6(in-package :cl-test)
7
8;;; When printing a non-list, the result is the same as calling WRITE."
9(deftest pprint-fill.1
10  (my-with-standard-io-syntax
11   (let ((*print-pretty* t)
12         (*print-readably* nil))
13     (loop for obj in *mini-universe*
14           nconc
15           (and (not (listp obj))
16                (let ((s1 (write-to-string obj))
17                      (s2 (with-output-to-string (s) (pprint-fill s obj))))
18                  (unless (equal s1 s2)
19                    (list (list obj s1 s2))))))))
20  nil)
21
22(deftest pprint-fill.2
23  (my-with-standard-io-syntax
24   (let ((*print-pretty* nil)
25         (*print-readably* nil))
26     (loop for obj in *mini-universe*
27           nconc
28           (and (not (listp obj))
29                (let ((s1 (write-to-string obj))
30                      (s2 (with-output-to-string (s) (pprint-fill s obj))))
31                  (unless (equal s1 s2)
32                    (list (list obj s1 s2))))))))
33  nil)
34
35(defmacro def-pprint-fill-test (name args expected-value &key (margin 100) (circle nil) (len nil))
36  `(deftest ,name
37     (my-with-standard-io-syntax
38      (let ((*print-pretty* t)
39            (*print-readably* nil)
40            (*print-right-margin* ,margin)
41            (*package* (find-package "CL-TEST"))
42            (*print-length* ,len)
43            (*print-circle* ,circle))
44        (with-output-to-string (s) (pprint-fill s ,@args))))
45     ,expected-value))
46
47(def-pprint-fill-test pprint-fill.3 ('(|A|)) "(A)")
48(def-pprint-fill-test pprint-fill.4 ('(|A|) t) "(A)")
49(def-pprint-fill-test pprint-fill.5 ('(|A|) nil) "A")
50(def-pprint-fill-test pprint-fill.6 ('(1 2 3 4 5)) "(1 2 3 4 5)")
51(def-pprint-fill-test pprint-fill.7 ('((1) (2) #(3) "abc" 5) nil) "(1) (2) #(3) \"abc\" 5")
52
53;;; The fourth argument is ignored
54(def-pprint-fill-test pprint-fill.8 ('(1 2 3 4 5) t nil) "(1 2 3 4 5)")
55(def-pprint-fill-test pprint-fill.9 ('(1 2 3 4 5) nil t) "1 2 3 4 5")
56
57;;; Takes T, NIL as stream designators
58
59(deftest pprint-fill.10
60  (my-with-standard-io-syntax
61   (let ((*print-pretty* nil)
62         (*print-readably* nil)
63         (*print-right-margin* 100))
64     (with-output-to-string
65       (os)
66       (with-input-from-string
67        (is "")
68        (with-open-stream (*terminal-io* (make-two-way-stream is os))
69                          (pprint-fill t '(1 2 3)))))))
70  "(1 2 3)")
71
72(deftest pprint-fill.11
73  (my-with-standard-io-syntax
74   (let ((*print-pretty* t)
75         (*print-readably* nil)
76         (*print-right-margin* 100))
77     (with-output-to-string (*standard-output*) (pprint-fill nil '(1 2 3)))))
78  "(1 2 3)")
79
80
81;;; Now tests for cases that should be wrapped
82;;; It's not entirely clear what they should be doing
83;;; but check for some obvious properties
84
85(deftest pprint-fill.12
86  (my-with-standard-io-syntax
87   (let ((*print-pretty* t)
88         (*print-readably* nil)
89         (*package* (find-package :cl-test))
90         (obj '(|M| |M| |M| |M| |M| |M| |M| |M| |M| |M|)))
91     (loop for i from 1 to 10
92           for result =
93           (let* ((*print-right-margin* i)
94                  (s (with-output-to-string (os)
95                                            (terpri os)
96                                            (pprint-fill os obj))))
97             (cond
98              ((not (eql (elt s 0) #\Newline))
99               (list :bad1 s))
100              ((not (equal (read-from-string s) obj))
101               (list :bad2 s))
102              ((not (find #\Newline s :start 1))
103               (list :bad3 s))
104              (t t)))
105           unless (eql result t)
106           collect (list i result))))
107  nil)
108
109
110(deftest pprint-fill.13
111  (my-with-standard-io-syntax
112   (let ((*print-pretty* t)
113         (*print-readably* nil)
114         (*package* (find-package :cl-test))
115         (obj '(|M| |M| |M| |M| |M| |M| |M| |M| |M| |M| |M|)))
116     (loop for i from 1 to 10
117           for result =
118           (let* ((*print-right-margin* i)
119                  (s (with-output-to-string (os)
120                                            (terpri os)
121                                            (pprint-fill os obj nil))))
122             (cond
123              ((not (eql (elt s 0) #\Newline))
124               (list :bad1 s))
125              ((not (equal (read-from-string (concatenate 'string "(" s ")"))
126                           obj))
127               (list :bad2 s))
128              ((not (find #\Newline s :start 1))
129               (list :bad3 s))
130              (t t)))
131           unless (eql result t)
132           collect (list i result))))
133  nil)
134
135;;;
136(def-pprint-fill-test pprint-fill.14 ((let ((x (list '|A|))) (list x x)))
137  "(#1=(A) #1#)" :circle t)
138
139(def-pprint-fill-test pprint-fill.15 ((let ((x (list '|A|))) (setf (cdr x) x) x))
140  "#1=(A . #1#)" :circle t :len 500)
141
142
143;;; Test that pprint-fill returns NIL
144
145(deftest pprint-fill.return-values.1
146  (my-with-standard-io-syntax
147   (let ((*print-pretty* nil)
148         (*package* (find-package "CL-TEST")))
149     (with-open-stream (s (make-broadcast-stream))
150                       (pprint-fill s '(a b)))))
151  nil)
152
153(deftest pprint-fill.return-values.2
154  (my-with-standard-io-syntax
155   (let ((*print-pretty* nil)
156         (*package* (find-package :cl-test)))
157     (with-open-stream (s (make-broadcast-stream))
158                       (pprint-fill s 10 nil t))))
159  nil)
160
161;;; Error tests
162
163(deftest pprint-fill.error.1
164  (signals-error (pprint-fill) program-error)
165  t)
166
167(deftest pprint-fill.error.2
168  (signals-error (pprint-fill *standard-output*) program-error)
169  t)
170
171(deftest pprint-fill.error.3
172  (signals-error (pprint-fill *standard-output* nil t t t) program-error)
173  t)
Note: See TracBrowser for help on using the repository browser.