plus.lsp 12.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Aug 31 04:34:17 2003
;;;; Contains: Tests of the function +

(in-package :cl-test)

(compile-and-load "numbers-aux.lsp")
;;; (compile-and-load "plus-aux.lsp")

(deftest plus.1
  (+)
  0)

(deftest plus.2
  (loop for x in *numbers*
sds's avatar
sds committed
17 18
        unless (eql x (+ x))
        collect x)
19 20 21 22
  nil)

(deftest plus.3
  (loop for x in *numbers*
sds's avatar
sds committed
23 24 25 26
        for x1 = (+ x 0)
        for x2 = (+ 0 x)
        unless (and (eql x x1) (eql x x2) (eql x1 x2))
        collect (list x x1 x2))
27 28 29 30
  nil)

(deftest plus.4
  (loop for x in *numbers*
sds's avatar
sds committed
31 32 33
        for x1 = (- x x)
        unless (= x1 0)
        collect (list x x1))
34 35 36 37
  nil)

(deftest plus.5
  (let* ((upper-bound most-positive-fixnum)
sds's avatar
sds committed
38 39
         (lower-bound most-negative-fixnum)
         (spread (- upper-bound lower-bound)))
40
    (flet ((%r () (+ (random spread) lower-bound)))
41
      (loop for x = (%r)
sds's avatar
sds committed
42 43 44 45 46 47 48 49 50 51 52 53
            for y = (%r)
            for z = (%r)
            for s1 = (+ x y z)
            for s2 = (+ z y x)
            for s3 = (+ y x z)
            for s4 = (+ x z y)
            for s5 = (+ z x y)
            for s6 = (+ y z x)
            repeat 1000
            unless (and (eql s1 s2) (eql s1 s3) (eql s1 s4)
                        (eql s1 s5) (eql s1 s6))
            collect (list x y z s1 s2 s3 s4 s5 s6))))
54 55 56 57
  nil)

(deftest plus.6
  (let* ((upper-bound 1000000000000000)
sds's avatar
sds committed
58 59
         (lower-bound -1000000000000000)
         (spread (- upper-bound lower-bound)))
60
    (flet ((%r () (+ (random spread) lower-bound)))
61
      (loop for x = (%r)
sds's avatar
sds committed
62 63 64 65 66 67 68 69 70 71 72 73
            for y = (%r)
            for z = (%r)
            for s1 = (+ x y z)
            for s2 = (+ z y x)
            for s3 = (+ y x z)
            for s4 = (+ x z y)
            for s5 = (+ z x y)
            for s6 = (+ y z x)
            repeat 1000
            unless (and (eql s1 s2) (eql s1 s3) (eql s1 s4)
                        (eql s1 s5) (eql s1 s6))
            collect (list x y z s1 s2 s3 s4 s5 s6))))
74 75 76 77
  nil)

(deftest plus.7
  (let* ((upper-bound most-positive-fixnum)
sds's avatar
sds committed
78 79
         (lower-bound most-negative-fixnum)
         (spread (- upper-bound lower-bound)))
80
    (flet ((%r () (+ (random spread) lower-bound)))
81
      (loop for x = (/ (%r) (max 1 (%r)))
sds's avatar
sds committed
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
            for y = (/ (%r) (max 1 (%r)))
            for z = (/ (%r) (max 1 (%r)))
            for s1 = (+ x y z)
            for s2 = (+ z y x)
            for s3 = (+ y x z)
            for s4 = (+ x z y)
            for s5 = (+ z x y)
            for s6 = (+ y z x)
            repeat 1000
            unless (and (eql s1 s2) (eql s1 s3) (eql s1 s4)
                        (eql s1 s5) (eql s1 s6))
            collect (list x y z s1 s2 s3 s4 s5 s6)
            unless (= (+ x y)
                      (let ((xn (numerator x))
                            (xd (denominator x))
                            (yn (numerator y))
                            (yd (denominator y)))
                        (/ (+ (* xn yd) (* xd yn))
                           (* xd yd))))
            collect (list x y))))
102 103 104 105
  nil)

(deftest plus.8
  (let (args)
106
    (loop for i from 0 to (min 256 (1- call-arguments-limit))
sds's avatar
sds committed
107 108 109
          unless (eql (apply #'+ args) (/ (* i (1+ i)) 2))
          collect i
          do (push (1+ i) args)))
110 111 112 113
  nil)

(deftest plus.9
  (let* ((upper-bound most-positive-fixnum)
sds's avatar
sds committed
114 115
         (lower-bound most-negative-fixnum)
         (spread (- upper-bound lower-bound)))
116
    (flet ((%r () (+ (random spread) lower-bound)))
117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
      (loop
       for xr = (%r)
       for xi = (%r)
       for yr = (%r)
       for yi = (%r)
       for x = (complex xr xi)
       for y = (complex yr yi)
       for s = (+ x y)
       repeat 1000
       unless (eql s (complex (+ xr yr) (+ xi yi)))
       collect (list x y s))))
  nil)

(deftest plus.10
  (loop
   for x in '(0.0s0 0.0f0 0.0d0 0.0l0)
   for radix = (float-radix x)
   for (k eps-r eps-f) = (multiple-value-list (find-epsilon x))
   nconc
   (loop for i from 1 to k
sds's avatar
sds committed
137 138 139 140 141 142 143 144
         for e1 = (expt radix (- i))
         for y = (+ x e1)
         nconc
         (loop for j from 1 to (- k i)
               for e2 = (expt radix (- j))
               for z = (+ x e2)
               unless (eql (+ y z) (+ x e1 e2))
               collect (list x i j))))
145 146 147 148 149
  nil)

(deftest plus.11
  (flet ((%r () (- (random most-positive-short-float) (/ most-positive-short-float 2))))
    (loop for x = (%r)
sds's avatar
sds committed
150 151 152 153 154 155
          for y = (%r)
          for s = (+ x y)
          repeat 1000
          unless (and (eql s (+ y x))
                      (typep s 'short-float))
          collect (list x y s)))
156 157 158 159 160
  nil)

(deftest plus.12
  (flet ((%r () (- (random most-positive-single-float) (/ most-positive-single-float 2))))
    (loop for x = (%r)
sds's avatar
sds committed
161 162 163 164 165 166
          for y = (%r)
          for s = (+ x y)
          repeat 1000
          unless (and (eql s (+ y x))
                      (typep s 'single-float))
          collect (list x y s)))
167 168 169 170 171
  nil)

(deftest plus.13
  (flet ((%r () (- (random most-positive-double-float) (/ most-positive-double-float 2))))
    (loop for x = (%r)
sds's avatar
sds committed
172 173 174 175 176 177
          for y = (%r)
          for s = (+ x y)
          repeat 1000
          unless (and (eql s (+ y x))
                      (typep s 'double-float))
          collect (list x y s)))
178 179 180 181 182
  nil)

(deftest plus.14
  (flet ((%r () (- (random most-positive-long-float) (/ most-positive-long-float 2))))
    (loop for x = (%r)
sds's avatar
sds committed
183 184 185 186 187 188
          for y = (%r)
          for s = (+ x y)
          repeat 1000
          unless (and (eql s (+ y x))
                      (typep s 'long-float))
          collect (list x y s)))
189 190 191 192
  nil)

(deftest plus.15
  (let ((bound most-positive-short-float)
sds's avatar
sds committed
193
        (bound2 most-positive-single-float))
194
    (loop for x = (- (random bound) (/ bound 2))
sds's avatar
sds committed
195 196 197 198 199 200
          for y = (- (random bound2)(/ bound2 2))
          for p = (+ x y)
          repeat 1000
          unless (and (eql p (+ y x))
                      (typep p 'single-float))
          collect (list x y p)))
201 202 203 204
  nil)

(deftest plus.16
  (let ((bound most-positive-short-float)
sds's avatar
sds committed
205
        (bound2 most-positive-double-float))
206
    (loop for x = (- (random bound) (/ bound 2))
sds's avatar
sds committed
207 208 209 210 211 212
          for y = (- (random bound2)(/ bound2 2))
          for p = (+ x y)
          repeat 1000
          unless (and (eql p (+ y x))
                      (typep p 'double-float))
          collect (list x y p)))
213 214 215 216
  nil)

(deftest plus.17
  (let ((bound most-positive-short-float)
sds's avatar
sds committed
217
        (bound2 most-positive-long-float))
218
    (loop for x = (- (random bound) (/ bound 2))
sds's avatar
sds committed
219 220 221 222 223 224
          for y = (- (random bound2)(/ bound2 2))
          for p = (+ x y)
          repeat 1000
          unless (and (eql p (+ y x))
                      (typep p 'long-float))
          collect (list x y p)))
225 226 227 228
  nil)

(deftest plus.18
  (let ((bound most-positive-single-float)
sds's avatar
sds committed
229
        (bound2 most-positive-double-float))
230
    (loop for x = (- (random bound) (/ bound 2))
sds's avatar
sds committed
231 232 233 234 235 236
          for y = (- (random bound2)(/ bound2 2))
          for p = (+ x y)
          repeat 1000
          unless (and (eql p (+ y x))
                      (typep p 'double-float))
          collect (list x y p)))
237 238 239 240
  nil)

(deftest plus.19
  (let ((bound most-positive-single-float)
sds's avatar
sds committed
241
        (bound2 most-positive-long-float))
242
    (loop for x = (- (random bound) (/ bound 2))
sds's avatar
sds committed
243 244 245 246 247 248
          for y = (- (random bound2)(/ bound2 2))
          for p = (+ x y)
          repeat 1000
          unless (and (eql p (+ y x))
                      (typep p 'long-float))
          collect (list x y p)))
249 250 251 252
  nil)

(deftest plus.20
  (let ((bound most-positive-double-float)
sds's avatar
sds committed
253
        (bound2 most-positive-long-float))
254
    (loop for x = (- (random bound) (/ bound 2))
sds's avatar
sds committed
255 256 257 258 259 260
          for y = (- (random bound2)(/ bound2 2))
          for p = (+ x y)
          repeat 1000
          unless (and (eql p (+ y x))
                      (typep p 'long-float))
          collect (list x y p)))
261 262 263 264 265 266 267 268 269
  nil)

(deftest plus.21
  (loop
   for type in '(short-float single-float double-float long-float)
   for bits in '(13 24 50 50)
   for bound = (ash 1 (1- bits))
   nconc
   (loop for i = (random bound)
sds's avatar
sds committed
270 271 272 273 274 275 276 277
         for x = (coerce i type)
         for j = (random bound)
         for y = (coerce j type)
         for sum = (+ x y)
         repeat 1000
         unless (and (eql sum (coerce (+ i j) type))
                     (eql sum (+ y x)))
         collect (list i j x y sum (coerce (+ i j) type))))
278 279 280 281 282 283 284 285 286 287 288 289 290 291 292
  nil)

(deftest plus.22
  (loop
   for type in '(short-float single-float double-float long-float)
   for bits in '(13 24 50 50)
   for bound = (ash 1 (1- bits))
   nconc
   (loop
    for one = (coerce 1 type)
    for i = (random bound)
    for x = (complex (coerce i type) one)
    for j = (random bound)
    for y = (complex (coerce j type) one)
    for sum = (+ x y)
293
    repeat 1000
294
    unless (and (eql sum (complex (coerce (+ i j) type)
sds's avatar
sds committed
295 296
                                  (coerce 2 type)))
                (eql sum (+ y x)))
297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312
    collect (list i j x y sum)))
  nil)

(deftest plus.23
  (loop
   for type in '(short-float single-float double-float long-float)
   for bits in '(13 24 50 50)
   for bound = (ash 1 (1- bits))
   nconc
   (loop
    for one = (coerce 1 type)
    for i = (random bound)
    for x = (complex one (coerce i type))
    for j = (random bound)
    for y = (complex one (coerce j type))
    for sum = (+ x y)
313
    repeat 1000
314
    unless (and (eql sum (complex (coerce 2 type)
sds's avatar
sds committed
315 316
                                  (coerce (+ i j) type)))
                (eql sum (+ y x)))
317 318 319
    collect (list i j x y sum)))
  nil)

320 321 322 323 324
;;; Negative zero tests (suggested by R. Toy)

(deftest plus.24
  (funcall
   (compile nil '(lambda (x) (declare (type short-float x) (optimize (speed 3) (safety 0) (debug 0)))
sds's avatar
sds committed
325
                   (+ 0.0s0 x)))
326 327 328 329 330 331
   -0.0s0)
  0.0s0)

(deftest plus.25
  (funcall
   (compile nil '(lambda (x) (declare (type single-float x) (optimize (speed 3) (safety 0) (debug 0)))
sds's avatar
sds committed
332
                   (+ 0.0f0 x)))
333 334 335 336 337 338
   -0.0f0)
  0.0f0)

(deftest plus.26
  (funcall
   (compile nil '(lambda (x) (declare (type double-float x) (optimize (speed 3) (safety 0) (debug 0)))
sds's avatar
sds committed
339
                   (+ 0.0d0 x)))
340 341 342 343 344 345
   -0.0d0)
  0.0d0)

(deftest plus.27
  (funcall
   (compile nil '(lambda (x) (declare (type long-float x) (optimize (speed 3) (safety 0) (debug 0)))
sds's avatar
sds committed
346
                   (+ 0.0l0 x)))
347 348 349
   -0.0l0)
  0.0l0)

350 351 352 353 354
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest plus.28
  (macrolet ((%m (z) z))
sds's avatar
sds committed
355 356 357 358 359
            (values
             (+ (expand-in-current-env (%m 1)))
             (+ (expand-in-current-env (%m 2)) 3)
             (+ 4 (expand-in-current-env (%m 5)))
             (+ 1/2 (expand-in-current-env (%m 6)) 2/3)))
360 361
  1 5 9 43/6)

362 363
;;; Must test combinations of reals and complex arguments.

364
;;; Order of evaluation tests
365 366 367 368 369

(deftest plus.order.1
  (let ((i 0) x y)
    (values
     (+ (progn (setf x (incf i)) '8)
sds's avatar
sds committed
370
        (progn (setf y (incf i)) '11))
371 372 373 374 375 376 377
     i x y))
  19 2 1 2)

(deftest plus.order.2
  (let ((i 0) x y z)
    (values
     (+ (progn (setf x (incf i)) '8)
sds's avatar
sds committed
378 379
        (progn (setf y (incf i)) '11)
        (progn (setf z (incf i)) '100))
380 381 382 383 384 385 386 387 388
     i x y z))
  119 3 1 2 3)

;;; Test that compilation does not reassociate float additions

(deftest plus.reassociation.1
  (loop
   for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
   for eps in (list short-float-epsilon single-float-epsilon
sds's avatar
sds committed
389
                    double-float-epsilon long-float-epsilon)
390
   for eps2 = (* eps 9/10)
391
   when (eql
sds's avatar
sds committed
392 393
         (funcall (compile nil `(lambda () (+ ,x (+ ,eps2 ,eps2)))))
         x)
394 395 396 397 398 399 400
   collect (list x eps eps2))
  nil)

(deftest plus.reassociation.2
  (loop
   for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
   for eps in (list short-float-epsilon single-float-epsilon
sds's avatar
sds committed
401
                    double-float-epsilon long-float-epsilon)
402
   for eps2 = (* eps 9/10)
403
   unless (equal
sds's avatar
sds committed
404 405 406
           (funcall (compile nil `(lambda () (list (+ (+ ,x ,eps2) ,eps2)
                                                   (+ ,eps2 (+ ,eps2 ,x))))))
           (list x x))
407 408 409 410 411 412 413
   collect (list x eps eps2))
  nil)

(deftest plus.reassociation.3
  (loop
   for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
   for eps in (list short-float-epsilon single-float-epsilon
sds's avatar
sds committed
414
                    double-float-epsilon long-float-epsilon)
415
   for eps2 = (* eps 9/10)
416
   when (eql
sds's avatar
sds committed
417 418
         (funcall (compile nil `(lambda (y e) (+ y (+ e e)))) x eps2)
         x)
419 420 421 422 423 424 425
   collect (list x eps eps2))
  nil)

(deftest plus.reassociation.4
  (loop
   for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
   for eps in (list short-float-epsilon single-float-epsilon
sds's avatar
sds committed
426
                    double-float-epsilon long-float-epsilon)
427
   for eps2 = (* eps 9/10)
428
   unless (equal
sds's avatar
sds committed
429 430 431 432
           (funcall (compile nil `(lambda (y e) (list (+ (+ y e) e)
                                                      (+ e (+ e y)))))
                    x eps2)
           (list x x))
433 434
   collect (list x eps eps2))
  nil)