format-o.lsp 19 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Aug  1 06:36:30 2004
;;;; Contains: Tests of format directive ~O

(in-package :cl-test)

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

(deftest format.o.1
pfdietz's avatar
pfdietz committed
11 12 13
  (let ((fn (formatter "~o")))
    (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
           for i = (- (random (+ x x)) x)
           for s1 = (format nil "~O" i)
           for j = (let ((*read-base* 8)) (read-from-string s1))
           for s2 = (formatter-call-to-string fn i)
           repeat 1000
           when (or (/= i j)
                    (not (string= s1 s2))
                    (find #\. s1)
                    (find #\+ s1)
                  (find-if #'alpha-char-p s1))
           collect (list i s1 j s2))))
25 26 27
  nil)

(deftest format.o.2
pfdietz's avatar
pfdietz committed
28 29 30
  (let ((fn (formatter "~@O")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
31 32 33 34 35 36 37 38 39 40 41
           for i = (- (random (+ x x)) x)
           for s1 = (format nil "~@o" i)
           for j = (let ((*read-base* 8)) (read-from-string s1))
           for s2 = (formatter-call-to-string fn i)
           repeat 1000
           when (or (/= i j)
                    (not (string= s1 s2))
                    (find #\. s1)
                    ;; (find #\+ s1)
                    (find-if #'alpha-char-p s1))
           collect (list i s1 j s2))))
pfdietz's avatar
pfdietz committed
42 43 44
  nil)

(deftest format.o.3
45 46
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
47 48 49 50 51 52 53 54 55 56 57 58 59
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~o" i)
         for fmt = (format nil "~~~do" mincol)
         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)))
60 61
  nil)

pfdietz's avatar
pfdietz committed
62
(deftest formatter.o.3
63 64
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
65 66 67 68 69 70 71 72 73 74 75 76 77 78
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~o" i)
         for fmt = (format nil "~~~do" mincol)
         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)))
79 80 81 82 83
  nil)

(deftest format.o.4
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
84 85 86 87 88 89 90 91 92 93 94 95 96 97
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~@O" i)
         for fmt = (format nil "~~~d@o" mincol)
         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)))
98 99
  nil)

pfdietz's avatar
pfdietz committed
100
(deftest formatter.o.4
101 102
  (with-standard-io-syntax
   (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
         for mincol = (random 30)
         for i = (- (random (+ x x)) x)
         for s1 = (format nil "~@O" i)
         for fmt = (format nil "~~~d@o" mincol)
         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)))
118 119
  nil)

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

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

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

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

204 205 206
;;; Comma tests

(deftest format.o.8
pfdietz's avatar
pfdietz committed
207 208
  (let ((fn (formatter "~:O")))
    (loop for i from #o-777 to #o777
sds's avatar
sds committed
209 210 211 212 213
          for s1 = (format nil "~o" i)
          for s2 = (format nil "~:o" i)
          for s3 = (formatter-call-to-string fn i)
          unless (and (string= s1 s2) (string= s2 s3))
          collect (list i s1 s2 s3)))
214 215 216
  nil)

(deftest format.o.9
pfdietz's avatar
pfdietz committed
217 218 219
  (let ((fn (formatter "~:o")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236
           for i = (- (random (+ x x)) x)
           for commachar = #\,
           for s1 = (format nil "~o" i)
           for s2 = (format nil "~:O" 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) "01234567")))))
           collect (list x i commachar s1 s2 s3))))
237 238 239
  nil)

(deftest format.o.10
pfdietz's avatar
pfdietz committed
240 241 242
  (let ((fn (formatter "~,,v:o")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for s1 = (format nil "~o" i)
           for s2 = (format nil "~,,v:o" 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))))
pfdietz's avatar
pfdietz committed
261 262 263
  nil)

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

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

(deftest format.o.12
pfdietz's avatar
pfdietz committed
309 310 311
  (let ((fn (formatter "~,,V,v:O")))
    (with-standard-io-syntax
     (loop for x = (ash 1 (+ 2 (random 80)))
sds's avatar
sds committed
312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330
           for i = (- (random (+ x x)) x)
           for commachar = (random-from-seq +standard-chars+)
           for commaint = (1+ (random 20))
           for s1 = (format nil "~o" i)
           for s2 = (format nil "~,,v,v:O" 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))))
331 332 333
  nil)

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

;;; NIL arguments

360 361
(def-format-test format.o.14
  "~vO" (nil #o100) "100")
362

363 364
(def-format-test format.o.15
  "~6,vO" (nil #o100) "   100")
365

366 367
(def-format-test format.o.16
  "~,,v:o" (nil #o12345) "12,345")
368

369 370
(def-format-test format.o.17
  "~,,'*,v:o" (nil #o12345) "12*345")
371 372 373 374

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

(deftest format.o.18
pfdietz's avatar
pfdietz committed
375 376
  (let ((fn (formatter "~o")))
    (loop for x in *mini-universe*
sds's avatar
sds committed
377 378 379 380 381
          for s1 = (format nil "~o" x)
          for s2 = (let ((*print-base* 8)) (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)))
382 383 384
  nil)

(deftest format.o.19
pfdietz's avatar
pfdietz committed
385 386
  (let ((fn (formatter "~:o")))
    (loop for x in *mini-universe*
sds's avatar
sds committed
387 388 389 390 391
          for s1 = (format nil "~:o" x)
          for s2 = (let ((*print-base* 8)) (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)))
392 393 394
  nil)

(deftest format.o.20
pfdietz's avatar
pfdietz committed
395 396
  (let ((fn (formatter "~@o")))
    (loop for x in *mini-universe*
sds's avatar
sds committed
397 398 399 400 401
          for s1 = (format nil "~@o" x)
          for s2 = (let ((*print-base* 8)) (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)))
402 403 404
  nil)

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

(deftest format.o.23
  (apply
   #'values
pfdietz's avatar
pfdietz committed
451
   (let ((fn (formatter "~,,,#:o"))
sds's avatar
sds committed
452
         (n #o1234567012))
pfdietz's avatar
pfdietz committed
453
     (loop for i from 0 to 10
sds's avatar
sds committed
454 455 456 457 458 459 460
           for args = (make-list i)
           for s = (apply #'format nil "~,,,#:o" n args)
           for s2 = (with-output-to-string
                      (stream)
                      (assert (equal (apply fn stream n args) args)))
           do (assert (string= s s2))
           collect s)))
461 462 463 464 465 466 467 468 469 470 471 472 473 474 475
  "1,2,3,4,5,6,7,0,1,2"
  "12,34,56,70,12"
  "1,234,567,012"
  "12,3456,7012"
  "12345,67012"
  "1234,567012"
  "123,4567012"
  "12,34567012"
  "1,234567012"
  "1234567012"
  "1234567012")

(deftest format.o.24
  (apply
   #'values
pfdietz's avatar
pfdietz committed
476
   (let ((fn (formatter "~,,,#:@o"))
sds's avatar
sds committed
477
         (n #o1234567012))
pfdietz's avatar
pfdietz committed
478
     (loop for i from 0 to 10
sds's avatar
sds committed
479 480 481 482 483 484 485
           for args = (make-list i)
           for s = (apply #'format nil "~,,,#@:O" n args)
           for s2 = (with-output-to-string
                      (stream)
                      (assert (equal (apply fn stream n args) args)))
           do (assert (string= s s2))
           collect s)))
486 487 488 489 490 491 492 493 494 495 496 497
  "+1,2,3,4,5,6,7,0,1,2"
  "+12,34,56,70,12"
  "+1,234,567,012"
  "+12,3456,7012"
  "+12345,67012"
  "+1234,567012"
  "+123,4567012"
  "+12,34567012"
  "+1,234567012"
  "+1234567012"
  "+1234567012")

498 499
(def-format-test format.o.25
  "~+10o" (#o1234) "      1234")
500

501 502
(def-format-test format.o.26
  "~+10@O" (#o1234) "     +1234")
503

504 505
(def-format-test format.o.27
  "~-1O" (#o1234) "1234")
506

507 508
(def-format-test format.o.28
  "~-1000000000000000000o" (#o1234) "1234")
509

510 511
(def-format-test format.o.29
  "~vo" ((1- most-negative-fixnum) #o1234) "1234")
512 513 514 515

;;; Randomized test

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