format-d.lsp 20 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Jul 31 05:19:39 2004
;;;; Contains: Tests of the ~D format directive

(in-package :cl-test)

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

(deftest format.d.1
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
13 14 15 16 17 18 19 20 21
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~D" i)
         for j = (read-from-string s1)
         repeat 1000
         when (or (/= i j)
                  (find #\. s1)
                  (find #\+ s1)
                  (find-if #'alpha-char-p s1))
         collect (list i s1 j)))
22 23
  nil)

24 25 26 27
(deftest formatter.d.1
  (let ((fn (formatter "~D")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
28 29 30 31 32 33 34 35 36
           for i = (- (random (+ x x)) x)
           for s1 = (formatter-call-to-string fn i)
           for j = (read-from-string s1)
           repeat 1000
           when (or (/= i j)
                    (find #\. s1)
                    (find #\+ s1)
                    (find-if #'alpha-char-p s1))
           collect (list i s1 j))))
37 38
  nil)

39 40 41
(deftest format.d.2
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
42 43 44 45 46 47 48 49 50
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~@d" i)
         for j = (read-from-string s1)
         repeat 1000
         when (or (/= i j)
                  (find #\. s1)
                  ;; (find #\+ s1)
                  (find-if #'alpha-char-p s1))
         collect (list i s1 j)))
51 52
  nil)

53 54 55 56
(deftest formatter.d.2
  (let ((fn (formatter "~@D")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
57 58 59 60 61 62 63 64 65
           for i = (- (random (+ x x)) x)
           for s1 = (formatter-call-to-string fn i)
           for j = (read-from-string s1)
           repeat 1000
           when (or (/= i j)
                    (find #\. s1)
                    ;; (find #\+ s1)
                    (find-if #'alpha-char-p s1))
           collect (list i s1 j))))
66 67
  nil)

68 69 70
(deftest format.d.3
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
71 72 73 74 75 76 77 78 79 80 81 82
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~d" i)
         for s2 = (format nil (format nil "~~~dd" mincol) i)
         for pos = (search s1 s2)
         repeat 1000
         when (or (null pos)
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (not (eql (position #\Space s2 :test-not #'eql)
                                     (- (length s2) (length s1)))))))
         collect (list i mincol s1 s2 pos)))
83 84
  nil)

85 86 87
(deftest formatter.d.3
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~d" i)
         for format-string = (format nil "~~~dd" mincol)
         ; for s2 = (format nil format-string i)
         for fn = (eval `(formatter ,format-string))
         for s2 = (formatter-call-to-string fn i)
         for pos = (search s1 s2)
         repeat 100
         when (or (null pos)
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (not (eql (position #\Space s2 :test-not #'eql)
                                     (- (length s2) (length s1)))))))
         collect (list i mincol s1 s2 pos)))
103 104
  nil)

105 106
(deftest format.d.4
  (with-standard-io-syntax
107
   (loop with limit = 10
sds's avatar
sds committed
108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
         with count = 0
         for x = (ash 1 (+ 2 (random 80)))
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~@D" i)
         for format-string = (format nil "~~~d@d" mincol)
         for s2 = (format nil format-string i)
         for pos = (search s1 s2)
         repeat 1000
         when (or (null pos)
                  (and (>= i 0) (not (eql (elt s1 0) #\+)))
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (not (eql (position #\Space s2 :test-not #'eql)
                                     (- (length s2) (length s1)))))))
         collect (if (> (incf count) limit)
                     "Count limit exceeded"
                     (list i mincol s1 format-string s2 pos))
         while (<= count limit)))
127 128
  nil)

129
(deftest formatter.d.4
130
  (with-standard-io-syntax
131
   (loop with limit = 10
sds's avatar
sds committed
132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151
         with count = 0
         for x = (ash 1 (+ 2 (random 80)))
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~@D" i)
         for format-string = (format nil "~~~d@d" mincol)
         for fn = (eval `(formatter ,format-string))
         for s2 = (formatter-call-to-string fn i)
         for pos = (search s1 s2)
         repeat 100
         when (or (null pos)
                  (and (>= i 0) (not (eql (elt s1 0) #\+)))
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (not (eql (position #\Space s2 :test-not #'eql)
                                     (- (length s2) (length s1)))))))
         collect (if (> (incf count) limit)
                     "Count limit exceeded"
                   (list i mincol s1 s2 pos))
         while (<= count limit)))
152 153
  nil)

154
(deftest format.d.5
155 156
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
157 158 159 160 161 162 163 164 165 166 167 168 169
         for mincol = (random 30)
         for padchar = (random-from-seq +standard-chars+)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~d" i)
         for s2 = (format nil (format nil "~~~d,'~cd" mincol padchar) i)
         for pos = (search s1 s2)
         repeat 1000
         when (or (null pos)
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (find padchar s2 :end (- (length s2) (length s1))
                                 :test-not #'eql))))
         collect (list i mincol s1 s2 pos)))
170 171
  nil)

172
(deftest formatter.d.5
173 174
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
         for mincol = (random 30)
         for padchar = (random-from-seq +standard-chars+)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~d" i)
         for format-string = (format nil "~~~d,'~cd" mincol padchar)
         for fn = (eval `(formatter ,format-string))
         for s2 = (formatter-call-to-string fn i)
         for pos = (search s1 s2)
         repeat 100
         when (or (null pos)
                  (and (> mincol (length s1))
                       (or (/= (length s2) mincol)
                           (find padchar s2 :end (- (length s2) (length s1))
                                 :test-not #'eql))))
         collect (list i mincol s1 s2 pos)))
190 191
  nil)

192 193 194 195
(deftest format.d.6
  (let ((fn (formatter "~v,vd")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
           for mincol = (random 30)
           for padchar = (random-from-seq +standard-chars+)
           for i = (- (random (+ x x)) x)
           for s1 = (format nil "~d" i)
           for s2 = (format nil "~v,vD" mincol padchar i)
           for s3 = (formatter-call-to-string fn mincol padchar i)
           for pos = (search s1 s2)
           repeat 1000
           when (or (null pos)
                    (not (string= s2 s3))
                    (and (> mincol (length s1))
                         (or (/= (length s2) mincol)
                             (find padchar s2 :end (- (length s2) (length s1))
                                   :test-not #'eql))))
           collect (list i mincol s1 s2 s3 pos))))
211 212 213 214 215
  nil)

(deftest format.d.7
  (let ((fn (formatter "~v,v@D")))
    (with-standard-io-syntax
216
     (loop with limit = 10
sds's avatar
sds committed
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
           with count = 0
           for x = (ash 1 (+ 2 (random 80)))
           for mincol = (random 30)
           for padchar = (random-from-seq +standard-chars+)
           for i = (- (random (+ x x)) x)
           for s1 = (format nil "~@d" i)
           for s2 = (format nil "~v,v@d" mincol padchar i)
           for s3 = (formatter-call-to-string fn mincol padchar i)
           for pos = (search s1 s2)
           repeat 1000
           when (or (null pos)
                    (not (string= s2 s3))
                    (and (>= i 0) (not (eql (elt s1 0) #\+)))
                    (and (> mincol (length s1))
                         (or (/= (length s2) mincol)
                             (find padchar s2 :end (- (length s2) (length s1))
                                   :test-not #'eql))))
           collect (if (> (incf count) limit)
                       "Count limit exceeded"
                     (list i mincol s1 s2 s3 pos))
           while (<= count limit))))
238 239
  nil)

240 241 242
;;; Comma tests

(deftest format.d.8
243
  (let ((fn1 (formatter "~d"))
sds's avatar
sds committed
244
        (fn2 (formatter "~:d")))
245
    (loop for i from -999 to 999
sds's avatar
sds committed
246 247 248 249 250 251
          for s1 = (format nil "~d" i)
          for s2 = (format nil "~:d" i)
          for s3 = (formatter-call-to-string fn1 i)
          for s4 = (formatter-call-to-string fn2 i)
          unless (and (string= s1 s2) (string= s1 s3) (string= s1 s4))
          collect (list i s1 s2 s3 s4)))
252 253 254
  nil)

(deftest format.d.9
255
  (let ((fn1 (formatter "~d"))
sds's avatar
sds committed
256
        (fn2 (formatter "~:d")))
257 258
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277
           for i = (- (random (+ x x)) x)
           for commachar = #\,
           for s1 = (format nil "~d" i)
           for s2 = (format nil "~:d" i)
           for s3 = (formatter-call-to-string fn1 i)
           for s4 = (formatter-call-to-string fn2 i)
           repeat 1000
           unless (and (string= s1 s3)
                       (string= s2 s4)
                       (string= s1 (remove commachar s2))
                       (not (eql (elt s2 0) commachar))
                       (or (>= i 0) (not (eql (elt s2 1) commachar)))
                       (let ((len (length s2))
                             (ci+1 4))
                         (loop for i from (if (< i 0) 2 1) below len
                               always (if (= (mod (- len i) ci+1) 0)
                                          (eql (elt s2 i) commachar)
                                        (find (elt s2 i) "0123456789")))))
           collect (list x i commachar s1 s2 s3 s4))))
278 279 280
  nil)

(deftest format.d.10
281 282 283
  (let ((fn (formatter "~,,v:d")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for s1 = (format nil "~d" i)
           for s2 = (format nil "~,,v:d" commachar i)
           for s3 = (formatter-call-to-string fn commachar i)
           repeat 1000
           unless (and
                   (string= s2 s3)
                   (eql (elt s1 0) (elt s2 0))
                   (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
                   (let ((len (length s2))
                         (ci+1 4)
                         (j (if (< i 0) 1 0)))
                     (loop for i from (if (< i 0) 2 1) below len
                           always (if (= (mod (- len i) ci+1) 0)
                                      (eql (elt s2 i) commachar)
                                    (eql (elt s1 (incf j)) (elt s2 i))))))
           collect (list x i commachar s1 s2 s3))))
302 303 304
  nil)

(deftest format.d.11
305 306
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323
         for i = (- (random (+ x x)) x)
         for commachar = (random-from-seq +standard-chars+)
         for s1 = (format nil "~d" i)
         for format-string = (format nil "~~,,'~c:d" commachar)
         for s2 = (format nil format-string i)
         repeat 1000
         unless (and
                 (eql (elt s1 0) (elt s2 0))
                 (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
                 (let ((len (length s2))
                      (ci+1 4)
                      (j (if (< i 0) 1 0)))
                  (loop for i from (if (< i 0) 2 1) below len
                        always (if (= (mod (- len i) ci+1) 0)
                                   (eql (elt s2 i) commachar)
                                 (eql (elt s1 (incf j)) (elt s2 i))))))
         collect (list x i commachar s1 s2)))
324 325
  nil)

326
(deftest formatter.d.11
327 328
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347
         for i = (- (random (+ x x)) x)
         for commachar = (random-from-seq +standard-chars+)
         for s1 = (format nil "~d" i)
         for format-string = (format nil "~~,,'~c:d" commachar)
         for fn = (eval `(formatter ,format-string))
         ; for s2 = (format nil format-string i)
         for s2 = (formatter-call-to-string fn i)
         repeat 100
         unless (and
                 (eql (elt s1 0) (elt s2 0))
                 (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
                 (let ((len (length s2))
                      (ci+1 4)
                      (j (if (< i 0) 1 0)))
                  (loop for i from (if (< i 0) 2 1) below len
                        always (if (= (mod (- len i) ci+1) 0)
                                   (eql (elt s2 i) commachar)
                                 (eql (elt s1 (incf j)) (elt s2 i))))))
         collect (list x i commachar s1 s2)))
348 349 350
  nil)

(deftest format.d.12
351 352 353
  (let ((fn (formatter "~,,v,v:d")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for commaint = (1+ (random 20))
           for s1 = (format nil "~d" i)
           for s2 = (format nil "~,,v,v:D" commachar commaint i)
           for s3 = (formatter-call-to-string fn commachar commaint i)
           repeat 1000
           unless (and
                   (string= s2 s3)
                   (eql (elt s1 0) (elt s2 0))
                   (if (< i 0) (eql (elt s1 1) (elt s2 1)) t)
                   (let ((len (length s2))
                         (ci+1 (1+ commaint))
                         (j (if (< i 0) 1 0)))
                     (loop for i from (if (< i 0) 2 1) below len
                           always (if (= (mod (- len i) ci+1) 0)
                                      (eql (elt s2 i) commachar)
                                    (eql (elt s1 (incf j)) (elt s2 i))))))
           collect (list x i commachar s1 s2 s3))))
373 374 375
  nil)

(deftest format.d.13
376 377 378
  (let ((fn (formatter "~,,v,v:@D")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for commaint = (1+ (random 20))
           for s1 = (format nil "~@d" i)
           for s2 = (format nil "~,,v,v:@d" commachar commaint i)
           for s3 = (formatter-call-to-string fn commachar commaint i)
           repeat 1000
           unless (and
                   (eql (elt s1 0) (elt s2 0))
                   (eql (elt s1 1) (elt s2 1))
                   (let ((len (length s2))
                         (ci+1 (1+ commaint))
                         (j 1))
                     (loop for i from 2 below len
                           always (if (= (mod (- len i) ci+1) 0)
                                      (eql (elt s2 i) commachar)
                                    (eql (elt s1 (incf j)) (elt s2 i))))))
           collect (list x i commachar s1 s2 s3))))
397 398 399 400
  nil)

;;; NIL arguments

401 402
(def-format-test format.d.14
  "~vD" (nil 100) "100")
403

404 405
(def-format-test format.d.15
  "~6,vD" (nil 100) "   100")
406

407 408
(def-format-test format.d.16
  "~,,v:d" (nil 12345) "12,345")
409

410 411
(def-format-test format.d.17
  "~,,'*,v:d" (nil 12345) "12*345")
412 413 414 415 416

;;; When the argument is not an integer, print as if using ~A and base 10

(deftest format.d.18
  (loop for x in *mini-universe*
sds's avatar
sds committed
417 418 419 420
        for s1 = (format nil "~d" x)
        for s2 = (format nil "~A" x)
        unless (or (integerp x) (string= s1 s2))
        collect (list x s1 s2))
421 422 423 424
  nil)

(deftest format.d.19
  (loop for x in *mini-universe*
sds's avatar
sds committed
425 426 427 428
        for s1 = (format nil "~:d" x)
        for s2 = (format nil "~A" x)
        unless (or (integerp x) (string= s1 s2))
        collect (list x s1 s2))
429 430 431 432
  nil)

(deftest format.d.20
  (loop for x in *mini-universe*
sds's avatar
sds committed
433 434 435 436
        for s1 = (format nil "~@d" x)
        for s2 = (format nil "~A" x)
        unless (or (integerp x) (string= s1 s2))
        collect (list x s1 s2))
437 438 439 440
  nil)

(deftest format.d.21
  (loop for x in *mini-universe*
sds's avatar
sds committed
441 442
        for s1 = (format nil "~A" x)
        for s2 = (format nil "~@:d" x)
443
        for s3 = (format nil "~A" x)
sds's avatar
sds committed
444 445
        unless (or (integerp x) (string= s1 s2) (not (string= s1 s3)))
        collect (list x s1 s2))
446 447 448 449 450 451 452 453 454 455 456 457 458
  nil)

;;; Must add tests for non-integers when the parameters
;;; are specified, but it's not clear what the meaning is.
;;; Does mincol apply to the ~A equivalent?  What about padchar?
;;; Are comma-char and comma-interval always ignored?

;;; # arguments

(deftest format.d.22
  (apply
   #'values
   (loop for i from 0 to 10
sds's avatar
sds committed
459 460 461
         for args = (make-list i)
         for s = (apply #'format nil "~#d" 12345 args)
         collect s))
462 463 464 465 466 467 468 469 470 471 472 473
  "12345"
  "12345"
  "12345"
  "12345"
  "12345"
  " 12345"
  "  12345"
  "   12345"
  "    12345"
  "     12345"
  "      12345")

474 475 476 477 478
(deftest formatter.d.22
  (apply
   #'values
   (let ((fn (formatter "~#D")))
     (loop for i from 0 to 10
sds's avatar
sds committed
479 480 481 482 483 484
           for args = (make-list i)
           ; for s = (apply #'format nil "~#d" 12345 args)
           for s = (with-output-to-string
                     (stream)
                     (assert (equal (apply fn stream 12345 args) args)))
           collect s)))
485 486 487 488 489 490 491 492 493 494 495 496
  "12345"
  "12345"
  "12345"
  "12345"
  "12345"
  " 12345"
  "  12345"
  "   12345"
  "    12345"
  "     12345"
  "      12345")

497 498 499
(deftest format.d.23
  (apply
   #'values
500 501
   (let ((fn (formatter "~,,,#:D")))
     (loop for i from 0 to 10
sds's avatar
sds committed
502 503 504 505 506 507 508
           for args = (make-list i)
           for s = (apply #'format nil "~,,,#:d" 1234567890 args)
           for s2 = (with-output-to-string
                      (stream)
                      (assert (equal (apply fn stream 1234567890 args) args)))
           do (assert (string= s s2))
           collect s)))
509 510 511 512 513 514 515 516 517 518 519 520 521 522 523
  "1,2,3,4,5,6,7,8,9,0"
  "12,34,56,78,90"
  "1,234,567,890"
  "12,3456,7890"
  "12345,67890"
  "1234,567890"
  "123,4567890"
  "12,34567890"
  "1,234567890"
  "1234567890"
  "1234567890")

(deftest format.d.24
  (apply
   #'values
524 525
   (let ((fn (formatter "~,,,#:@d")))
     (loop for i from 0 to 10
sds's avatar
sds committed
526 527 528 529 530 531 532
           for args = (make-list i)
           for s = (apply #'format nil "~,,,#@:D" 1234567890 args)
           for s2 = (with-output-to-string
                      (stream)
                      (assert (equal (apply fn stream 1234567890 args) args)))
           do (assert (string= s s2))
           collect s)))
533 534 535 536 537 538 539 540 541 542 543 544
  "+1,2,3,4,5,6,7,8,9,0"
  "+12,34,56,78,90"
  "+1,234,567,890"
  "+12,3456,7890"
  "+12345,67890"
  "+1234,567890"
  "+123,4567890"
  "+12,34567890"
  "+1,234567890"
  "+1234567890"
  "+1234567890")

545 546
(def-format-test format.d.25
  "~+10d" (1234) "      1234")
547

548 549
(def-format-test format.d.26
  "~+10@d" (1234) "     +1234")
550

551 552
(def-format-test format.d.27
  "~-1d" (1234) "1234")
553

554 555
(def-format-test format.d.28
  "~-1000000000000000000d" (1234) "1234")
556

557 558
(def-format-test format.d.29
  "~vd" ((1- most-negative-fixnum) 1234) "1234")
559 560 561 562

;;; Randomized test

(deftest format.d.30
563 564 565 566
  (let ((fn (formatter "~v,v,v,vD")))
    (loop
     for mincol = (and (coin) (random 50))
     for padchar = (and (coin)
sds's avatar
sds committed
567
                        (random-from-seq +standard-chars+))
568
     for commachar = (and (coin)
sds's avatar
sds committed
569
                          (random-from-seq +standard-chars+))
570 571 572 573
     for commaint = (and (coin) (1+ (random 10)))
     for k = (ash 1 (+ 2 (random 30)))
     for x = (- (random (+ k k)) k)
     for fmt = (concatenate
sds's avatar
sds committed
574 575 576 577 578
                'string
                (if mincol (format nil "~~~d," mincol) "~,")
                (if padchar (format nil "'~c," padchar) ",")
                (if commachar (format nil "'~c," commachar) ",")
                (if commaint (format nil "~dd" commaint) "d"))
579 580 581 582 583 584
     for s1 = (format nil fmt x)
     for s2 = (format nil "~v,v,v,vd" mincol padchar commachar commaint x)
     for s3 = (formatter-call-to-string fn mincol padchar commachar commaint x)
     repeat 2000
     unless (and (string= s1 s2) (string= s2 s3))
     collect (list mincol padchar commachar commaint fmt x s1 s2 s3)))
585
  nil)