pprint-newline.lsp 10.2 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Jul  7 07:48:01 2004
;;;; Contains: Tests of PPRINT-NEWLINE

(in-package :cl-test)

(compile-and-load "printer-aux.lsp")

(defmacro def-pprint-newline-test (name form expected-value &rest key-args)
  `(def-pprint-test ,name
     (with-output-to-string
       (*standard-output*)
       (pprint-logical-block (*standard-output* nil) ,form))
     ,expected-value
     ,@key-args))

;;; NIL designates the standard output

(def-pprint-test pprint-newline.1
  (with-output-to-string
    (*standard-output*)
    (pprint-logical-block
     (*standard-output* nil)
     (dotimes (i 8)
       (write-char #\A)
       (write-char #\Space)
       (pprint-newline :fill nil))))
  "A A A A A
A A A "
  :margin 10)

;;; T designates the stream *terminal-io*
(def-pprint-test pprint-newline.2
  (with-output-to-string
    (os)
    (with-input-from-string
     (is "")
     (with-open-stream
      (*terminal-io* (make-two-way-stream is os))
      (pprint-logical-block
       (*terminal-io* nil)
       (dotimes (i 8)
sds's avatar
sds committed
44 45
         (write "A " :stream t)
         (pprint-newline :fill t))))))
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
  "A A A A A
A A A "
  :margin 10)

;;; No stream is standard output

(def-pprint-test pprint-newline.3
  (with-output-to-string
    (*standard-output*)
    (pprint-logical-block
     (*standard-output* nil)
     (dotimes (i 8)
       (write-char #\A)
       (write-char #\Space)
       (pprint-newline :fill))))
  "A A A A A
A A A "
  :margin 10)

;;; :linear

67
(def-ppblock-test pprint-newline.linear.1
68 69 70 71 72 73 74 75
  (progn
   (dotimes (i 2) (write "A ") (pprint-newline :fill))
   (write "B ") (pprint-newline :linear)
   (dotimes (i 3) (write "A ") (pprint-newline :fill)))
  "A A B
A A A "
  :margin 10)

76
(def-ppblock-test pprint-newline.linear.2
77 78 79 80 81 82 83 84 85 86 87
  (progn
   (dotimes (i 2) (write "A ") (pprint-newline :fill))
   (write "B ") (pprint-newline :linear)
   (dotimes (i 2) (write "C ") (pprint-newline :fill))
   (write "D ") (pprint-newline :linear)
   (dotimes (i 3) (write "A ") (pprint-newline :fill)))
  "A A B
C C D
A A A "
  :margin 10)

88
(def-ppblock-test pprint-newline.linear.3
89 90 91 92
  (dotimes (i 4) (write "A ") (pprint-newline :linear))
  "A A A A "
  :margin 10)

93
(def-ppblock-test pprint-newline.linear.4
94 95 96 97 98
  (dotimes (i 4) (write "A ") (pprint-newline :linear))
  "A A A A "
  :margin 10
  :miser 10)

99
(def-ppblock-test pprint-newline.linear.5
100 101 102 103 104
  (dotimes (i 10) (write "A ") (pprint-newline :linear))
  "A A A A A A A A A A "
  :margin 10
  :pretty nil)

105
(def-ppblock-test pprint-newline.linear.6
106 107 108 109 110 111 112 113
  (dotimes (i 4) (write "A             ") (pprint-newline :linear))
  "A
A
A
A
"
  :margin 10)

114
(def-ppblock-test pprint-newline.linear.7
115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
  (progn
    (dotimes (i 4) (write "A ") (pprint-newline :linear))
    (terpri)
    (dotimes (i 4) (write "A ") (pprint-newline :linear)))
  "A
A
A
A

A
A
A
A
"
  :margin 10)

131
(def-ppblock-test pprint-newline.linear.8
132 133
  (progn
    (pprint-logical-block (*standard-output* nil)
sds's avatar
sds committed
134 135 136
                          (dotimes (i 4)
                            (write "A ")
                            (pprint-newline :linear)))
137 138
    (pprint-newline :linear)
    (pprint-logical-block (*standard-output* nil)
sds's avatar
sds committed
139 140 141
                          (dotimes (i 4)
                            (write "A ")
                            (pprint-newline :linear))))
142 143 144
  "A A A A
A A A A "
  :margin 10)
sds's avatar
sds committed
145

146
(def-ppblock-test pprint-newline.linear.9
147 148 149 150
  (dotimes (i 10) (write "A ") (let ((*print-pretty* nil)) (pprint-newline :linear)))
  "A A A A A A A A A A "
  :margin 10)

pfdietz's avatar
pfdietz committed
151 152 153
(deftest pprint-newline.linear.10
  (with-standard-io-syntax
   (let ((*print-readably* nil)
sds's avatar
sds committed
154 155 156 157
         (*print-escape* nil)
         (*print-pretty* t)
         (*print-right-margin* 4)
         (*print-miser-width* nil))
pfdietz's avatar
pfdietz committed
158 159 160 161 162
     (with-output-to-string
       (*standard-output*)
       (dotimes (i 5) (write "A ") (pprint-newline :linear)))))
  "A A A A A ")

163 164
;;; :miser

165
(def-ppblock-test pprint-newline.miser.1
166 167 168 169
  (dotimes (i 10) (write "A ") (pprint-newline :miser))
  "A A A A A A A A A A "
  :margin 10)

170
(def-ppblock-test pprint-newline.miser.2
171 172 173 174 175
  (dotimes (i 10) (write "A ") (pprint-newline :miser))
  "A A A A A A A A A A "
  :margin 10
  :miser 0)

176
(def-ppblock-test pprint-newline.miser.3
177 178 179 180 181
  (dotimes (i 10) (write "A ") (pprint-newline :miser))
  "A A A A A A A A A A "
  :margin 10
  :miser 9)

182
(def-ppblock-test pprint-newline.miser.4
183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
  (dotimes (i 10) (write "A ") (pprint-newline :miser))
  "A
A
A
A
A
A
A
A
A
A
"
  :margin 10
  :miser 10)

198
(def-ppblock-test pprint-newline.miser.5
199 200 201 202 203 204
  (dotimes (i 10) (write "A ") (pprint-newline :miser))
  "A A A A A A A A A A "
  :margin 10
  :miser 10
  :pretty nil)

205
(def-ppblock-test pprint-newline.miser.6
206 207 208 209 210 211 212 213 214 215
  (progn
    (terpri)
    (write "A")
    (pprint-newline :miser))
  "
A
"
  :margin 20
  :miser 20)

216
(def-ppblock-test pprint-newline.miser.7
217 218 219 220 221 222 223 224 225 226
  (progn
    (pprint-newline :miser)
    (write "A")
    (terpri))
  "
A
"
  :margin 20
  :miser 20)

227
(def-ppblock-test pprint-newline.miser.8
pfdietz's avatar
pfdietz committed
228 229 230 231 232 233 234 235 236 237 238
  (progn
    (write "AAAA ")
    (pprint-newline :linear)
    (pprint-logical-block
     (*standard-output* nil)
     (dotimes (i 4) (write "A ") (pprint-newline :miser))))
  "AAAA
A A A A "
  :margin 10
  :miser 8)

239
(def-ppblock-test pprint-newline.miser.9
pfdietz's avatar
pfdietz committed
240 241 242 243 244 245 246 247 248 249 250
  (progn
    (write "AAAA ")
    (pprint-newline :fill)
    (pprint-logical-block
     (*standard-output* nil)
     (dotimes (i 4) (write "A ") (pprint-newline :miser))))
  "AAAA
A A A A "
  :margin 10
  :miser 8)

251
(def-ppblock-test pprint-newline.miser.10
pfdietz's avatar
pfdietz committed
252
  (pprint-logical-block (*standard-output* nil :prefix "(" :suffix ")")
sds's avatar
sds committed
253 254 255
                        (write "A")
                        (pprint-newline :miser)
                        (pprint-newline :mandatory))
pfdietz's avatar
pfdietz committed
256 257 258 259 260 261
  "(A

 )"
  :margin 20
  :miser 20)

262
(def-ppblock-test pprint-newline.miser.11
pfdietz's avatar
pfdietz committed
263
  (pprint-logical-block (*standard-output* nil :prefix "(" :suffix ")")
sds's avatar
sds committed
264 265 266
                        (write "A")
                        (pprint-newline :miser)
                        (pprint-newline :mandatory))
pfdietz's avatar
pfdietz committed
267 268 269 270 271 272
  "(A

 )"
  :margin 20
  :miser 19)

273
(def-ppblock-test pprint-newline.miser.12
pfdietz's avatar
pfdietz committed
274
  (pprint-logical-block (*standard-output* nil :prefix "(" :suffix ")")
sds's avatar
sds committed
275 276 277
                        (write "A")
                        (pprint-newline :miser)
                        (pprint-newline :mandatory))
pfdietz's avatar
pfdietz committed
278 279 280 281 282 283 284 285
  "(A
 )"
  :margin 20
  :miser 18)

(deftest pprint-newline.miser.13
  (with-standard-io-syntax
   (let ((*print-readably* nil)
sds's avatar
sds committed
286 287 288 289
         (*print-escape* nil)
         (*print-pretty* t)
         (*print-right-margin* 4)
         (*print-miser-width* 4))
pfdietz's avatar
pfdietz committed
290 291 292 293 294 295 296
     (with-output-to-string
       (*standard-output*)
       (dotimes (i 5) (write "A ") (pprint-newline :miser)))))
  "A A A A A ")

;;; :fill

297
(def-ppblock-test pprint-newline.fill.1
pfdietz's avatar
pfdietz committed
298 299 300 301 302
  (dotimes (i 10) (write "A ") (pprint-newline :fill))
  "A A A A A
A A A A A "
  :margin 10)

303
(def-ppblock-test pprint-newline.fill.2
pfdietz's avatar
pfdietz committed
304 305 306 307 308 309 310
  (dotimes (i 10) (write "A ") (pprint-newline :fill))
  "A A A
A A A
A A A
A "
  :margin 6)

311
(def-ppblock-test pprint-newline.fill.3
pfdietz's avatar
pfdietz committed
312 313 314 315 316 317 318
  (dotimes (i 10) (write "A ") (pprint-newline :fill))
  "A A A
A A A
A A A
A "
  :margin 7)

319
(def-ppblock-test pprint-newline.fill.4
pfdietz's avatar
pfdietz committed
320 321 322 323 324 325
    (dotimes (i 10) (write "A ") (pprint-newline :fill))
  "A A A A A
A A A A A "
  :margin 10
  :miser 9)

326
(def-ppblock-test pprint-newline.fill.5
pfdietz's avatar
pfdietz committed
327 328 329 330 331 332 333 334 335 336 337 338 339 340 341
    (dotimes (i 10) (write "A ") (pprint-newline :fill))
  "A
A
A
A
A
A
A
A
A
A
"
  :margin 10
  :miser 10)

342
(def-ppblock-test pprint-newline.fill.6
pfdietz's avatar
pfdietz committed
343 344 345 346 347 348 349 350 351
    (dotimes (i 5)
      (write '(A B))
      (write #\Space)
      (pprint-newline :fill))
  "(A B) (A B)
(A B) (A B)
(A B) "
  :margin 12)

352
(def-ppblock-test pprint-newline.fill.7
pfdietz's avatar
pfdietz committed
353 354 355 356 357 358 359 360 361 362 363
    (dolist (x '(A (A B) (A A A A A A A A) X (C D) (E F)))
      (pprint-fill nil x)
      (write #\Space)
      (pprint-newline :fill))
  "A (A B)
(A A A A A
 A A A)
X (C D)
(E F) "
  :margin 12)

364
(def-ppblock-test pprint-newline.fill.8
pfdietz's avatar
pfdietz committed
365 366 367 368 369 370 371 372 373 374
    (dotimes (i 5)
      (write '(A B) :pretty nil)
      (write #\Space)
      (let ((*print-pretty* nil)) (pprint-newline :fill)))
  "(A B) (A B) (A B) (A B) (A B) "
  :margin 12)

(deftest pprint-newline.fill.9
  (with-standard-io-syntax
   (let ((*print-readably* nil)
sds's avatar
sds committed
375 376 377 378
         (*print-escape* nil)
         (*print-right-margin* 4)
         (*print-pretty* t)
         (*print-miser-width* nil))
pfdietz's avatar
pfdietz committed
379 380 381 382 383 384 385 386
     (with-output-to-string
       (*standard-output*)
       (dotimes (i 5) (write "A ") (pprint-newline :fill)))))
  "A A A A A ")

(deftest pprint-newline.fill.10
  (with-standard-io-syntax
   (let ((*print-readably* nil)
sds's avatar
sds committed
387 388 389 390
         (*print-escape* nil)
         (*print-right-margin* 4)
         (*print-pretty* t)
         (*print-miser-width* 4))
pfdietz's avatar
pfdietz committed
391 392 393 394 395 396 397 398
     (with-output-to-string
       (*standard-output*)
       (dotimes (i 5) (write "A ") (pprint-newline :fill)))))
  "A A A A A ")


;;; :mandatory

399
(def-ppblock-test pprint-newline.mandatory.1
pfdietz's avatar
pfdietz committed
400 401 402 403 404 405 406
  (dotimes (i 4) (write "A ") (pprint-newline :mandatory))
  "A
A
A
A
")

407
(def-ppblock-test pprint-newline.mandatory.2
pfdietz's avatar
pfdietz committed
408 409 410 411 412 413 414 415
  (dotimes (i 4) (write "A ") (pprint-newline :mandatory))
  "A
A
A
A
"
  :margin 10)

416
(def-ppblock-test pprint-newline.mandatory.3
pfdietz's avatar
pfdietz committed
417 418 419 420 421 422 423 424
  (progn
    (write "A ")
    (pprint-newline :mandatory)
    (write "A "))
  "A
A "
  :margin 1)

425
(def-ppblock-test pprint-newline.mandatory.4
pfdietz's avatar
pfdietz committed
426 427 428 429
  (dotimes (i 4) (write "A ") (pprint-newline :mandatory))
  "A A A A "
  :pretty nil)

430
(def-ppblock-test pprint-newline.mandatory.5
pfdietz's avatar
pfdietz committed
431 432 433 434 435 436 437 438 439 440 441 442 443
  (pprint-logical-block
   (*standard-output* nil :prefix "<<<" :suffix ">>>")
   (dotimes (i 4) (write "A ") (pprint-newline :mandatory))
   (write "A"))
  "<<<A
   A
   A
   A
   A>>>")

(deftest pprint-newline.mandatory.6
  (with-standard-io-syntax
   (let ((*print-readably* nil)
sds's avatar
sds committed
444 445 446 447
         (*print-escape* nil)
         (*print-pretty* t)
         (*print-right-margin* 4)
         (*print-miser-width* nil))
pfdietz's avatar
pfdietz committed
448 449 450 451 452 453 454 455
     (with-output-to-string
       (*standard-output*)
       (dotimes (i 5) (write "A ") (pprint-newline :mandatory)))))
  "A A A A A ")

;;; Error cases

(deftest pprint-newline.error.1
pfdietz's avatar
pfdietz committed
456
  (check-type-error #'pprint-newline
sds's avatar
sds committed
457
                    (typef '(member :linear :miser :fill :mandatory)))
pfdietz's avatar
pfdietz committed
458 459
  nil)

460
(deftest pprint-newline.error.1-unsafe
pfdietz's avatar
pfdietz committed
461
  (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pprint-newline x))
sds's avatar
sds committed
462
                    (typef '(member :linear :miser :fill :mandatory)))
463 464
  nil)

pfdietz's avatar
pfdietz committed
465 466 467 468 469 470 471
(deftest pprint-newline.error.2
  (signals-error (pprint-newline) program-error)
  t)

(deftest pprint-newline.error.3
  (signals-error (pprint-newline :fill nil nil) program-error)
  t)