source: trunk/source/tests/ansi-tests/number-comparison.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 42.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon Apr  7 07:17:42 2003
4;;;; Contains: Tests of =, /=, <, <=, >, >=
5
6(in-package :cl-test)
7
8(compile-and-load "numbers-aux.lsp")
9
10;;; Errors tests on comparison functions
11
12(deftest =.error.1
13  (signals-error (=) program-error)
14  t)
15
16(deftest /=.error.1
17  (signals-error (/=) program-error)
18  t)
19
20(deftest <.error.1
21  (signals-error (<) program-error)
22  t)
23
24(deftest <=.error.1
25  (signals-error (<=) program-error)
26  t)
27
28(deftest >.error.1
29  (signals-error (>) program-error)
30  t)
31
32(deftest >=.error.1
33  (signals-error (>=) program-error)
34  t)
35
36;;; Tests of =
37
38(deftest =.1
39  (loop for x in *numbers*
40        unless (= x)
41        collect x)
42  nil)
43
44(deftest =.2
45  (loop for x in *numbers*
46        unless (= x x)
47        collect x)
48  nil)
49
50(deftest =.3
51  (loop for x in *numbers*
52        unless (= x x x)
53        collect x)
54  nil)
55
56(deftest =.4
57  (=.4-fn)
58  nil)
59
60(deftest =.5
61  (loop for i from 1 to 10000
62        for i2 = (1+ i)
63        never (or (= i i2) (= i2 i)))
64  t)
65
66(deftest =.6
67  (loop for i from 5 to 10000 by 17
68        for j from 2 to i by 19
69        for r = (/ i j)
70        unless (and (not (= r (1+ r)))
71                    (not (= r 0))
72                    (not (= r (- r)))
73                    (= r r))
74        collect r)
75  nil)
76                         
77(deftest =.7
78  (let ((args nil))
79    (loop for i from 1 to (min 256 (1- call-arguments-limit))
80          do (push 17 args)
81          always (apply #'= args)))
82  t)
83
84(deftest =.8
85  (loop for i from 2 to (min 256 (1- call-arguments-limit))
86        for args = (append (make-list (1- i) :initial-element 7)
87                           (list 23))
88        when (apply #'= args)
89        collect args)
90  nil)
91
92
93(deftest =.9
94  (=t 0 0.0)
95  t)
96
97(deftest =.10
98  (=t 0 #c(0 0))
99  t)
100
101(deftest =.11
102  (=t 1 #c(1.0 0.0))
103  t)
104
105(deftest =.12
106  (=t -0.0 0.0)
107  t)
108
109(deftest =.13
110  (let ((nums '(0 0.0s0 0.0f0 0.0d0 0.0l0
111                  #c(0.0s0 0.0s0) #c(0.0f0 0.0f0)
112                  #c(0.0d0 0.0d0) #c(0.0l0 0.0l0))))
113    (loop for x in nums
114          append
115          (loop for y in nums
116                unless (= x y)
117                collect (list x y))))
118  nil)
119
120(deftest =.14
121  (let ((nums '(17 17.0s0 17.0f0 17.0d0 17.0l0
122                   #c(17.0s0 0.0s0) #c(17.0f0 0.0f0)
123                   #c(17.0d0 0.0d0) #c(17.0l0 0.0l0))))
124    (loop for x in nums
125          append
126          (loop for y in nums
127                unless (= x y)
128                collect (list x y))))
129  nil)
130
131(deftest =.15
132  (let ((nums '(-17 -17.0s0 -17.0f0 -17.0d0 -17.0l0
133                    #c(-17.0s0 0.0s0) #c(-17.0f0 0.0f0)
134                    #c(-17.0d0 0.0d0) #c(-17.0l0 0.0l0))))
135    (loop for x in nums
136          append
137          (loop for y in nums
138                unless (= x y)
139                collect (list x y))))
140  nil)
141
142(deftest =.16
143  (let ((n 60000) (m 30000))
144    (loop for x = (- (random n) m)
145          for y = (- (random n) m)
146          for z = (- (random n) m)
147          for w = (- (random n) m)
148          for a = (* x y)
149          for b = (* x w)
150          for c = (* y z)
151          for d = (* w z)
152          repeat 10000
153          when (and (/= b 0)
154                    (/= d 0)
155                    (or (not (= (/ a b) (/ c d)))
156                        (/= (/ a b) (/ c d))))
157          collect (list a b c d)))
158  nil)
159
160;;; Comparison of a rational with a float
161
162(deftest =.17
163  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
164        for eps in (list short-float-epsilon single-float-epsilon
165                         double-float-epsilon long-float-epsilon)
166        for exp = (nth-value 1 (decode-float eps))
167        for radix = (float-radix eps)
168        when (< (* (log radix 2) exp) 1000)
169        nconc
170        (let* ((rat (rational eps))
171               (xrat (rational x)))
172          (loop for i from 2 to 100
173                for rat/i = (/ rat i)
174                for xrat+rat/i = (+ xrat rat/i)
175                nconc
176                (if (= x xrat+rat/i)
177                    (list (list x i  xrat+rat/i))
178                  nil))))
179  nil)
180
181(deftest =.18
182  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
183        for eps in (list short-float-negative-epsilon single-float-negative-epsilon
184                         double-float-negative-epsilon long-float-negative-epsilon)
185        for exp = (nth-value 1 (decode-float eps))
186        for radix = (float-radix eps)
187        when (< (* (log radix 2) exp) 1000)
188        nconc
189        (let* ((rat (rational eps))
190               (xrat (rational x)))
191          (loop for i from 2 to 100
192                for rat/i = (/ rat i)
193                for xrat-rat/i = (- xrat rat/i)
194                nconc
195                (if (= x xrat-rat/i)
196                    (list (list x i xrat-rat/i))
197                  nil))))
198  nil)
199
200(deftest =.19
201  (let ((bound (expt 10 1000)))
202    (loop for x in (list most-positive-short-float most-positive-single-float
203                         most-positive-double-float most-positive-long-float)
204          for d = (and (<= x bound) (truncate x))
205          when (and d (or (= (* 3/2 d) x)
206                          (= x (* 5/4 d))))
207          collect (list x d (* 3/2 d) (* 5/4 d))))
208  nil)
209
210(deftest =.order.1
211  (let ((i 0) x y)
212    (values
213     (= (progn (setf x (incf i)) 1)
214        (progn (setf y (incf i)) 2))
215     i x y))
216  nil 2 1 2)
217
218(deftest =.order.2
219  (let ((i 0) x y z)
220    (values
221     (= (progn (setf x (incf i)) 1)
222        (progn (setf y (incf i)) 2)
223        (progn (setf z (incf i)) 3))
224     i x y z))
225  nil 3 1 2 3)
226
227(deftest =.order.3
228  (let ((i 0) u v w x y z)
229    (values
230     (=
231      (progn (setf u (incf i)) 1)
232      (progn (setf v (incf i)) 2)
233      (progn (setf w (incf i)) 3)
234      (progn (setf x (incf i)) 4)
235      (progn (setf y (incf i)) 5)
236      (progn (setf z (incf i)) 6))
237     i u v w x y z))
238  nil 6 1 2 3 4 5 6)
239
240;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
241
242(deftest /=.1
243  (loop for x in *numbers*
244        unless (/= x)
245        collect x)
246  nil)
247
248(deftest /=.2
249  (loop for x in *numbers*
250        when (/= x x)
251        collect x)
252  nil)
253
254(deftest /=.3
255  (loop for x in *numbers*
256        when (/= x x x)
257        collect x)
258  nil)
259
260(deftest /=.4
261  (/=.4-fn)
262  nil)
263
264(deftest /=.4a
265  (/=.4a-fn)
266  nil)
267
268(deftest /=.5
269  (loop for i from 1 to 10000
270        for i2 = (1+ i)
271        always (and (/= i i2) (/= i2 i)))
272  t)
273
274(deftest /=.6
275  (loop for i from 5 to 10000 by 17
276        for j from 2 to i by 19
277        for r = (/ i j)
278        when (or (not (/= r (1+ r)))
279                 (not (/= r 0))
280                 (not (/= r (- r)))
281                 (/= r r))
282        collect r)
283  nil)
284                         
285(deftest /=.7
286  (let ((args (list 17))
287        (args2 nil))
288    (loop for i from 2 to (min 256 (1- call-arguments-limit))
289          do (push 17 args)
290          do (push i args2)
291          always (and (not (apply #'/= args))
292                      (apply #'/= args2))))
293  t)
294
295(deftest /=.8
296  (loop for i from 2 to (min 256 (1- call-arguments-limit))
297        for args = (append (make-list (1- i) :initial-element 7)
298                           (list 7))
299        when (apply #'/= args)
300        collect args)
301  nil)
302
303
304(deftest /=.9
305  (/= 0 0.0)
306  nil)
307
308(deftest /=.10
309  (/= 0 #c(0 0))
310  nil)
311
312(deftest /=.11
313  (/= 1 #c(1.0 0.0))
314  nil)
315
316(deftest /=.12
317  (/= -0.0 0.0)
318  nil)
319
320(deftest /=.13
321  (let ((nums '(0 0.0s0 0.0f0 0.0d0 0.0l0
322                  #c(0.0s0 0.0s0) #c(0.0f0 0.0f0)
323                  #c(0.0d0 0.0d0) #c(0.0l0 0.0l0))))
324    (loop for x in nums
325          append
326          (loop for y in nums
327                when (/= x y)
328                collect (list x y))))
329  nil)
330
331(deftest /=.14
332  (let ((nums '(17 17.0s0 17.0f0 17.0d0 17.0l0
333                   #c(17.0s0 0.0s0) #c(17.0f0 0.0f0)
334                   #c(17.0d0 0.0d0) #c(17.0l0 0.0l0))))
335    (loop for x in nums
336          append
337          (loop for y in nums
338                when (/= x y)
339                collect (list x y))))
340  nil)
341
342(deftest /=.15
343  (let ((nums '(-17 -17.0s0 -17.0f0 -17.0d0 -17.0l0
344                    #c(-17.0s0 0.0s0) #c(-17.0f0 0.0f0)
345                    #c(-17.0d0 0.0d0) #c(-17.0l0 0.0l0))))
346    (loop for x in nums
347          append
348          (loop for y in nums
349                when (/= x y)
350                collect (list x y))))
351  nil)
352
353(deftest /=.17
354  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
355        for eps in (list short-float-epsilon single-float-epsilon
356                         double-float-epsilon long-float-epsilon)
357        for exp = (nth-value 1 (decode-float eps))
358        for radix = (float-radix eps)
359        when (< (* (log radix 2) exp) 1000)
360        nconc
361        (let* ((rat (rational eps))
362               (xrat (rational x)))
363          (loop for i from 2 to 100
364                for rat/i = (/ rat i)
365                for xrat+rat/i = (+ xrat rat/i)
366                nconc
367                (if (/= x xrat+rat/i)
368                    nil
369                    (list (list x i  xrat+rat/i))))))
370  nil)
371
372(deftest /=.18
373  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
374        for eps in (list short-float-negative-epsilon single-float-negative-epsilon
375                         double-float-negative-epsilon long-float-negative-epsilon)
376        for exp = (nth-value 1 (decode-float eps))
377        for radix = (float-radix eps)
378        when (< (* (log radix 2) exp) 1000)
379        nconc
380        (let* ((rat (rational eps))
381               (xrat (rational x)))
382          (loop for i from 2 to 100
383                for rat/i = (/ rat i)
384                for xrat-rat/i = (- xrat rat/i)
385                nconc
386                (if (/= x xrat-rat/i)
387                    nil
388                    (list (list x i xrat-rat/i))))))
389  nil)
390
391(deftest /=.19
392  (let ((bound (expt 10 1000)))
393    (loop for x in (list most-positive-short-float most-positive-single-float
394                         most-positive-double-float most-positive-long-float)
395          for d = (and (<= x bound) (truncate x))
396          unless (or (null d) (and (/= (* 3/2 d) x)
397                                   (/= x (* 5/4 d))))
398          collect (list x d (* 3/2 d) (* 5/4 d))))
399  nil)
400
401(deftest /=.order.1
402  (let ((i 0) x y)
403    (values
404     (notnot (/= (progn (setf x (incf i)) 1)
405                 (progn (setf y (incf i)) 2)))
406     i x y))
407  t 2 1 2)
408
409(deftest /=.order.2
410  (let ((i 0) x y z)
411    (values
412     (notnot (/= (progn (setf x (incf i)) 1)
413                 (progn (setf y (incf i)) 2)
414                 (progn (setf z (incf i)) 3)))
415     i x y z))
416  t 3 1 2 3)
417
418(deftest /=.order.3
419  (let ((i 0) u v w x y z)
420    (values
421     (notnot
422      (/=
423       (progn (setf u (incf i)) 1)
424       (progn (setf v (incf i)) 2)
425       (progn (setf w (incf i)) 3)
426       (progn (setf x (incf i)) 4)
427       (progn (setf y (incf i)) 5)
428       (progn (setf z (incf i)) 6)))
429     i u v w x y z))
430  t 6 1 2 3 4 5 6)
431
432;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
433
434(deftest <.1
435  (let ((a 0) (b 1)) (notnot-mv (< a b)))
436  t)
437
438(deftest <.2
439  (let ((a 0) (b 0)) (notnot-mv (< a b)))
440  nil)
441
442(deftest <.3
443  (let ((a 1) (b 0)) (notnot-mv (< a b)))
444  nil)
445
446(defparameter *number-less-tests*
447  (let* ((n (- most-positive-fixnum most-negative-fixnum))
448         (n2 (* 1000 n)))
449    (nconc
450     (loop for i = (+ (random n) most-negative-fixnum)
451           for i2 = (+ i (random most-positive-fixnum))
452           repeat 1000
453           nconc
454           (list (list i i2 t) (list i2 i nil)))
455     (loop for i = (random n2)
456           for i2 = (+ (random n2) i)
457           repeat 1000
458           nconc
459           (list (list i i2 t) (list i2 i nil)))
460     (loop for x in *universe*
461           when (integerp x)
462           nconc (list (list x (1+ x) t)
463                       (list (1+ x) x nil)))
464     (loop for x in *universe*
465           when (realp x)
466           collect (list x x nil))
467
468     (loop for x in *universe*
469           when (and (realp x) (>= x 1))
470           nconc
471           (loop for epsilon in (list short-float-epsilon
472                                      single-float-epsilon
473                                      double-float-epsilon
474                                      long-float-epsilon)
475                 for bound in (list most-positive-short-float
476                                    most-positive-single-float
477                                    most-positive-double-float
478                                    most-positive-long-float)
479                 for lower-bound in (list most-negative-short-float
480                                    most-negative-single-float
481                                    most-negative-double-float
482                                    most-negative-long-float)
483                 for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
484                 when (and (<= (abs (float-exponent lower-bound)) 500)
485                           (<= (abs (float-exponent x)) 500)
486                           (<= (abs (float-exponent bound)) 500))
487                 when (<= (rational lower-bound)
488                          (rational x)
489                          (rational bound))
490                 nconc
491                 (let* ((y (float x one))
492                        (z (* y (- one (* 2 epsilon)))))
493                   (list (list y z nil)
494                         (list z y t)))))
495     
496     (loop for x in *universe*
497           when (and (realp x) (<= x -1))
498           nconc
499           (loop for epsilon in (list short-float-epsilon
500                                      single-float-epsilon
501                                      double-float-epsilon
502                                      long-float-epsilon)
503                 for bound in (list most-negative-short-float
504                                    most-negative-single-float
505                                    most-negative-double-float
506                                    most-negative-long-float)
507                 for upper-bound in (list most-positive-short-float
508                                    most-positive-single-float
509                                    most-positive-double-float
510                                    most-positive-long-float)
511                 for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
512                 when (and (<= (abs (float-exponent bound)) 500)
513                           (<= (abs (float-exponent x)) 500)
514                           (<= (abs (float-exponent upper-bound)) 500))
515                 when (<= (rational bound)
516                          (rational x)
517                          (rational upper-bound))
518                 nconc
519                 (let* ((y (float x one)))
520                   (let ((z (* y (- one (* 2 epsilon)))))
521                     (list (list y z t)
522                           (list z y nil))))))
523     
524     (loop for x in *universe*
525           when (and (realp x) (< -1 x 1))
526           nconc
527           (loop for epsilon in (list short-float-epsilon
528                                      single-float-epsilon
529                                      double-float-epsilon
530                                      long-float-epsilon)
531                 for lower-bound in (list most-negative-short-float
532                                    most-negative-single-float
533                                    most-negative-double-float
534                                    most-negative-long-float)
535                 for upper-bound in (list most-positive-short-float
536                                    most-positive-single-float
537                                    most-positive-double-float
538                                    most-positive-long-float)
539                 for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
540                 when (and (<= (abs (float-exponent lower-bound)) 500)
541                           (<= (abs (float-exponent x)) 500)
542                           (<= (abs (float-exponent upper-bound)) 500))
543                 when (<= (rational lower-bound)
544                          (rational x)
545                          (rational upper-bound))
546                 nconc
547                 (handler-case
548                  (let* ((y (float x one))
549                         (z1 (+ y epsilon))
550                         (z2 (- y epsilon)))
551                    (list (list y z1 t)
552                          (list z1 y nil)
553                          (list y z2 nil)
554                          (list z2 y t)))
555                  (arithmetic-error () nil)))
556           ))))
557
558(deftest <.4
559  (loop for (x y result . rest) in *number-less-tests*
560        unless (if (< x y) result (not result))
561        collect (list* x y result rest))
562  nil)
563
564(deftest <.5
565  (loop for x in *universe*
566        when (and (typep x 'real)
567                  (not (< x)))
568        collect x)
569  nil)
570
571(deftest <.6
572  (let ((args (list 17))
573        (args2 nil))
574    (loop for i from 2 to (min 256 (1- call-arguments-limit))
575          do (push 17 args)
576          do (push (- i) args2)
577          unless (and (not (apply #'< args))
578                      (apply #'< args2))
579          collect (list args args2)))
580  nil)
581
582(deftest <.7
583  (let* ((len (min 256 (1- call-arguments-limit)))
584         (args-proto (loop for i from 1 to len collect i)))
585    (loop for i from 1 below len
586          for args = (copy-list args-proto)
587          do (setf (elt args i) 0)
588          never (apply #'< args)))
589  t)
590
591;;; Check that < is antisymmetric
592(deftest <.8
593  (<.8-fn)
594  nil)
595
596;;;  < is symmetric with >
597(deftest <.9
598  (<.9-fn)
599  nil)
600
601;;;  < is negation of >=
602(deftest <.10
603  (<.10-fn)
604  nil)
605
606(deftest <.11
607  (loop for x in '(0.0s0 0.0f0 0.0d0 0.0l0)
608        never (or (< (- x) x)
609                  (< x (- x))))
610  t)
611
612(deftest <.17
613  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
614        for eps in (list short-float-epsilon single-float-epsilon
615                         double-float-epsilon long-float-epsilon)
616        for exp = (nth-value 1 (decode-float eps))
617        for radix = (float-radix eps)
618        when (< (* (log radix 2) exp) 1000)
619        nconc
620        (let* ((rat (rational eps))
621               (xrat (rational x)))
622          (loop for i from 2 to 100
623                for rat/i = (/ rat i)
624                for xrat+rat/i = (+ xrat rat/i)
625                nconc
626                (if (< x xrat+rat/i)
627                    nil
628                    (list (list x i  xrat+rat/i))))))
629  nil)
630
631(deftest <.18
632  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
633        for eps in (list short-float-negative-epsilon single-float-negative-epsilon
634                         double-float-negative-epsilon long-float-negative-epsilon)
635        for exp = (nth-value 1 (decode-float eps))
636        for radix = (float-radix eps)
637        when (< (* (log radix 2) exp) 1000)
638        nconc
639        (let* ((rat (rational eps))
640               (xrat (rational x)))
641          (loop for i from 2 to 100
642                for rat/i = (/ rat i)
643                for xrat-rat/i = (- xrat rat/i)
644                nconc
645                (if (< x xrat-rat/i)
646                    (list (list x i xrat-rat/i))
647                  nil))))
648  nil)
649
650(deftest <.19
651  (let ((bound (expt 10 1000)))
652    (loop for x in (list most-positive-short-float most-positive-single-float
653                         most-positive-double-float most-positive-long-float)
654          for d = (and (<= x bound) (truncate x))
655          unless (or (null d) (and (< x (* 3/2 d))
656                                   (not (< (* 17/16 d) x))))
657          collect (list x d (* 3/2 d) (* 17/16 d))))
658  nil)
659
660(deftest <.order.1
661  (let ((i 0) x y)
662    (values
663     (notnot (< (progn (setf x (incf i)) 1)
664                 (progn (setf y (incf i)) 2)))
665     i x y))
666  t 2 1 2)
667
668(deftest <.order.2
669  (let ((i 0) x y z)
670    (values
671     (notnot (< (progn (setf x (incf i)) 1)
672                 (progn (setf y (incf i)) 2)
673                 (progn (setf z (incf i)) 3)))
674     i x y z))
675  t 3 1 2 3)
676
677(deftest <.order.3
678  (let ((i 0) u v w x y z)
679    (values
680     (notnot
681      (<
682       (progn (setf u (incf i)) 1)
683       (progn (setf v (incf i)) 2)
684       (progn (setf w (incf i)) 3)
685       (progn (setf x (incf i)) 4)
686       (progn (setf y (incf i)) 5)
687       (progn (setf z (incf i)) 6)))
688     i u v w x y z))
689  t 6 1 2 3 4 5 6)
690
691;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
692
693(deftest <=.1
694  (let ((a 0) (b 1)) (notnot-mv (<= a b)))
695  t)
696
697(deftest <=.2
698  (let ((a 0) (b 0)) (notnot-mv (<= a b)))
699  t)
700
701(deftest <=.3
702  (let ((a 1) (b 0)) (notnot-mv (<= a b)))
703  nil)
704
705(defparameter *number-less-or-equal-tests*
706  (let* ((n (- most-positive-fixnum most-negative-fixnum))
707         (n2 (* 1000 n)))
708    (nconc
709     (loop for i = (+ (random n) most-negative-fixnum)
710           for i2 = (+ i (random most-positive-fixnum))
711           repeat 1000
712           nconc
713           (list (list i i2 t) (list i2 i nil)))
714     (loop for i = (random n2)
715           for i2 = (+ (random n2) i)
716           repeat 1000
717           nconc
718           (list (list i i2 t) (list i2 i nil)))
719     (loop for x in *universe*
720           when (integerp x)
721           nconc (list (list x (1+ x) t)
722                       (list (1+ x) x nil)))
723     (loop for x in *universe*
724           when (realp x)
725           collect (list x x t))
726
727     (loop for x in *universe*
728           when (and (realp x) (>= x 1))
729           nconc
730           (loop for epsilon in (list short-float-epsilon
731                                      single-float-epsilon
732                                      double-float-epsilon
733                                      long-float-epsilon)
734                 for bound in (list most-positive-short-float
735                                    most-positive-single-float
736                                    most-positive-double-float
737                                    most-positive-long-float)
738                 for lower-bound in (list most-negative-short-float
739                                    most-negative-single-float
740                                    most-negative-double-float
741                                    most-negative-long-float)
742                 for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
743                 when (and (<= (abs (float-exponent lower-bound)) 500)
744                           (<= (abs (float-exponent x)) 500)
745                           (<= (abs (float-exponent bound)) 500))
746                 when (<= (rational lower-bound)
747                          (rational x)
748                          (rational bound))
749                 nconc
750                 (let* ((y (float x one))
751                        (z (* y (- one (* 2 epsilon)))))
752                   (list (list y z nil)
753                         (list z y t)))))
754     (loop for x in *universe*
755           when (and (realp x) (<= x -1))
756           nconc
757           (loop for epsilon in (list short-float-epsilon
758                                      single-float-epsilon
759                                      double-float-epsilon
760                                      long-float-epsilon)
761                 for bound in (list most-negative-short-float
762                                    most-negative-single-float
763                                    most-negative-double-float
764                                    most-negative-long-float)
765                 for upper-bound in (list most-positive-short-float
766                                    most-positive-single-float
767                                    most-positive-double-float
768                                    most-positive-long-float)
769                 for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
770                 when (and (<= (abs (float-exponent bound)) 500)
771                           (<= (abs (float-exponent x)) 500)
772                           (<= (abs (float-exponent upper-bound)) 500))
773                 when (<= (rational bound)
774                          (rational x)
775                          (rational upper-bound))
776                 nconc
777                 (let* ((y (float x one))
778                        (z (* y (- one (* 2 epsilon)))))
779                   (list (list y z t)
780                         (list z y nil)))))
781     (loop for x in *universe*
782           when (and (realp x) (< -1 x 1))
783           nconc
784           (loop for epsilon in (list short-float-epsilon
785                                      single-float-epsilon
786                                      double-float-epsilon
787                                      long-float-epsilon)
788                 for lower-bound in (list most-negative-short-float
789                                    most-negative-single-float
790                                    most-negative-double-float
791                                    most-negative-long-float)
792                 for upper-bound in (list most-positive-short-float
793                                    most-positive-single-float
794                                    most-positive-double-float
795                                    most-positive-long-float)
796                 for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
797                 when (and (<= (abs (float-exponent lower-bound)) 500)
798                           (<= (abs (float-exponent x)) 500)
799                           (<= (abs (float-exponent upper-bound)) 500))
800                 when (<= (rational lower-bound)
801                          (rational x)
802                          (rational upper-bound))
803                 nconc
804                 (handler-case
805                  (let* ((y (float x one))
806                         (z1 (+ y epsilon))
807                         (z2 (- y epsilon)))
808                    (list (list y z1 t)
809                          (list z1 y nil)
810                          (list y z2 nil)
811                          (list z2 y t)))
812                  (floating-point-underflow () nil))))
813     )))
814
815(deftest <=.4
816  (loop for (x y result . rest) in *number-less-or-equal-tests*
817        unless (if (<= x y) result (not result))
818        collect (list* x y result rest))
819  nil)
820
821(deftest <=.5
822  (loop for x in *universe*
823        when (and (typep x 'real)
824                  (not (<= x)))
825        collect x)
826  nil)
827
828(deftest <=.6
829  (let ((args (list 17))
830        (args2 nil)
831        (args3 (list 0)))
832    (loop for i from 2 to (min 256 (1- call-arguments-limit))
833          do (push 17 args)
834          do (push (- i) args2)
835          do (push i args3)
836          unless (and (apply #'<= args)
837                      (apply #'<= args2)
838                      (not (apply #'<= args3)))
839          collect (list args args2 args3)))
840  nil)
841
842(deftest <=.7
843  (let* ((len (min 256 (1- call-arguments-limit)))
844         (args-proto (loop for i from 1 to len collect i)))
845    (loop for i from 1 below len
846          for args = (copy-list args-proto)
847          do (setf (elt args i) 0)
848          never (apply #'<= args)))
849  t)
850
851;;; Check that <= is symmetric with >=
852(deftest <=.8
853  (<=.8-fn)
854  nil)
855
856;;; Check that <= is equivalent to (or < =)
857(deftest <=.9
858  (<=.9-fn)
859  nil)
860
861(deftest <=.10
862  (loop for x in '(0.0s0 0.0f0 0.0d0 0.0l0)
863        always (and (<= (- x) x)
864                    (<= x (- x))))
865  t)
866
867(deftest <=.17
868  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
869        for eps in (list short-float-epsilon single-float-epsilon
870                         double-float-epsilon long-float-epsilon)
871        for exp = (nth-value 1 (decode-float eps))
872        for radix = (float-radix eps)
873        when (< (* (log radix 2) exp) 1000)
874        nconc
875        (let* ((rat (rational eps))
876               (xrat (rational x)))
877          (loop for i from 2 to 100
878                for rat/i = (/ rat i)
879                for xrat+rat/i = (+ xrat rat/i)
880                nconc
881                (if (<= x xrat+rat/i)
882                    nil
883                    (list (list x i  xrat+rat/i))))))
884  nil)
885
886(deftest <=.18
887  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
888        for eps in (list short-float-negative-epsilon single-float-negative-epsilon
889                         double-float-negative-epsilon long-float-negative-epsilon)
890        for exp = (nth-value 1 (decode-float eps))
891        for radix = (float-radix eps)
892        when (< (* (log radix 2) exp) 1000)
893        nconc
894        (let* ((rat (rational eps))
895               (xrat (rational x)))
896          (loop for i from 2 to 100
897                for rat/i = (/ rat i)
898                for xrat-rat/i = (- xrat rat/i)
899                nconc
900                (if (<= x xrat-rat/i)
901                    (list (list x i xrat-rat/i))
902                  nil))))
903  nil)
904
905(deftest <=.19
906  (let ((bound (expt 10 1000)))
907    (loop for x in (list most-positive-short-float most-positive-single-float
908                         most-positive-double-float most-positive-long-float)
909          for d = (and (<= x bound) (truncate x))
910          unless (or (null d) (and (<= x (* 3/2 d))
911                                   (not (<= (* 5/4 d) x))))
912          collect (list x d (* 3/2 d) (* 5/4 d))))
913  nil)
914
915(deftest <=.order.1
916  (let ((i 0) x y)
917    (values
918     (notnot (<= (progn (setf x (incf i)) 1)
919                 (progn (setf y (incf i)) 2)))
920     i x y))
921  t 2 1 2)
922
923(deftest <=.order.2
924  (let ((i 0) x y z)
925    (values
926     (notnot (<= (progn (setf x (incf i)) 1)
927                 (progn (setf y (incf i)) 2)
928                 (progn (setf z (incf i)) 3)))
929     i x y z))
930  t 3 1 2 3)
931
932(deftest <=.order.3
933  (let ((i 0) u v w x y z)
934    (values
935     (notnot
936      (<=
937       (progn (setf u (incf i)) 1)
938       (progn (setf v (incf i)) 2)
939       (progn (setf w (incf i)) 3)
940       (progn (setf x (incf i)) 4)
941       (progn (setf y (incf i)) 5)
942       (progn (setf z (incf i)) 6)))
943     i u v w x y z))
944  t 6 1 2 3 4 5 6)
945
946
947;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
948
949(deftest >.1
950  (let ((a 0) (b 1)) (notnot-mv (> a b)))
951  nil)
952
953(deftest >.2
954  (let ((a 0) (b 0)) (notnot-mv (> a b)))
955  nil)
956
957(deftest >.3
958  (let ((a 1) (b 0)) (notnot-mv (> a b)))
959  t)
960
961(deftest >.4
962  (loop for (x y result . rest) in *number-less-tests*
963        unless (if (> y x) result (not result))
964        collect (list* y x result rest))
965  nil)
966
967(deftest >.5
968  (loop for x in *universe*
969        when (and (typep x 'real)
970                  (not (> x)))
971        collect x)
972  nil)
973
974(deftest >.6
975  (let ((args (list 17))
976        (args2 nil))
977    (loop for i from 2 to (min 256 (1- call-arguments-limit))
978          do (push 17 args)
979          do (push i args2)
980          unless (and (not (apply #'> args))
981                      (apply #'> args2))
982          collect (list args args2)))
983  nil)
984
985(deftest >.7
986  (let* ((len (min 256 (1- call-arguments-limit)))
987         (args-proto (loop for i from 1 to len collect i)))
988    (loop for i from 1 below len
989          for args = (copy-list args-proto)
990          do (setf (elt args i) 0)
991          never (apply #'> args)))
992  t)
993
994;;; > is negation of <=
995(deftest >.8
996  (>.8-fn)
997  nil)
998
999(deftest >.9
1000  (loop for x in '(0.0s0 0.0f0 0.0d0 0.0l0)
1001        never (or (> (- x) x)
1002                  (> x (- x))))
1003  t)
1004
1005(deftest >.17
1006  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
1007        for eps in (list short-float-epsilon single-float-epsilon
1008                         double-float-epsilon long-float-epsilon)
1009        for exp = (nth-value 1 (decode-float eps))
1010        for radix = (float-radix eps)
1011        when (< (* (log radix 2) exp) 1000)
1012        nconc
1013        (let* ((rat (rational eps))
1014               (xrat (rational x)))
1015          (loop for i from 2 to 100
1016                for rat/i = (/ rat i)
1017                for xrat+rat/i = (+ xrat rat/i)
1018                nconc
1019                (if (> x xrat+rat/i)
1020                    (list (list x i  xrat+rat/i))
1021                  nil))))
1022  nil)
1023
1024(deftest >.18
1025  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
1026        for eps in (list short-float-negative-epsilon single-float-negative-epsilon
1027                         double-float-negative-epsilon long-float-negative-epsilon)
1028        for exp = (nth-value 1 (decode-float eps))
1029        for radix = (float-radix eps)
1030        when (< (* (log radix 2) exp) 1000)
1031        nconc
1032        (let* ((rat (rational eps))
1033               (xrat (rational x)))
1034          (loop for i from 2 to 100
1035                for rat/i = (/ rat i)
1036                for xrat-rat/i = (- xrat rat/i)
1037                nconc
1038                (if (> x xrat-rat/i)
1039                    nil
1040                    (list (list x i  xrat-rat/i))))))
1041  nil)
1042
1043(deftest >.19
1044  (let ((bound (expt 10 1000)))
1045    (loop for x in (list most-positive-short-float most-positive-single-float
1046                         most-positive-double-float most-positive-long-float)
1047          for d = (and (<= x bound) (truncate x))
1048          unless (or (null d) (and (> (* 3/2 d) x)
1049                                   (not (> x (* 17/16 d)))))
1050          collect (list x d (* 3/2 d) (* 17/16 d))))
1051  nil)
1052
1053(deftest >.order.1
1054  (let ((i 0) x y)
1055    (values
1056     (notnot (> (progn (setf x (incf i)) 2)
1057                (progn (setf y (incf i)) 1)))
1058     i x y))
1059  t 2 1 2)
1060
1061(deftest >.order.2
1062  (let ((i 0) x y z)
1063    (values
1064     (notnot (> (progn (setf x (incf i)) 3)
1065                 (progn (setf y (incf i)) 2)
1066                 (progn (setf z (incf i)) 1)))
1067     i x y z))
1068  t 3 1 2 3)
1069
1070(deftest >.order.3
1071  (let ((i 0) u v w x y z)
1072    (values
1073     (notnot
1074      (>
1075       (progn (setf u (incf i)) 6)
1076       (progn (setf v (incf i)) 5)
1077       (progn (setf w (incf i)) 4)
1078       (progn (setf x (incf i)) 3)
1079       (progn (setf y (incf i)) 2)
1080       (progn (setf z (incf i)) 1)))
1081     i u v w x y z))
1082  t 6 1 2 3 4 5 6)
1083
1084;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1085
1086(deftest >=.1
1087  (let ((a 0) (b 1)) (notnot-mv (>= a b)))
1088  nil)
1089
1090(deftest >=.2
1091  (let ((a 0) (b 0)) (notnot-mv (>= a b)))
1092  t)
1093
1094(deftest >=.3
1095  (let ((a 1) (b 0)) (notnot-mv (>= a b)))
1096  t)
1097
1098(deftest >=.4
1099  (loop for (x y result . rest) in *number-less-or-equal-tests*
1100        unless (if (>= y x) result (not result))
1101        collect (list* y x result rest))
1102  nil)
1103
1104(deftest >=.5
1105  (loop for x in *universe*
1106        when (and (typep x 'real)
1107                  (not (>= x)))
1108        collect x)
1109  nil)
1110
1111(deftest >=.6
1112  (let ((args (list 17))
1113        (args2 (list 0))
1114        (args3 nil))
1115    (loop for i from 2 to (min 256 (1- call-arguments-limit))
1116          do (push 17 args)
1117          do (push (- i) args2)
1118          do (push i args3)
1119          unless (and (apply #'>= args)
1120                      (not (apply #'>= args2))
1121                      (apply #'>= args3))
1122          collect (list args args2 args3)))
1123  nil)
1124
1125(deftest >=.7
1126  (let* ((len (min 256 (1- call-arguments-limit)))
1127         (args-proto (loop for i from 1 to len collect i)))
1128    (loop for i from 1 below len
1129          for args = (copy-list args-proto)
1130          do (setf (elt args i) 0)
1131          never (apply #'>= args)))
1132  t)
1133
1134;;; Check that >= is equivalent to (or > =)
1135(deftest >=.8
1136  (>=.8-fn)
1137  nil)
1138
1139(deftest >=.9
1140  (loop for x in '(0.0s0 0.0f0 0.0d0 0.0l0)
1141        always (and (>= (- x) x)
1142                    (>= x (- x))))
1143  t)
1144
1145
1146(deftest >=.17
1147  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
1148        for eps in (list short-float-epsilon single-float-epsilon
1149                         double-float-epsilon long-float-epsilon)
1150        for exp = (nth-value 1 (decode-float eps))
1151        for radix = (float-radix eps)
1152        when (< (* (log radix 2) exp) 1000)
1153        nconc
1154        (let* ((rat (rational eps))
1155               (xrat (rational x)))
1156          (loop for i from 2 to 100
1157                for rat/i = (/ rat i)
1158                for xrat+rat/i = (+ xrat rat/i)
1159                nconc
1160                (if (>= x xrat+rat/i)
1161                    (list (list x i  xrat+rat/i))
1162                  nil))))
1163  nil)
1164
1165(deftest >=.18
1166  (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
1167        for eps in (list short-float-negative-epsilon single-float-negative-epsilon
1168                         double-float-negative-epsilon long-float-negative-epsilon)
1169        for exp = (nth-value 1 (decode-float eps))
1170        for radix = (float-radix eps)
1171        when (< (* (log radix 2) exp) 1000)
1172        nconc
1173        (let* ((rat (rational eps))
1174               (xrat (rational x)))
1175          (loop for i from 2 to 100
1176                for rat/i = (/ rat i)
1177                for xrat-rat/i = (- xrat rat/i)
1178                nconc
1179                (if (>= x xrat-rat/i)
1180                    nil
1181                    (list (list x i xrat-rat/i))))))
1182  nil)
1183
1184(deftest >=.19
1185  (let ((bound (expt 10 1000)))
1186    (loop for x in (list most-positive-short-float most-positive-single-float
1187                         most-positive-double-float most-positive-long-float)
1188          for d = (and (<= x bound) (truncate x))
1189          unless (or (null d) (and (>= (* 3/2 d) x)
1190                                   (not (>=  x(* 17/16 d)))))
1191          collect (list x d (* 3/2 d) (* 17/16 d))))
1192  nil)
1193
1194(deftest >=.order.1
1195  (let ((i 0) x y)
1196    (values
1197     (notnot (>= (progn (setf x (incf i)) 2)
1198                (progn (setf y (incf i)) 1)))
1199     i x y))
1200  t 2 1 2)
1201
1202(deftest >=.order.2
1203  (let ((i 0) x y z)
1204    (values
1205     (notnot (>= (progn (setf x (incf i)) 3)
1206                 (progn (setf y (incf i)) 2)
1207                 (progn (setf z (incf i)) 1)))
1208     i x y z))
1209  t 3 1 2 3)
1210
1211(deftest >=.order.3
1212  (let ((i 0) u v w x y z)
1213    (values
1214     (notnot
1215      (>=
1216       (progn (setf u (incf i)) 6)
1217       (progn (setf v (incf i)) 5)
1218       (progn (setf w (incf i)) 4)
1219       (progn (setf x (incf i)) 3)
1220       (progn (setf y (incf i)) 2)
1221       (progn (setf z (incf i)) 1)))
1222     i u v w x y z))
1223  t 6 1 2 3 4 5 6)
1224
1225;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1226
1227;;; Comparison of rationals
1228
1229(deftest compare-rationals.1
1230  (compare-random-rationals 60000 30000 10000)
1231  nil)
1232
1233(deftest compare-rationals.2
1234  (compare-random-rationals 600000 300000 10000)
1235  nil)
1236
1237(deftest compare-rationals.3
1238  (compare-random-rationals 6000000 3000000 10000)
1239  nil)
1240
1241(deftest compare-rationals.4
1242  (compare-random-rationals 6000000000 3000000000 10000)
1243  nil)
1244
1245;;;; Comparison of bignums with floats
1246
1247(deftest bignum.float.compare.1a
1248  (loop for x in *floats*
1249        when (or (zerop x)
1250                 (< (abs (log (abs x))) 10000))
1251        nconc
1252        (loop for r = (1+ (random (ash 1 (random 32))))
1253              repeat 200
1254              nconc
1255              (let ((i (+ r (ceiling (rational x)))))
1256                (unless (< x i)
1257                  (list (list r x i))))))
1258  nil)
1259
1260(deftest bignum.float.compare.1b
1261  (loop for x in *floats*
1262        when (or (zerop x)
1263                 (< (abs (log (abs x))) 10000))
1264        nconc
1265        (loop for r = (1+ (random (ash 1 (random 32))))
1266              repeat 200
1267              nconc
1268              (let ((i (- (floor (rational x)) r)))
1269                (unless (< i x)
1270                  (list (list r x i))))))
1271  nil)
1272
1273(deftest bignum.float.compare.2a
1274  (loop for x in *floats*
1275        when (or (zerop x)
1276                 (< (abs (log (abs x))) 10000))
1277        nconc
1278        (loop for r = (1+ (random (ash 1 (random 32))))
1279              repeat 200
1280              nconc
1281              (let ((i (+ r (ceiling (rational x)))))
1282                (unless (> i x)
1283                  (list (list r x i))))))
1284  nil)
1285
1286(deftest bignum.float.compare.2b
1287  (loop for x in *floats*
1288        when (or (zerop x)
1289                 (< (abs (log (abs x))) 10000))
1290        nconc
1291        (loop for r = (1+ (random (ash 1 (random 32))))
1292              repeat 200
1293              nconc
1294              (let ((i (- (floor (rational x)) r)))
1295                (unless (> x i)
1296                  (list (list r x i))))))
1297  nil)
1298
1299(deftest bignum.float.compare.3a
1300  (loop for x in *floats*
1301        when (or (zerop x)
1302                 (< (abs (log (abs x))) 10000))
1303        nconc
1304        (loop for r = (1+ (random (ash 1 (random 32))))
1305              repeat 200
1306              nconc
1307              (let ((i (+ r (ceiling (rational x)))))
1308                (when (or (= x i) (= i x))
1309                  (list (list r x i))))))
1310  nil)
1311
1312(deftest bignum.float.compare.3b
1313  (loop for x in *floats*
1314        when (or (zerop x)
1315                 (< (abs (log (abs x))) 10000))
1316        nconc
1317        (loop for r = (1+ (random (ash 1 (random 32))))
1318              repeat 200
1319              nconc
1320              (let ((i (- (floor (rational x)) r)))
1321                (when (or (= x i) (= i x))
1322                  (list (list r x i))))))
1323  nil)
1324
1325(deftest bignum.float.compare.4a
1326  (loop for x in *floats*
1327        when (or (zerop x)
1328                 (< (abs (log (abs x))) 10000))
1329        nconc
1330        (loop for r = (1+ (random (ash 1 (random 32))))
1331              repeat 200
1332              nconc
1333              (let ((i (+ r (ceiling (rational x)))))
1334                (unless (and (/= i x) (/= x i))
1335                  (list (list r x i))))))
1336  nil)
1337
1338(deftest bignum.float.compare.4b
1339  (loop for x in *floats*
1340        when (or (zerop x)
1341                 (< (abs (log (abs x))) 10000))
1342        nconc
1343        (loop for r = (1+ (random (ash 1 (random 32))))
1344              repeat 200
1345              nconc
1346              (let ((i (- (floor (rational x)) r)))
1347                (unless (and (/= i x) (/= x i))
1348                  (list (list r x i))))))
1349  nil)
1350
1351(deftest bignum.float.compare.5a
1352  (loop for x in *floats*
1353        when (or (zerop x)
1354                 (< (abs (log (abs x))) 10000))
1355        nconc
1356        (loop for r = (1+ (random (ash 1 (random 32))))
1357              repeat 200
1358              nconc
1359              (let ((i (+ r (ceiling (rational x)))))
1360                (unless (<= x i)
1361                  (list (list r x i))))))
1362  nil)
1363
1364(deftest bignum.float.compare.5b
1365  (loop for x in *floats*
1366        when (or (zerop x)
1367                 (< (abs (log (abs x))) 10000))
1368        nconc
1369        (loop for r = (1+ (random (ash 1 (random 32))))
1370              repeat 200
1371              nconc
1372              (let ((i (- (floor (rational x)) r)))
1373                (unless (<= i x)
1374                  (list (list r x i))))))
1375  nil)
1376
1377(deftest bignum.float.compare.6a
1378  (loop for x in *floats*
1379        when (or (zerop x)
1380                 (< (abs (log (abs x))) 10000))
1381        nconc
1382        (loop for r = (1+ (random (ash 1 (random 32))))
1383              repeat 200
1384              nconc
1385              (let ((i (+ r (ceiling (rational x)))))
1386                (unless (>= i x)
1387                  (list (list r x i))))))
1388  nil)
1389
1390(deftest bignum.float.compare.6b
1391  (loop for x in *floats*
1392        when (or (zerop x)
1393                 (< (abs (log (abs x))) 10000))
1394        nconc
1395        (loop for r = (1+ (random (ash 1 (random 32))))
1396              repeat 200
1397              nconc
1398              (let ((i (- (floor (rational x)) r)))
1399                (unless (>= x i)
1400                  (list (list r x i))))))
1401  nil)
1402
1403(deftest bignum.float.compare.7
1404  (let ((toobig (loop for x in *reals*
1405                      collect (and (> (abs x) 1.0)
1406                                   (> (abs (log (abs x))) 10000)))))
1407    (loop for x in *reals*
1408          for xtoobig in toobig
1409          nconc
1410          (unless xtoobig
1411            (let ((fx (floor x)))
1412              (loop for y in *reals*
1413                    for ytoobig in toobig
1414                    when (and (not ytoobig)
1415                              (< x y)
1416                              (or (not (< fx y))
1417                                  (<= y fx)
1418                                  (not (> y fx))
1419                                  (>= fx y)))
1420                    collect (list x y))))))
1421  nil)
1422
1423(deftest bignum.float.compare.8
1424  (let ((toobig (loop for x in *reals*
1425                      collect (and (> (abs x) 1.0)
1426                                   (> (abs (log (abs x))) 10000)))))
1427    (loop for x in *reals*
1428          for xtoobig in toobig
1429          nconc
1430          (unless xtoobig
1431            (let ((fx (floor x)))
1432              (loop for y in *reals*
1433                    for ytoobig in toobig
1434                    when (and (not ytoobig)
1435                              (<= x y)
1436                              (or (not (<= fx y))
1437                                  (> fx y)
1438                                  (not (>= y fx))
1439                                  (< y fx)))
1440                    collect (list x y))))))
1441  nil)
1442
1443;;; More randomized comparisons
1444
1445(deftest bignum.short-float.random.compare.1
1446  (let* ((integer-bound (ash 1 1000))
1447         (upper-bound (if (< (/ most-positive-short-float 2) integer-bound)
1448                          (/ most-positive-short-float 2)
1449                        (coerce integer-bound 'short-float))))
1450    (loop for bound = 1.0s0 then (* bound 2)
1451          while (<= bound upper-bound)
1452          nconc
1453          (loop for r = (random bound)
1454                for fr = (floor r)
1455                for cr = (ceiling r)
1456                repeat 20
1457                unless (and (<= fr r cr)
1458                            (if (= r fr)
1459                                (= r cr)
1460                              (/= r cr))
1461                            (>= cr r fr))
1462                collect (list r fr cr))))
1463  nil)
1464
1465(deftest bignum.single-float.random.compare.1
1466  (let* ((integer-bound (ash 1 100))
1467         (upper-bound (if (< (/ most-positive-single-float 2) integer-bound)
1468                          (/ most-positive-single-float 2)
1469                        (coerce integer-bound 'single-float))))
1470    (loop for bound = 1.0f0 then (* bound 2)
1471          while (<= bound upper-bound)
1472          nconc
1473          (loop for r = (random bound)
1474                for fr = (floor r)
1475                for cr = (ceiling r)
1476                repeat 20
1477                unless (and (<= fr r cr)
1478                            (if (= r fr)
1479                                (= r cr)
1480                              (/= r cr))
1481                            (>= cr r fr))
1482                collect (list r fr cr))))
1483  nil)
1484
1485(deftest bignum.double-float.random.compare.1
1486  (let* ((integer-bound (ash 1 100))
1487         (upper-bound (if (< (/ most-positive-double-float 2) integer-bound)
1488                          (/ most-positive-double-float 2)
1489                        (coerce integer-bound 'double-float))))
1490    (loop for bound = 1.0d0 then (* bound 2)
1491          while (<= bound upper-bound)
1492          nconc
1493          (loop for r = (random bound)
1494                for fr = (floor r)
1495                for cr = (ceiling r)
1496                repeat 20
1497                unless (and (<= fr r cr)
1498                            (if (= r fr)
1499                                (= r cr)
1500                              (/= r cr))
1501                            (>= cr r fr))
1502                collect (list r fr cr))))
1503  nil)
1504
1505(deftest bignum.long-float.random.compare.1
1506  (let* ((integer-bound (ash 1 100))
1507         (upper-bound (if (< (/ most-positive-long-float 2) integer-bound)
1508                          (/ most-positive-long-float 2)
1509                        (coerce integer-bound 'long-float))))
1510    (loop for bound = 1.0l0 then (* bound 2)
1511          while (< bound upper-bound)
1512          nconc
1513          (loop for r = (random bound)
1514                for fr = (floor r)
1515                for cr = (ceiling r)
1516                repeat 20
1517                unless (and (<= fr r cr)
1518                            (if (= r fr)
1519                                (= r cr)
1520                              (/= r cr))
1521                            (>= cr r fr))
1522                collect
1523                (list r fr cr))))
1524  nil)
1525
1526;;; Rational/float comparisons
1527
1528(deftest rational.short-float.random.compare.1
1529  (let* ((integer-bound (ash 1 1000))
1530         (upper-bound (if (< (/ most-positive-short-float 2) integer-bound)
1531                          (/ most-positive-short-float 2)
1532                        (coerce integer-bound 'short-float))))
1533    (loop for bound = 1.0s0 then (* bound 2)
1534          while (<= bound upper-bound)
1535          nconc
1536          (loop for r = (+ 1.s0 (random bound))
1537                for fr = (floor r)
1538                for cr = (ceiling r)
1539                for m = (ash 1 (1+ (random 30)))
1540                for p = (1+ (random m))
1541                for q = (1+ (random m))
1542                for x = 0
1543                repeat 50
1544                when (<= p q) do (psetf p (1+ q) q p)
1545                do (setf x (/ p q))
1546                unless (let ((fr/x (/ fr x))
1547                             (cr*x (* cr x)))
1548                         (and (<= fr/x r cr*x)
1549                              (< fr/x r cr*x)
1550                              (> cr*x r fr/x)
1551                              (>= cr*x r fr/x)))
1552                collect (list r p q x fr cr))))
1553  nil)
1554
1555(deftest rational.single-float.random.compare.1
1556  (let* ((integer-bound (ash 1 1000))
1557         (upper-bound (if (< (/ most-positive-single-float 2) integer-bound)
1558                          (/ most-positive-single-float 2)
1559                        (coerce integer-bound 'single-float))))
1560    (loop for bound = 1.0f0 then (* bound 2)
1561          while (<= bound upper-bound)
1562          nconc
1563          (loop for r = (+ 1.s0 (random bound))
1564                for fr = (floor r)
1565                for cr = (ceiling r)
1566                for m = (ash 1 (1+ (random 30)))
1567                for p = (1+ (random m))
1568                for q = (1+ (random m))
1569                for x = 0
1570                repeat 50
1571                when (<= p q) do (psetf p (1+ q) q p)
1572                do (setf x (/ p q))
1573                unless (let ((fr/x (/ fr x))
1574                             (cr*x (* cr x)))
1575                         (and (<= fr/x r cr*x)
1576                              (< fr/x r cr*x)
1577                              (> cr*x r fr/x)
1578                              (>= cr*x r fr/x)))
1579                collect (list r p q x fr cr))))
1580  nil)
1581
1582(deftest rational.double-float.random.compare.1
1583  (let* ((integer-bound (ash 1 1000))
1584         (upper-bound (if (< (/ most-positive-double-float 4) integer-bound)
1585                          (/ most-positive-double-float 4)
1586                        (coerce integer-bound 'double-float))))
1587    (loop for bound = 1.0d0 then (* bound 4)
1588          while (<= bound upper-bound)
1589          nconc
1590          (loop for r = (+ 1.s0 (random bound))
1591                for fr = (floor r)
1592                for cr = (ceiling r)
1593                for m = (ash 1 (1+ (random 30)))
1594                for p = (1+ (random m))
1595                for q = (1+ (random m))
1596                for x = 0
1597                repeat 50
1598                when (<= p q) do (psetf p (1+ q) q p)
1599                do (setf x (/ p q))
1600                unless (let ((fr/x (/ fr x))
1601                             (cr*x (* cr x)))
1602                         (and (<= fr/x r cr*x)
1603                              (< fr/x r cr*x)
1604                              (> cr*x r fr/x)
1605                              (>= cr*x r fr/x)))
1606                collect (list r p q x fr cr))))
1607  nil)
1608
1609(deftest rational.long-float.random.compare.1
1610  (let* ((integer-bound (ash 1 1000))
1611         (upper-bound (if (< (/ most-positive-long-float 4) integer-bound)
1612                          (/ most-positive-long-float 4)
1613                        (coerce integer-bound 'long-float))))
1614    (loop for bound = 1.0d0 then (* bound 4)
1615          while (<= bound upper-bound)
1616          nconc
1617          (loop for r = (+ 1.s0 (random bound))
1618                for fr = (floor r)
1619                for cr = (ceiling r)
1620                for m = (ash 1 (1+ (random 30)))
1621                for p = (1+ (random m))
1622                for q = (1+ (random m))
1623                for x = 0
1624                repeat 50
1625                when (<= p q) do (psetf p (1+ q) q p)
1626                do (setf x (/ p q))
1627                unless (let ((fr/x (/ fr x))
1628                             (cr*x (* cr x)))
1629                         (and (<= fr/x r cr*x)
1630                              (< fr/x r cr*x)
1631                              (> cr*x r fr/x)
1632                              (>= cr*x r fr/x)))
1633                collect (list r p q x fr cr))))
1634  nil)
1635
1636;;; Test that explicit calls to macroexpand in subforms
1637;;; are done in the correct environment
1638
1639(deftest =.env.1
1640  (macrolet ((%m (z) z))
1641            (mapcar 'notnot
1642                    (list (= (expand-in-current-env (%m 0)))
1643                          (= 1 (expand-in-current-env (%m 1)))
1644                          (= (expand-in-current-env (%m 2)) 2)
1645                          (= (expand-in-current-env (%m 3))
1646                             (expand-in-current-env (%m 3)))
1647                          (= (expand-in-current-env (%m #c(1 2)))
1648                             (expand-in-current-env (%m #c(1 2))))
1649
1650                          (= 1 (expand-in-current-env (%m 2.0)))
1651                          (= (expand-in-current-env (%m 2)) 2/3)
1652                          (= (expand-in-current-env (%m 4))
1653                             (expand-in-current-env (%m 5)))
1654
1655                          (= (expand-in-current-env (%m 0)) 0 0)
1656                          (= 0 (expand-in-current-env (%m 0)) 0)
1657                          (= 0 0 (expand-in-current-env (%m 0)))
1658                          )))
1659  (t t t t t nil nil nil t t t))
1660
1661
1662(deftest /=.env.1
1663  (macrolet ((%m (z) z))
1664            (mapcar 'notnot
1665                    (list (/= (expand-in-current-env (%m 0)))
1666                          (/= 1 (expand-in-current-env (%m 1)))
1667                          (/= (expand-in-current-env (%m 2)) 2)
1668                          (/= (expand-in-current-env (%m 3))
1669                              (expand-in-current-env (%m 3)))
1670                          (/= (expand-in-current-env (%m #c(1 2)))
1671                              (expand-in-current-env (%m #c(1 2))))
1672
1673                          (/= 1 (expand-in-current-env (%m 2.0)))
1674                          (/= (expand-in-current-env (%m 2)) 2/3)
1675                          (/= (expand-in-current-env (%m 4))
1676                              (expand-in-current-env (%m 5)))
1677
1678                          (/= (expand-in-current-env (%m 2)) 0 1)
1679                          (/= 0 (expand-in-current-env (%m 2)) 1)
1680                          (/= 0 1 (expand-in-current-env (%m 2)))
1681                          )))
1682  (t nil nil nil nil t t t t t t))
1683
1684(deftest <.env.1
1685  (macrolet ((%m (z) z))
1686            (mapcar 'notnot
1687                    (list (< (expand-in-current-env (%m 0)))
1688                          (< 0 (expand-in-current-env (%m 1)))
1689                          (< (expand-in-current-env (%m 2)) 3)
1690                          (< (expand-in-current-env (%m 5))
1691                             (expand-in-current-env (%m 7)))
1692
1693                          (< 3 (expand-in-current-env (%m 2.0)))
1694                          (< (expand-in-current-env (%m 2)) 2/3)
1695                          (< (expand-in-current-env (%m 6))
1696                             (expand-in-current-env (%m 5)))
1697
1698                          (< (expand-in-current-env (%m 1)) 2 3)
1699                          (< 1 (expand-in-current-env (%m 2)) 3)
1700                          (< 1 2 (expand-in-current-env (%m 3)))
1701                          )))
1702  (t t t t nil nil nil t t t))
1703
1704(deftest <=.env.1
1705  (macrolet ((%m (z) z))
1706            (mapcar 'notnot
1707                    (list (<= (expand-in-current-env (%m 0)))
1708                          (<= 0 (expand-in-current-env (%m 1)))
1709                          (<= (expand-in-current-env (%m 2)) 3)
1710                          (<= (expand-in-current-env (%m 5))
1711                             (expand-in-current-env (%m 7)))
1712
1713                          (<= 3 (expand-in-current-env (%m 2.0)))
1714                          (<= (expand-in-current-env (%m 2)) 2/3)
1715                          (<= (expand-in-current-env (%m 6))
1716                             (expand-in-current-env (%m 5)))
1717
1718                          (<= (expand-in-current-env (%m 2)) 2 3)
1719                          (<= 1 (expand-in-current-env (%m 1)) 3)
1720                          (<= 1 2 (expand-in-current-env (%m 2)))
1721                          )))
1722  (t t t t nil nil nil t t t))
1723
1724(deftest >.env.1
1725  (macrolet ((%m (z) z))
1726            (mapcar 'notnot
1727                    (list (> (expand-in-current-env (%m 0)))
1728                          (> 2 (expand-in-current-env (%m 1)))
1729                          (> (expand-in-current-env (%m 4)) 3)
1730                          (> (expand-in-current-env (%m 10))
1731                             (expand-in-current-env (%m 7)))
1732
1733                          (> 1 (expand-in-current-env (%m 2.0)))
1734                          (> (expand-in-current-env (%m -1)) 2/3)
1735                          (> (expand-in-current-env (%m 4))
1736                             (expand-in-current-env (%m 5)))
1737
1738                          (> (expand-in-current-env (%m 2)) 1 0)
1739                          (> 2 (expand-in-current-env (%m 1)) 0)
1740                          (> 2 1 (expand-in-current-env (%m 0)))
1741                          )))
1742  (t t t t nil nil nil t t t))
1743
1744
1745(deftest >=.env.1
1746  (macrolet ((%m (z) z))
1747            (mapcar 'notnot
1748                    (list (>= (expand-in-current-env (%m 0)))
1749                          (>= 2 (expand-in-current-env (%m 1)))
1750                          (>= (expand-in-current-env (%m 4)) 3)
1751                          (>= (expand-in-current-env (%m 7))
1752                              (expand-in-current-env (%m 7)))
1753
1754                          (>= 1 (expand-in-current-env (%m 2.0)))
1755                          (>= (expand-in-current-env (%m -1)) 2/3)
1756                          (>= (expand-in-current-env (%m 4))
1757                             (expand-in-current-env (%m 5)))
1758
1759                          (>= (expand-in-current-env (%m 2)) 1 1)
1760                          (>= 1 (expand-in-current-env (%m 1)) 0)
1761                          (>= 2 2 (expand-in-current-env (%m 0)))
1762                          )))
1763  (t t t t nil nil nil t t t))
Note: See TracBrowser for help on using the repository browser.