pprint-exit-if-list-exhausted.lsp 10.2 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Jul  6 06:11:01 2004
;;;; Contains: Tests of PPRINT-EXIT-IF-LIST-EXHAUSTED, PPRINT-POP

(in-package :cl-test)

(deftest pprint-exit-if-list-exhausted.1
  (with-standard-io-syntax
   (let ((*print-pretty* nil)
sds's avatar
sds committed
11 12 13 14
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         )
15 16 17
     (with-output-to-string
       (os)
       (pprint-logical-block
sds's avatar
sds committed
18 19 20 21 22 23 24 25 26 27 28 29
        (os '(1 2))
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write (pprint-pop) :stream os)
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write #\Space :stream os)
        (write (pprint-pop) :stream os)
        (pprint-exit-if-list-exhausted)
        (assert nil)))))
30 31 32 33 34
  "1 2")

(deftest pprint-exit-if-list-exhausted.2
  (with-standard-io-syntax
   (let ((*print-pretty* t)
sds's avatar
sds committed
35 36 37 38
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         )
39 40 41
     (with-output-to-string
       (os)
       (pprint-logical-block
sds's avatar
sds committed
42 43 44 45 46 47 48 49 50 51 52 53
        (os '(1 2))
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write (pprint-pop) :stream os)
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write #\Space :stream os)
        (write (pprint-pop) :stream os)
        (pprint-exit-if-list-exhausted)
        (assert nil)))))
54 55 56 57 58
  "1 2")

(deftest pprint-exit-if-list-exhausted.3
  (with-standard-io-syntax
   (let ((*print-pretty* t)
sds's avatar
sds committed
59 60 61 62
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         )
63 64 65
     (with-output-to-string
       (os)
       (pprint-logical-block
sds's avatar
sds committed
66 67 68 69 70 71 72 73 74 75 76
        (os '(1 . 2))
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write (pprint-pop) :stream os)
        (write #\Space :stream os)
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (pprint-pop)
        (assert nil)))))
77 78 79 80 81
  "1 . 2")

(deftest pprint-exit-if-list-exhausted.4
  (with-standard-io-syntax
   (let ((*print-pretty* t)
sds's avatar
sds committed
82 83 84 85
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         )
86 87 88
     (with-output-to-string
       (os)
       (pprint-logical-block
sds's avatar
sds committed
89 90 91 92 93 94 95 96 97 98 99
        (os '(1 . 2) :prefix "[" :suffix "]")
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write (pprint-pop) :stream os)
        (write #\Space :stream os)
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (pprint-pop)
        (assert nil)))))
100 101 102 103 104 105 106
  "[1 . 2]")

;;; Tests focusing on pprint-pop

(deftest pprint-pop.1
  (with-standard-io-syntax
   (let ((*print-pretty* t)
sds's avatar
sds committed
107 108 109 110
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-length* 0))
111 112 113
     (with-output-to-string
       (os)
       (pprint-logical-block
sds's avatar
sds committed
114 115 116
        (os nil)
        (pprint-pop)
        (assert nil)))))
117 118 119 120 121
  "...")

(deftest pprint-pop.2
  (with-standard-io-syntax
   (let ((*print-pretty* t)
sds's avatar
sds committed
122 123 124 125
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-length* 0))
126 127 128
     (with-output-to-string
       (os)
       (pprint-logical-block
sds's avatar
sds committed
129 130
        (os 1)
        (pprint-pop)))))
131 132 133 134 135
  "1")

(deftest pprint-pop.3
  (with-standard-io-syntax
   (let ((*print-pretty* t)
sds's avatar
sds committed
136 137 138 139
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-length* 1))
140 141 142
     (with-output-to-string
       (os)
       (pprint-logical-block
sds's avatar
sds committed
143 144
        (os '(1))
        (assert (equal '(1) (multiple-value-list (pprint-pop))))))))
145 146 147 148 149
  "")

(deftest pprint-pop.4
  (with-standard-io-syntax
   (let ((*print-pretty* t)
sds's avatar
sds committed
150 151 152 153
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-length* 0))
154 155 156
     (with-output-to-string
       (os)
       (pprint-logical-block
sds's avatar
sds committed
157 158 159
        (os '(1 2 3) :prefix "{" :suffix "}")
        (pprint-pop)
        (assert nil)))))
160 161 162
  "{...}")

(deftest pprint-pop.5
163
  (flet ((%f (len)
sds's avatar
sds committed
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
             (with-standard-io-syntax
              (let ((*print-pretty* t)
                    (*print-escape* nil)
                    (*print-right-margin* 100)
                    (*print-readably* nil)
                    (*print-length* len))
                (with-output-to-string
                  (os)
                  (pprint-logical-block
                   (os '(1 2 3 4 5) :prefix "{" :suffix "}")
                   (pprint-exit-if-list-exhausted)
                   (write (pprint-pop) :stream os)
                   (loop (pprint-exit-if-list-exhausted)
                         (write #\Space :stream os)
                         (write (pprint-pop) :stream os))))))))
179 180 181 182 183 184 185 186
    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 4) (%f 5) (%f 6)))
  "{...}"
  "{1 ...}"
  "{1 2 ...}"
  "{1 2 3 ...}"
  "{1 2 3 4 ...}"
  "{1 2 3 4 5}"
  "{1 2 3 4 5}")
187 188

(deftest pprint-pop.6
189
  (flet ((%f (len)
sds's avatar
sds committed
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204
             (with-standard-io-syntax
              (let ((*print-pretty* t)
                    (*print-escape* nil)
                    (*print-right-margin* 100)
                    (*print-readably* nil)
                    (*print-length* len))
                (with-output-to-string
                  (os)
                  (pprint-logical-block
                   (os '(1 2 . 3) :prefix "{" :suffix "}")
                   (pprint-exit-if-list-exhausted)
                   (write (pprint-pop) :stream os)
                   (loop (pprint-exit-if-list-exhausted)
                         (write #\Space :stream os)
                         (write (pprint-pop) :stream os))))))))
205 206 207 208 209
    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
  "{...}"
  "{1 ...}"
  "{1 2 . 3}"
  "{1 2 . 3}"
210 211
  "{1 2 . 3}")

212 213 214 215
;;; pprint-pop and circularity/sharing

(deftest pprint-pop.7
  (flet ((%f (len)
sds's avatar
sds committed
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233
             (with-standard-io-syntax
              (let ((*print-pretty* t)
                    (*print-escape* nil)
                    (*print-right-margin* 100)
                    (*print-readably* nil)
                    (*print-length* len)
                    (*print-circle* t))
                (with-output-to-string
                  (os)
                  (let* ((tail (list 1))
                         (x (list* tail 2 tail)))
                    (pprint-logical-block
                     (os x :prefix "<" :suffix ">")
                     (pprint-exit-if-list-exhausted)
                     (write (pprint-pop) :stream os)
                     (loop (pprint-exit-if-list-exhausted)
                           (write #\Space :stream os)
                           (write (pprint-pop) :stream os)))))))))
234 235 236 237 238 239 240 241 242 243
    (values (%f nil) (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
  "<#1=(1) 2 . #1#>"
  "<...>"
  "<(1) ...>"
  "<(1) 2 ...>"
  "<#1=(1) 2 . #1#>"
  "<#1=(1) 2 . #1#>")

(deftest pprint-pop.8
  (flet ((%f (len)
sds's avatar
sds committed
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262
             (with-standard-io-syntax
              (let ((*print-pretty* t)
                    (*print-escape* nil)
                    (*print-right-margin* 100)
                    (*print-readably* nil)
                    (*print-length* len)
                    (*print-circle* t))
                (with-output-to-string
                  (os)
                  (let* ((tail (list 2))
                         (x (list* 1 tail)))
                    (setf (cdr tail) tail)
                    (pprint-logical-block
                     (os x :prefix "[[" :suffix "]]")
                     (pprint-exit-if-list-exhausted)
                     (write (pprint-pop) :stream os)
                     (loop (pprint-exit-if-list-exhausted)
                           (write #\Space :stream os)
                           (write (pprint-pop) :stream os)))))))))
263 264 265 266 267 268 269 270
    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 10) (%f 20)))
  "[[...]]"
  "[[1 ...]]"
  "[[1 2 ...]]"
  "[[1 . #1=(2 . #1#)]]"
  "[[1 . #1=(2 . #1#)]]"
  "[[1 . #1=(2 . #1#)]]")

271 272 273 274
;;; pprint-pop when pprint-logical-block is given NIL

(deftest pprint-pop.9
  (flet ((%f (len)
sds's avatar
sds committed
275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
             (with-standard-io-syntax
              (let ((*print-pretty* t)
                    (*print-escape* nil)
                    (*print-right-margin* 100)
                    (*print-readably* nil)
                    (*print-length* len))
                (with-output-to-string
                  (os)
                  (pprint-logical-block
                   (os nil :prefix "{" :suffix "}")
                   (let ((vals (multiple-value-list (pprint-pop))))
                     (assert (equal vals '(nil)) () "First call returned ~A" vals))
                   (write 1 :stream os)
                   (write #\Space :stream os)
                   (let ((vals (multiple-value-list (pprint-pop))))
                     (assert (equal vals '(nil)) () "Second call returned ~A" vals))
                   (write 2 :stream os)
                   (write #\Space :stream os)
                   (let ((vals (multiple-value-list (pprint-pop))))
                     (assert (equal vals '(nil)) () "Third call returned ~A" vals))
                   (write 3 :stream os)
                   ))))))
297 298 299 300 301 302 303
    (values (%f nil) (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
  "{1 2 3}"
  "{...}"
  "{1 ...}"
  "{1 2 ...}"
  "{1 2 3}"
  "{1 2 3}")
304

305 306 307 308 309 310
;;; Error cases

(deftest pprint-exit-if-list-exhausted.error.1
  (signals-error (pprint-exit-if-list-exhausted) error)
  t)

311 312
(deftest pprint-exit-if-list-exhausted.error.1-unsafe
  (locally (declare (optimize (safety 0)))
sds's avatar
sds committed
313 314 315
           (signals-error (locally (declare (optimize (safety 0)))
                                   (pprint-exit-if-list-exhausted))
                          error))
316 317
  t)

318 319 320 321 322
(deftest pprint-pop.error.1
  (signals-error (pprint-pop) error)
  t)


323 324
(deftest pprint-pop.error.1-unsafe
  (locally (declare (optimize (safety 0)))
sds's avatar
sds committed
325
           (signals-error (locally (declare (optimize (safety 0))) (pprint-pop)) error))
326
  t)