source: trunk/source/tests/ansi-tests/print-cons.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.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon Apr 19 07:28:40 2004
4;;;; Contains: Tests of printing of conses
5
6(compile-and-load "printer-aux.lsp")
7
8(in-package :cl-test)
9
10(deftest print.cons.1
11  (my-with-standard-io-syntax
12   (let ((*print-readably* nil))
13     (write-to-string '(|A|) :case :upcase :pretty nil :escape nil)))
14  "(A)")
15
16(deftest print.cons.2
17  (my-with-standard-io-syntax
18   (let ((*print-readably* nil))
19     (write-to-string '(|A| |B|) :case :upcase :pretty nil :escape nil)))
20  "(A B)")
21
22(deftest print.cons.3
23  (my-with-standard-io-syntax
24   (let ((*print-readably* nil))
25     (write-to-string (cons '|A| '|B|) :case :upcase :pretty nil :escape nil)))
26  "(A . B)")
27
28(deftest print.cons.4
29  (my-with-standard-io-syntax
30   (let ((*print-readably* nil))
31     (write-to-string (let ((s '#:|X|)) (cons s s)) :case :upcase :pretty nil :escape t)))
32  "(#:X . #:X)")
33
34(deftest print.cons.5
35  (my-with-standard-io-syntax
36   (let ((*print-readably* nil))
37     (write-to-string (let ((s '#:|X|)) (cons s s)) :case :upcase :pretty nil :escape t :circle t)))
38  "(#1=#:X . #1#)")
39
40(deftest print.cons.6
41  (my-with-standard-io-syntax
42   (let ((*print-readably* nil))
43     (write-to-string (let ((s1 (make-symbol "X"))
44                            (s2 (make-symbol "X")))
45                        (list s1 s2 s1 s2))
46                      :case :upcase :pretty nil :escape t :circle t)))
47  "(#1=#:X #2=#:X #1# #2#)")
48
49(deftest print.cons.7
50  (my-with-standard-io-syntax
51   (let ((*print-readably* nil))
52     (write-to-string (let ((a (list 17 nil)))
53                        (setf (cdr a) a)
54                        a)
55                      :circle t :pretty nil :escape nil)))
56  "#1=(17 . #1#)")
57
58;;; Random printing
59
60(deftest print.cons.random.1
61  (trim-list
62   (loop
63    for x = (make-random-cons-tree (random 100))
64    repeat 50
65    nconc (randomly-check-readability x))
66   10)
67  nil)
68
69;; random circular cons graphs
70#-lispworks
71(deftest print.cons.random.2
72  (loop repeat 50
73        nconc
74        (let* ((n 20)
75               (conses (apply #'vector
76                              (loop repeat n collect (cons nil nil)))))
77          (loop for x across conses
78                for j = (random n)
79                for k = (random n)
80                do (setf (car x) (elt conses j)
81                         (cdr x) (elt conses k)))
82          (randomly-check-readability (elt conses 0) :test #'is-similar
83                                      :circle t)))
84  nil)
85
86;;; Printing with *print-length*
87
88(deftest print.cons.length.1
89  (my-with-standard-io-syntax
90   (let ((*print-readably* nil))
91     (write-to-string '(a) :length 0 :pretty nil :escape nil)))
92  "(...)")
93
94(deftest print.cons.length.2
95  (my-with-standard-io-syntax
96   (let ((*print-readably* nil))
97     (write-to-string '(81) :length 1 :pretty nil :escape nil)))
98  "(81)")
99
100(deftest print.cons.length.3
101  (my-with-standard-io-syntax
102   (let ((*print-readably* nil))
103     (write-to-string '(4 . 8) :length 1 :pretty nil :escape nil)))
104  "(4 . 8)")
105
106(deftest print.cons.length.4
107  (my-with-standard-io-syntax
108   (let ((*print-readably* nil))   
109     (write-to-string '(4 8) :length 1 :pretty nil :escape nil)))
110  "(4 ...)")
111
112(deftest print.cons.length.5
113  (my-with-standard-io-syntax
114   (let ((*print-readably* nil))
115     (write-to-string '(a b c d e f g h i j k l m n o p)
116                      :case :downcase :length 10
117                      :pretty nil :escape nil)))
118  "(a b c d e f g h i j ...)")
119
120
121(deftest print.cons.length.6
122  (my-with-standard-io-syntax
123   (let ((*print-readably* nil))   
124     (write-to-string '(((((((0)))))))
125                      :case :downcase :length 3
126                      :pretty nil :escape nil)))
127  "(((((((0)))))))")
128
129;;; Printing with *print-level*
130
131(deftest print.cons.level.1
132  (my-with-standard-io-syntax
133   (let ((*print-readably* nil))
134     (write-to-string '(a)
135                      :case :downcase :level 0
136                      :escape nil :pretty nil)))
137  "#")
138
139(deftest print.cons.level.2
140  (my-with-standard-io-syntax
141   (let ((*print-readably* nil))
142     (write-to-string '(a)
143                      :case :downcase :level 1
144                      :escape nil :pretty nil)))
145  "(a)")
146
147(deftest print.cons.level.3
148  (my-with-standard-io-syntax
149   (let ((*print-readably* nil))
150     (write-to-string '((a))
151                      :case :downcase :level 1
152                      :escape nil :pretty nil)))
153  "(#)")
154
155
156(deftest print.cons.level.4
157  (my-with-standard-io-syntax
158   (let ((*print-readably* nil))
159     (write-to-string '(a)
160                      :case :downcase :level 2
161                      :escape nil :pretty nil)))
162  "(a)")
163
164(deftest print.cons.level.5
165  (my-with-standard-io-syntax
166   (let ((*print-readably* nil))
167     (write-to-string '(#(a) #*1101 "abc")
168                      :case :downcase :level 1
169                      :pretty nil)))
170  "(# #*1101 \"abc\")")
Note: See TracBrowser for help on using the repository browser.