/[gcl]/gcl/ansi-tests/number-comparison.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/number-comparison.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by pfdietz, Wed Apr 9 02:27:57 2003 UTC revision 1.2 by pfdietz, Sun Aug 3 21:05:22 2003 UTC
# Line 5  Line 5 
5    
6  (in-package :cl-test)  (in-package :cl-test)
7    
8    (compile-and-load "numbers-aux.lsp")
9    
10  ;;; Errors tests on comparison functions  ;;; Errors tests on comparison functions
11    
12  (deftest =.error.1  (deftest =.error.1
# Line 87  Line 89 
89          collect args)          collect args)
90    nil)    nil)
91    
92    
93  (deftest =.9  (deftest =.9
94    (=t 0 0.0)    (=t 0 0.0)
95    t)    t)
# Line 102  Line 105 
105  (deftest =.12  (deftest =.12
106    (=t -0.0 0.0)    (=t -0.0 0.0)
107    t)    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    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
161    
162    (deftest /=.1
163      (loop for x in *numbers*
164            unless (/= x)
165            collect x)
166      nil)
167    
168    (deftest /=.2
169      (loop for x in *numbers*
170            when (/= x x)
171            collect x)
172      nil)
173    
174    (deftest /=.3
175      (loop for x in *numbers*
176            when (/= x x x)
177            collect x)
178      nil)
179    
180    (deftest /=.4
181      (/=.4-fn)
182      nil)
183    
184    (deftest /=.4a
185      (/=.4a-fn)
186      nil)
187    
188    (deftest /=.5
189      (loop for i from 1 to 10000
190            for i2 = (1+ i)
191            always (and (/= i i2) (/= i2 i)))
192      t)
193    
194    (deftest /=.6
195      (loop for i from 5 to 10000 by 17
196            for j from 2 to i by 19
197            for r = (/ i j)
198            when (or (not (/= r (1+ r)))
199                     (not (/= r 0))
200                     (not (/= r (- r)))
201                     (/= r r))
202            collect r)
203      nil)
204                            
205    (deftest /=.7
206      (let ((args (list 17))
207            (args2 nil))
208        (loop for i from 2 to (min 256 call-arguments-limit)
209              do (push 17 args)
210              do (push i args2)
211              always (and (not (apply #'/= args))
212                          (apply #'/= args2))))
213      t)
214    
215    (deftest /=.8
216      (loop for i from 2 to (min 256 call-arguments-limit)
217            for args = (append (make-list (1- i) :initial-element 7)
218                               (list 7))
219            when (apply #'/= args)
220            collect args)
221      nil)
222    
223    
224    (deftest /=.9
225      (/= 0 0.0)
226      nil)
227    
228    (deftest /=.10
229      (/= 0 #c(0 0))
230      nil)
231    
232    (deftest /=.11
233      (/= 1 #c(1.0 0.0))
234      nil)
235    
236    (deftest /=.12
237      (/= -0.0 0.0)
238      nil)
239    
240    (deftest /=.13
241      (let ((nums '(0 0.0s0 0.0f0 0.0d0 0.0l0
242                      #c(0.0s0 0.0s0) #c(0.0f0 0.0f0)
243                      #c(0.0d0 0.0d0) #c(0.0l0 0.0l0))))
244        (loop for x in nums
245              append
246              (loop for y in nums
247                    when (/= x y)
248                    collect (list x y))))
249      nil)
250    
251    (deftest /=.14
252      (let ((nums '(17 17.0s0 17.0f0 17.0d0 17.0l0
253                       #c(17.0s0 0.0s0) #c(17.0f0 0.0f0)
254                       #c(17.0d0 0.0d0) #c(17.0l0 0.0l0))))
255        (loop for x in nums
256              append
257              (loop for y in nums
258                    when (/= x y)
259                    collect (list x y))))
260      nil)
261    
262    (deftest /=.15
263      (let ((nums '(-17 -17.0s0 -17.0f0 -17.0d0 -17.0l0
264                        #c(-17.0s0 0.0s0) #c(-17.0f0 0.0f0)
265                        #c(-17.0d0 0.0d0) #c(-17.0l0 0.0l0))))
266        (loop for x in nums
267              append
268              (loop for y in nums
269                    when (/= x y)
270                    collect (list x y))))
271      nil)
272    
273    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
274    
275    (deftest <.1
276      (let ((a 0) (b 1)) (notnot-mv (< a b)))
277      t)
278    
279    (deftest <.2
280      (let ((a 0) (b 0)) (notnot-mv (< a b)))
281      nil)
282    
283    (deftest <.3
284      (let ((a 1) (b 0)) (notnot-mv (< a b)))
285      nil)
286    
287    (defparameter *number-less-tests*
288      (let* ((n (- most-positive-fixnum most-negative-fixnum))
289             (n2 (* 1000 n)))
290        (nconc
291         (loop for i = (+ (random n) most-negative-fixnum)
292               for i2 = (+ i (random most-positive-fixnum))
293               repeat 1000
294               nconc
295               (list (list i i2 t) (list i2 i nil)))
296         (loop for i = (random n2)
297               for i2 = (+ (random n2) i)
298               repeat 1000
299               nconc
300               (list (list i i2 t) (list i2 i nil)))
301         (loop for x in *universe*
302               when (integerp x)
303               nconc (list (list x (1+ x) t)
304                           (list (1+ x) x nil)))
305         (loop for x in *universe*
306               when (realp x)
307               collect (list x x nil))
308    
309         (loop for x in *universe*
310               when (and (realp x) (>= x 1))
311               nconc
312               (loop for epsilon in (list short-float-epsilon
313                                          single-float-epsilon
314                                          double-float-epsilon
315                                          long-float-epsilon)
316                     for bound in (list most-positive-short-float
317                                        most-positive-single-float
318                                        most-positive-double-float
319                                        most-positive-long-float)
320                     for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
321                     when (<= x bound)
322                     nconc
323                     (let* ((y (float x one))
324                            (z (* y (- one (* 2 epsilon)))))
325                       (list (list y z nil)
326                             (list z y t)))))
327         (loop for x in *universe*
328               when (and (realp x) (<= x -1))
329               nconc
330               (loop for epsilon in (list short-float-epsilon
331                                          single-float-epsilon
332                                          double-float-epsilon
333                                          long-float-epsilon)
334                     for bound in (list most-negative-short-float
335                                        most-negative-single-float
336                                        most-negative-double-float
337                                        most-negative-long-float)
338                     for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
339                     when (>= x bound)
340                     nconc
341                     (let* ((y (float x one))
342                            (z (* y (- one (* 2 epsilon)))))
343                       (list (list y z t)
344                             (list z y nil)))))
345         (loop for x in *universe*
346               when (and (realp x) (< -1 x 1))
347               nconc
348               (loop for epsilon in (list short-float-epsilon
349                                          single-float-epsilon
350                                          double-float-epsilon
351                                          long-float-epsilon)
352                     for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
353                     nconc
354                     (let* ((y (float x one))
355                            (z1 (+ y epsilon))
356                            (z2 (- y epsilon)))
357                       (list (list y z1 t)
358                             (list z1 y nil)
359                             (list y z2 nil)
360                             (list z2 y t)))))
361         )))
362    
363    
364    (deftest <.4
365      (loop for (x y result . rest) in *number-less-tests*
366            unless (if (< x y) result (not result))
367            collect (list* x y result rest))
368      nil)
369    
370    (deftest <.5
371      (loop for x in *universe*
372            when (and (typep x 'real)
373                      (not (< x)))
374            collect x)
375      nil)
376    
377    (deftest <.6
378      (let ((args (list 17))
379            (args2 nil))
380        (loop for i from 2 to (min 256 call-arguments-limit)
381              do (push 17 args)
382              do (push (- i) args2)
383              unless (and (not (apply #'< args))
384                          (apply #'< args2))
385              collect (list args args2)))
386      nil)
387    
388    (deftest <.7
389      (let* ((len (min 256 call-arguments-limit))
390             (args-proto (loop for i from 1 to len collect i)))
391        (loop for i from 1 below len
392              for args = (copy-list args-proto)
393              do (setf (elt args i) 0)
394              never (apply #'< args)))
395      t)
396    
397    ;;; Check that < is antisymmetric
398    (deftest <.8
399      (<.8-fn)
400      nil)
401    
402    ;;;  < is symmetric with >
403    (deftest <.9
404      (<.9-fn)
405      nil)
406    
407    ;;;  < is negation of >=
408    (deftest <.10
409      (<.10-fn)
410      nil)
411    
412    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
413    
414    (deftest <=.1
415      (let ((a 0) (b 1)) (notnot-mv (<= a b)))
416      t)
417    
418    (deftest <=.2
419      (let ((a 0) (b 0)) (notnot-mv (<= a b)))
420      t)
421    
422    (deftest <=.3
423      (let ((a 1) (b 0)) (notnot-mv (<= a b)))
424      nil)
425    
426    (defparameter *number-less-or-equal-tests*
427      (let* ((n (- most-positive-fixnum most-negative-fixnum))
428             (n2 (* 1000 n)))
429        (nconc
430         (loop for i = (+ (random n) most-negative-fixnum)
431               for i2 = (+ i (random most-positive-fixnum))
432               repeat 1000
433               nconc
434               (list (list i i2 t) (list i2 i nil)))
435         (loop for i = (random n2)
436               for i2 = (+ (random n2) i)
437               repeat 1000
438               nconc
439               (list (list i i2 t) (list i2 i nil)))
440         (loop for x in *universe*
441               when (integerp x)
442               nconc (list (list x (1+ x) t)
443                           (list (1+ x) x nil)))
444         (loop for x in *universe*
445               when (realp x)
446               collect (list x x t))
447    
448         (loop for x in *universe*
449               when (and (realp x) (>= x 1))
450               nconc
451               (loop for epsilon in (list short-float-epsilon
452                                          single-float-epsilon
453                                          double-float-epsilon
454                                          long-float-epsilon)
455                     for bound in (list most-positive-short-float
456                                        most-positive-single-float
457                                        most-positive-double-float
458                                        most-positive-long-float)
459                     for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
460                     when (<= x bound)
461                     nconc
462                     (let* ((y (float x one))
463                            (z (* y (- one (* 2 epsilon)))))
464                       (list (list y z nil)
465                             (list z y t)))))
466         (loop for x in *universe*
467               when (and (realp x) (<= x -1))
468               nconc
469               (loop for epsilon in (list short-float-epsilon
470                                          single-float-epsilon
471                                          double-float-epsilon
472                                          long-float-epsilon)
473                     for bound in (list most-negative-short-float
474                                        most-negative-single-float
475                                        most-negative-double-float
476                                        most-negative-long-float)
477                     for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
478                     when (>= x bound)
479                     nconc
480                     (let* ((y (float x one))
481                            (z (* y (- one (* 2 epsilon)))))
482                       (list (list y z t)
483                             (list z y nil)))))
484         (loop for x in *universe*
485               when (and (realp x) (< -1 x 1))
486               nconc
487               (loop for epsilon in (list short-float-epsilon
488                                          single-float-epsilon
489                                          double-float-epsilon
490                                          long-float-epsilon)
491                     for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
492                     nconc
493                     (let* ((y (float x one))
494                            (z1 (+ y epsilon))
495                            (z2 (- y epsilon)))
496                       (list (list y z1 t)
497                             (list z1 y nil)
498                             (list y z2 nil)
499                             (list z2 y t)))))
500         )))
501    
502    (deftest <=.4
503      (loop for (x y result . rest) in *number-less-or-equal-tests*
504            unless (if (<= x y) result (not result))
505            collect (list* x y result rest))
506      nil)
507    
508    (deftest <=.5
509      (loop for x in *universe*
510            when (and (typep x 'real)
511                      (not (<= x)))
512            collect x)
513      nil)
514    
515    (deftest <=.6
516      (let ((args (list 17))
517            (args2 nil)
518            (args3 (list 0)))
519        (loop for i from 2 to (min 256 call-arguments-limit)
520              do (push 17 args)
521              do (push (- i) args2)
522              do (push i args3)
523              unless (and (apply #'<= args)
524                          (apply #'<= args2)
525                          (not (apply #'<= args3)))
526              collect (list args args2 args3)))
527      nil)
528    
529    (deftest <=.7
530      (let* ((len (min 256 call-arguments-limit))
531             (args-proto (loop for i from 1 to len collect i)))
532        (loop for i from 1 below len
533              for args = (copy-list args-proto)
534              do (setf (elt args i) 0)
535              never (apply #'<= args)))
536      t)
537    
538    ;;; Check that <= is symmetric with >=
539    (deftest <=.8
540      (<=.8-fn)
541      nil)
542    
543    ;;; Check that <= is equivalent to (or < =)
544    (deftest <=.9
545      (<=.9-fn)
546      nil)
547    
548    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
549    
550    (deftest >.1
551      (let ((a 0) (b 1)) (notnot-mv (> a b)))
552      nil)
553    
554    (deftest >.2
555      (let ((a 0) (b 0)) (notnot-mv (> a b)))
556      nil)
557    
558    (deftest >.3
559      (let ((a 1) (b 0)) (notnot-mv (> a b)))
560      t)
561    
562    (deftest >.4
563      (loop for (x y result . rest) in *number-less-tests*
564            unless (if (> y x) result (not result))
565            collect (list* y x result rest))
566      nil)
567    
568    (deftest >.5
569      (loop for x in *universe*
570            when (and (typep x 'real)
571                      (not (> x)))
572            collect x)
573      nil)
574    
575    (deftest >.6
576      (let ((args (list 17))
577            (args2 nil))
578        (loop for i from 2 to (min 256 call-arguments-limit)
579              do (push 17 args)
580              do (push i args2)
581              unless (and (not (apply #'> args))
582                          (apply #'> args2))
583              collect (list args args2)))
584      nil)
585    
586    (deftest >.7
587      (let* ((len (min 256 call-arguments-limit))
588             (args-proto (loop for i from 1 to len collect i)))
589        (loop for i from 1 below len
590              for args = (copy-list args-proto)
591              do (setf (elt args i) 0)
592              never (apply #'> args)))
593      t)
594    
595    ;;; > is negation of <=
596    (deftest >.8
597      (>.8-fn)
598      nil)
599    
600    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
601    
602    (deftest >=.1
603      (let ((a 0) (b 1)) (notnot-mv (>= a b)))
604      nil)
605    
606    (deftest >=.2
607      (let ((a 0) (b 0)) (notnot-mv (>= a b)))
608      t)
609    
610    (deftest >=.3
611      (let ((a 1) (b 0)) (notnot-mv (>= a b)))
612      t)
613    
614    (deftest >=.4
615      (loop for (x y result . rest) in *number-less-or-equal-tests*
616            unless (if (>= y x) result (not result))
617            collect (list* y x result rest))
618      nil)
619    
620    (deftest >=.5
621      (loop for x in *universe*
622            when (and (typep x 'real)
623                      (not (>= x)))
624            collect x)
625      nil)
626    
627    (deftest >=.6
628      (let ((args (list 17))
629            (args2 (list 0))
630            (args3 nil))
631        (loop for i from 2 to (min 256 call-arguments-limit)
632              do (push 17 args)
633              do (push (- i) args2)
634              do (push i args3)
635              unless (and (apply #'>= args)
636                          (not (apply #'>= args2))
637                          (apply #'>= args3))
638              collect (list args args2 args3)))
639      nil)
640    
641    (deftest >=.7
642      (let* ((len (min 256 call-arguments-limit))
643             (args-proto (loop for i from 1 to len collect i)))
644        (loop for i from 1 below len
645              for args = (copy-list args-proto)
646              do (setf (elt args i) 0)
647              never (apply #'>= args)))
648      t)
649    
650    ;;; Check that >= is equivalent to (or > =)
651    (deftest >=.8
652      (>=.8-fn)
653      nil)
654    
655    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
656    
657    ;;; Comparison of rationals
658    
659    (deftest compare-rationals.1
660      (compare-random-rationals 60000 30000 10000)
661      nil)
662    
663    (deftest compare-rationals.2
664      (compare-random-rationals 600000 300000 10000)
665      nil)
666    
667    (deftest compare-rationals.3
668      (compare-random-rationals 6000000 3000000 10000)
669      nil)
670    
671    (deftest compare-rationals.4
672      (compare-random-rationals 6000000000 3000000000 10000)
673      nil)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26