format-x.lsp 19.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Aug  1 06:51:34 2004
;;;; Contains: Tests of ~X format directive

(in-package :cl-test)

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

(deftest format.x.1
11 12 13
  (let ((fn (formatter "~x")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
14 15 16 17 18 19 20 21 22 23 24 25 26
           for i = (- (random (+ x x)) x)
           for s1 = (format nil "~X" i)
           for s2 = (formatter-call-to-string fn i)
           for j = (let ((*read-base* 16)) (read-from-string s1))
           repeat 1000
           when (or (/= i j)
                    (not (string= s1 s2))
                    (find #\. s1)
                    (find #\+ s1)
                    (loop for c across s1
                          thereis (and (not (eql c #\-))
                                       (not (digit-char-p c 16)))))
           collect (list i s1 j s2))))
27 28 29
  nil)

(deftest format.x.2
30 31 32
  (let ((fn (formatter "~@X")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
33 34 35 36 37 38 39 40 41 42 43 44 45 46
           for i = (- (random (+ x x)) x)
           for s1 = (format nil "~@x" i)
           for s2 = (formatter-call-to-string fn i)
           for j = (let ((*read-base* 16)) (read-from-string s1))
           repeat 1000
           when (or (/= i j)
                    (not (string= s1 s2))
                    (find #\. s1)
                    ;; (find #\+ s1)
                    (loop for c across s1
                          thereis (and
                                   (not (find c "-+"))
                                   (not (digit-char-p c 16)))))
           collect (list i s1 j s2))))
47 48 49
  nil)

(deftest format.x.3
50 51
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
52 53 54 55 56 57 58 59 60 61 62 63 64
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~x" i)
         for fmt = (format nil "~~~d~c" mincol (random-from-seq "xX"))
         for s2 = (format nil fmt 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)))
65 66
  nil)

67
(deftest formatter.x.3
68 69
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
70 71 72 73 74 75 76 77 78 79 80 81 82 83
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~x" i)
         for fmt = (format nil "~~~d~c" mincol (random-from-seq "xX"))
         for fn = (eval `(formatter ,fmt))
         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)))
84 85 86 87 88
  nil)

(deftest format.x.4
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
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 "~@X" i)
         for fmt = (format nil "~~~d@~c" mincol (random-from-seq "xX"))
         for s2 = (format nil fmt 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 (list i mincol s1 s2 pos)))
103 104
  nil)

105
(deftest formatter.x.4
106 107
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~@X" i)
         for fmt = (format nil "~~~d@~c" mincol (random-from-seq "xX"))
         for fn = (eval `(formatter ,fmt))
         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 (list i mincol s1 s2 pos)))
123 124
  nil)

125
(deftest format.x.5
126 127
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
128 129 130 131 132 133 134 135 136 137 138 139 140 141
         for mincol = (random 30)
         for padchar = (random-from-seq +standard-chars+)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~x" i)
         for fmt = (format nil "~~~d,'~c~c" mincol padchar (random-from-seq "xX"))
         for s2 = (format nil fmt 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)))
142 143
  nil)

144
(deftest formatter.x.5
145 146
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
         for mincol = (random 30)
         for padchar = (random-from-seq +standard-chars+)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~x" i)
         for fmt = (format nil "~~~d,'~c~c" mincol padchar (random-from-seq "xX"))
         for fn = (eval `(formatter ,fmt))
         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)))
162 163
  nil)

164 165 166 167
(deftest format.x.6
  (let ((fn (formatter "~V,vx")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
168 169 170 171 172 173 174 175 176 177 178 179 180 181 182
           for mincol = (random 30)
           for padchar = (random-from-seq +standard-chars+)
           for i = (- (random (+ x x)) x)
           for s1 = (format nil "~x" i)
           for s2 = (format nil "~v,vX" 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))))
183 184 185 186 187 188
  nil)

(deftest format.x.7
  (let ((fn (formatter "~v,V@X")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204
           for mincol = (random 30)
           for padchar = (random-from-seq +standard-chars+)
           for i = (- (random (+ x x)) x)
           for s1 = (format nil "~@x" i)
           for s2 = (format nil "~v,v@x" 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 (list i mincol s1 s2 s3 pos))))
205 206
  nil)

207 208 209
;;; Comma tests

(deftest format.x.8
210 211
  (let ((fn (formatter "~:X")))
    (loop for i from -999 to 999
sds's avatar
sds committed
212 213 214 215 216
          for s1 = (format nil "~x" i)
          for s2 = (format nil "~:x" i)
          for s3 = (formatter-call-to-string fn i)
          unless (and (string= s1 s2) (string= s2 s3))
          collect (list i s1 s2 s3)))
217 218 219
  nil)

(deftest format.x.9
220 221 222
  (let ((fn (formatter "~:x")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
           for i = (- (random (+ x x)) x)
           for commachar = #\,
           for s1 = (format nil "~x" i)
           for s2 = (format nil "~:X" i)
           for s3 = (formatter-call-to-string fn i)
           repeat 1000
           unless (and (string= s1 (remove commachar s2))
                       (string= s2 s3)
                       (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) "0123456789ABCDEF" :test #'char-equal)))))
           collect (list x i commachar s1 s2 s3))))
240 241 242
  nil)

(deftest format.x.10
243 244 245
  (let ((fn (formatter "~,,V:x")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for s1 = (format nil "~x" i)
           for s2 = (format nil "~,,v:X" commachar i)
           for s3 = (formatter-call-to-string fn commachar i)
           repeat 1000
           unless (and
                   (eql (elt s1 0) (elt s2 0))
                   (string= s2 s3)
                   (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))))
264 265 266
  nil)

(deftest format.x.11
267 268
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285
         for i = (- (random (+ x x)) x)
         for commachar = (random-from-seq +standard-chars+)
         for s1 = (format nil "~x" i)
         for fmt = (format nil "~~,,'~c:~c" commachar (random-from-seq "xX"))
         for s2 = (format nil fmt 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)))
286 287
  nil)

288
(deftest formatter.x.11
289 290
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308
         for i = (- (random (+ x x)) x)
         for commachar = (random-from-seq +standard-chars+)
         for s1 = (format nil "~x" i)
         for fmt = (format nil "~~,,'~c:~c" commachar (random-from-seq "xX"))
         for fn = (eval `(formatter ,fmt))
         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)))
309 310 311
  nil)

(deftest format.x.12
312 313 314
  (let ((fn (formatter "~,,v,v:X")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for commaint = (1+ (random 20))
           for s1 = (format nil "~x" i)
           for s2 = (format nil "~,,v,v:X" commachar commaint i)
           for s3 = (formatter-call-to-string fn commachar commaint i)
           repeat 1000
           unless (and
                   (eql (elt s1 0) (elt s2 0))
                   (string= s2 s3)
                   (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))))
334 335 336
  nil)

(deftest format.x.13
337 338 339
  (let ((fn (formatter "~,,v,V:@x")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for commaint = (1+ (random 20))
           for s1 = (format nil "~@x" i)
           for s2 = (format nil "~,,v,v:@x" 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))
                   (string= s2 s3)
                   (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))))
359 360 361 362
  nil)

;;; NIL arguments

363 364
(def-format-test format.x.14
  "~vx" (nil #x100) "100")
365

366 367
(def-format-test format.x.15
  "~6,vX" (nil #x100) "   100")
368

369 370
(def-format-test format.x.16
  "~,,v:x" (nil #x12345) "12,345")
371

372 373
(def-format-test format.x.17
  "~,,'*,v:x" (nil #x12345) "12*345")
374 375 376 377

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

(deftest format.x.18
378 379
  (let ((fn (formatter "~x")))
    (loop for x in *mini-universe*
sds's avatar
sds committed
380 381 382 383 384
          for s1 = (format nil "~x" x)
          for s2 = (let ((*print-base* 16)) (format nil "~A" x))
          for s3 = (formatter-call-to-string fn x)
          unless (or (integerp x) (and (string= s1 s2) (string= s2 s3)))
          collect (list x s1 s2 s3)))
385 386 387
  nil)

(deftest format.x.19
388 389
  (let ((fn (formatter "~:x")))
    (loop for x in *mini-universe*
sds's avatar
sds committed
390 391 392 393 394
          for s1 = (format nil "~:x" x)
          for s2 = (let ((*print-base* 16)) (format nil "~A" x))
          for s3 = (formatter-call-to-string fn x)
          unless (or (integerp x) (and (string= s1 s2) (string= s2 s3)))
          collect (list x s1 s2 s3)))
395 396 397
  nil)

(deftest format.x.20
398 399
  (let ((fn (formatter "~@x")))
    (loop for x in *mini-universe*
sds's avatar
sds committed
400 401 402 403 404
          for s1 = (format nil "~@x" x)
          for s2 = (let ((*print-base* 16)) (format nil "~A" x))
          for s3 = (formatter-call-to-string fn x)
          unless (or (integerp x) (and (string= s1 s2) (string= s2 s3)))
          collect (list x s1 s2 s3)))
405 406 407
  nil)

(deftest format.x.21
408 409
  (let ((fn (formatter "~:@x")))
    (loop for x in *mini-universe*
sds's avatar
sds committed
410 411 412 413 414 415 416 417
          for s1 = (let ((*print-base* 16)) (format nil "~A" x))
          for s2 = (format nil "~@:x" x)
          for s3 = (formatter-call-to-string fn x)
          for s4 = (let ((*print-base* 16)) (format nil "~A" x))
          unless (or (string/= s1 s4)
                     (integerp x)
                     (and (string= s1 s2) (string= s2 s3)))
          collect (list x s1 s2 s3)))
418 419 420 421 422 423 424 425 426 427 428 429
  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.x.22
  (apply
   #'values
430
   (let ((fn (formatter "~#X"))
sds's avatar
sds committed
431
         (n #x1b3fe))
432
     (loop for i from 0 to 10
sds's avatar
sds committed
433 434 435 436 437 438 439
           for args = (make-list i)
           for s = (apply #'format nil "~#x" n args)
           for s2 = (with-output-to-string
                      (stream)
                      (assert (equal (apply fn stream n args) args)))
           do (assert (string= s s2))
           collect (string-upcase s))))
440 441 442 443 444 445 446 447 448 449 450 451 452 453 454
  "1B3FE"
  "1B3FE"
  "1B3FE"
  "1B3FE"
  "1B3FE"
  " 1B3FE"
  "  1B3FE"
  "   1B3FE"
  "    1B3FE"
  "     1B3FE"
  "      1B3FE")

(deftest format.x.23
  (apply
   #'values
455
   (let ((fn (formatter "~,,,#:X"))
sds's avatar
sds committed
456
         (n #x1234567890))
457
     (loop for i from 0 to 10
sds's avatar
sds committed
458 459 460 461 462 463 464
           for args = (make-list i)
           for s = (apply #'format nil "~,,,#:x" n args)
           for s2 = (with-output-to-string
                      (stream)
                      (assert (equal (apply fn stream n args) args)))
           do (assert (string= s s2))
           collect s)))
465 466 467 468 469 470 471 472 473 474 475 476 477 478 479
  "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.x.24
  (apply
   #'values
480
   (let ((fn (formatter "~,,,#@:X"))
sds's avatar
sds committed
481
         (n #x1234567890))
482
     (loop for i from 0 to 10
sds's avatar
sds committed
483 484 485 486 487 488 489
           for args = (make-list i)
           for s = (apply #'format nil "~,,,#@:X" n args)
           for s2 = (with-output-to-string
                      (stream)
                      (assert (equal (apply fn stream n args) args)))
           do (assert (string= s s2))
           collect s)))
490 491 492 493 494 495 496 497 498 499 500 501
  "+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")

502 503
(def-format-test format.x.25
  "~+10x" (#x1234) "      1234")
504

505 506
(def-format-test format.x.26
  "~+10@X" (#x1234) "     +1234")
507

508 509
(def-format-test format.x.27
  "~-1X" (#x1234) "1234")
510

511 512
(def-format-test format.x.28
  "~-1000000000000000000x" (#x1234) "1234")
513

514 515
(def-format-test format.x.29
  "~vx" ((1- most-negative-fixnum) #x1234) "1234")
516 517 518 519

;;; Randomized test

(deftest format.x.30
520 521 522 523
  (let ((fn (formatter "~v,v,v,vx")))
    (loop
     for mincol = (and (coin) (random 50))
     for padchar = (and (coin)
sds's avatar
sds committed
524
                        (random-from-seq +standard-chars+))
525
     for commachar = (and (coin)
sds's avatar
sds committed
526
                          (random-from-seq +standard-chars+))
527 528 529 530
     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
531 532 533 534 535
                'string
                (if mincol (format nil "~~~d," mincol) "~,")
                (if padchar (format nil "'~c," padchar) ",")
                (if commachar (format nil "'~c," commachar) ",")
                (if commaint (format nil "~dx" commaint) "x"))
536 537 538 539 540 541
     for s1 = (format nil fmt x)
     for s2 = (format nil "~v,v,v,vx" 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)))
sds's avatar
sds committed
542
  nil)