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

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

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

File size: 4.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Jun 26 21:55:26 2004
4;;;; Contains: Tests of PPRINT-LINEAR
5
6(in-package :cl-test)
7
8;;; When printing a non-list, the result is the same as calling WRITE."
9(deftest pprint-linear.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) (assert (equal (multiple-value-list
18                                                                     (pprint-linear s obj))
19                                                                    '(nil))))))
20                  (unless (equal s1 s2)
21                    (list (list obj s1 s2))))))))
22  nil)
23
24(deftest pprint-linear.2
25  (my-with-standard-io-syntax
26   (let ((*print-pretty* nil)
27         (*print-readably* nil))
28     (loop for obj in *mini-universe*
29           nconc
30           (and (not (listp obj))
31                (let ((s1 (write-to-string obj))
32                      (s2 (with-output-to-string (s) (assert (equal (multiple-value-list
33                                                                     (pprint-linear s obj))
34                                                                    '(nil))))))
35                  (unless (equal s1 s2)
36                    (list (list obj s1 s2))))))))
37  nil)
38
39(defmacro def-pprint-linear-test (name args expected-value &key (margin 100) (circle nil))
40  `(deftest ,name
41     (my-with-standard-io-syntax
42      (let ((*print-pretty* t)
43            (*print-readably* nil)
44            (*print-right-margin* ,margin)
45            (*package* (find-package "CL-TEST"))
46            (*print-circle* ,circle))
47        (with-output-to-string
48          (s)
49          (pprint-linear s ,@args))))
50     ,expected-value))
51
52(def-pprint-linear-test pprint-linear.3 ('(|A|)) "(A)")
53(def-pprint-linear-test pprint-linear.4 ('(|A|) t) "(A)")
54(def-pprint-linear-test pprint-linear.5 ('(|A|) nil) "A")
55(def-pprint-linear-test pprint-linear.6 ('(1 2 3 4 5)) "(1 2 3 4 5)")
56(def-pprint-linear-test pprint-linear.7 ('((1) (2) #(3) "abc" 5) nil) "(1) (2) #(3) \"abc\" 5")
57
58;;; The fourth argument is ignored
59(def-pprint-linear-test pprint-linear.8 ('(1 2 3 4 5) t nil) "(1 2 3 4 5)")
60(def-pprint-linear-test pprint-linear.9 ('(1 2 3 4 5) nil t) "1 2 3 4 5")
61
62;;; Takes T, NIL as stream designators
63
64(deftest pprint-linear.10
65  (my-with-standard-io-syntax
66   (let ((*print-pretty* nil)
67         (*print-readably* nil)
68         (*print-right-margin* 100))
69     (with-output-to-string
70       (os)
71       (with-input-from-string
72        (is "")
73        (with-open-stream (*terminal-io* (make-two-way-stream is os))
74                          (pprint-linear t '(1 2 3)))))))
75  "(1 2 3)")
76
77(deftest pprint-linear.11
78  (my-with-standard-io-syntax
79   (let ((*print-pretty* t)
80         (*print-readably* nil)
81         (*print-right-margin* 100))
82     (with-output-to-string (*standard-output*) (pprint-linear nil '(1 2 3)))))
83  "(1 2 3)")
84
85(deftest pprint-linear.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-linear 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              ((< (count #\Newline s) (length obj))
103               (list :bad3 s))
104              (t t)))
105           unless (eql result t)
106           collect (list i result))))
107  nil)
108
109(deftest pprint-linear.13
110  (my-with-standard-io-syntax
111   (let ((*print-pretty* t)
112         (*print-readably* nil)
113         (*package* (find-package :cl-test))
114         (obj '(|M| |M| |M| |M| |M| |M| |M| |M| |M| |M| |M|)))
115     (loop for i from 1 to 10
116           for result =
117           (let* ((*print-right-margin* i)
118                  (s (with-output-to-string (os)
119                                            (terpri os)
120                                            (pprint-linear os obj nil))))
121             (cond
122              ((not (eql (elt s 0) #\Newline))
123               (list :bad1 s))
124              ((not (equal (read-from-string (concatenate 'string "(" s ")"))
125                           obj))
126               (list :bad2 s))
127              ((< (count #\Newline s) (length obj))
128               (list :bad3 s))
129              (t t)))
130           unless (eql result t)
131           collect (list i result))))
132  nil)
133
134;;;
135(def-pprint-linear-test pprint-linear.14 ((let ((x (list '|A|))) (list x x)))
136  "(#1=(A) #1#)" :circle t)
137
138;;; Error tests
139
140(deftest pprint-linear.error.1
141  (signals-error (pprint-linear) program-error)
142  t)
143
144(deftest pprint-linear.error.2
145  (signals-error (pprint-linear *standard-output*) program-error)
146  t)
147
148(deftest pprint-linear.error.3
149  (signals-error (pprint-linear *standard-output* nil t t t) program-error)
150  t)
Note: See TracBrowser for help on using the repository browser.