source: trunk/source/tests/ansi-tests/divide.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: 4.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Aug 31 20:20:15 2003
4;;;; Contains: Tests of the / function
5
6(in-package :cl-test)
7
8(compile-and-load "numbers-aux.lsp")
9(compile-and-load "division-aux.lsp")
10
11(deftest /.error.1
12  (signals-error (/) program-error)
13  t)
14
15(deftest /.error.2
16  (divide-by-zero-test 0))
17
18(deftest /.error.3
19  (divide-by-zero-test 1 0))
20
21(deftest /.error.4
22  (divide-by-zero-test 17 10 0 11))
23
24(deftest /.error.5
25  (divide-by-zero-test 0.0s0))
26
27(deftest /.error.6
28  (divide-by-zero-test 0.0f0))
29
30(deftest /.error.7
31  (divide-by-zero-test 0.0d0))
32
33(deftest /.error.8
34  (divide-by-zero-test 0.0l0))
35
36;;;;;;;;;;
37
38(deftest /.1
39  (/ 1)
40  1)
41
42(deftest /.2
43  (/ -1)
44  -1)
45
46(deftest /.3
47  (loop for i = (random-fixnum)
48        repeat 1000
49        unless (or (zerop i)
50                   (let ((q1 (/ i))
51                         (q2 (/ 1 i)))
52                     (and (rationalp q1)
53                          (eql (denominator q1) (abs i))
54                          (eql (numerator q1) (signum i))
55                          (eql q1 q2)
56                          (eql (* q1 i) 1))))
57        collect i)
58  nil)
59
60(deftest /.4
61  (loop for i = (random-from-interval 1000000 1)
62        for j = (random-from-interval 1000000 1)
63        for g = (gcd i j)
64        for q = (/ i j)
65        for q2 = (/ j)
66        repeat 1000
67        unless (and (integerp g)
68                    (zerop (mod i g))
69                    (zerop (mod j g))
70                    (eql (numerator q) (/ i g))
71                    (eql (denominator q) (/ j g))
72                    (eql (/ q) (/ j i))
73                    (eql q (* i q2)))                   
74        collect (list i j q))
75  nil)
76
77(deftest /.5
78  (loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20)
79        nconc
80        (loop for i = (1+ (random bound))
81              for r1 = (/ i)
82              for r2 = (/ 1 i)
83              repeat 1000
84              unless (eql r1 r2)
85              collect (list i r1 r2)))
86  nil)
87
88;; Complex division
89(deftest /.6
90  (loop for i1 = (random-fixnum)
91        for i = (if (zerop i1) 1 i1)
92        for c = (complex 0 i)
93        for r = (/ c)
94        repeat 1000
95        unless (eql r (complex 0 (- (/ i))))
96        collect (list i c r))
97  nil)
98
99#|
100(deftest /.7
101  (loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20)
102        nconc
103        (loop for i = (1+ (random bound))
104              for c = (complex 0 i)
105              for r = (/ c)
106              repeat 1000
107              unless (= r (complex 0 (- (/ i))))
108              collect (list i c r (complex 0 (- (/ i))))))
109  nil)
110|#
111
112(deftest /.8
113  (loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20)
114        for one = (float 1.0 bound)
115        for zero = (float 0.0 bound)
116        nconc
117        (loop for i = (1+ (random bound))
118              for c = (complex i zero)
119              for q = (/ c c)
120              repeat 100
121              unless (eql q (complex one zero))
122              collect (list i c q (complex one zero))))
123  nil)
124
125
126(deftest /.9
127  (loop for a = (random-fixnum)
128        for b = (random-fixnum)
129        for m = (+ (* a a) (* b b))
130        repeat 1000
131        unless
132        (or (zerop m)
133            (let* ((q (/ (complex a b)))
134                   (c (/ a m))
135                   (d (/ (- b) m))
136                   (expected (complex c d)))
137              (eql q expected)))
138        collect (list a b (/ (complex a b))))
139  nil)
140
141(deftest /.10
142  (let ((bound 1000000000000000000))
143    (loop for a = (random-from-interval bound)
144          for b = (random-from-interval bound)
145          for m = (+ (* a a) (* b b))
146          repeat 1000
147          unless
148          (or (zerop m)
149              (let* ((q (/ (complex a b)))
150                     (c (/ a m))
151                     (d (/ (- b) m))
152                     (expected (complex c d)))
153                (eql q expected)))
154          collect (list a b (/ (complex a b)))))
155  nil)
156
157(deftest /.11
158  (loop for a = (random-fixnum)
159        for b = (random-fixnum)
160        for n = (complex (random-fixnum) (random-fixnum))
161        for m = (+ (* a a) (* b b))
162        repeat 1000
163        unless
164        (or (zerop m)
165            (let* ((q (/ n (complex a b)))
166                   (c (/ a m))
167                   (d (/ (- b) m))
168                   (expected (* n (complex c d))))
169              (eql q expected)))
170        collect (list a b (/ n (complex a b))))
171  nil)
172
173;;; More floating point tests
174
175(deftest /.12
176  (loop for type in '(short-float single-float double-float long-float)
177        for lower in (mapcar
178                     #'rational-safely
179                     (list
180                      least-positive-short-float least-positive-single-float
181                      least-positive-double-float least-positive-long-float))
182        for upper in (mapcar
183                     #'rational-safely
184                     (list
185                      most-positive-short-float most-positive-single-float
186                      most-positive-double-float most-positive-long-float))
187        for one = (coerce 1 type)
188        for radix = (float-radix one)
189        nconc
190        (loop
191         for i from 1
192         for rpos = radix then (* rpos radix)
193         for rneg = (/ radix) then (/ rneg radix)
194         while (<= lower rneg rpos upper)
195         unless
196         (let ((frpos (float rpos one))
197               (frneg (float rneg one)))
198           (and (eql (/ frpos) (/ one frpos))
199                (eql (/ frpos) (/ 1.0s0 frpos))
200                (eql (/ frpos) (/ 1 frpos))
201                (eql (/ frpos) frneg)
202                (eql (/ frneg) (/ 1.0s0 frneg))
203                (eql (/ frneg) (/ 1 frneg))
204                (eql (/ frneg) frpos)))
205         collect (list i rpos rneg (float rpos one) (float rneg one))))
206  nil)
207
208;;; Test that explicit calls to macroexpand in subforms
209;;; are done in the correct environment
210
211(deftest /.13
212  (macrolet ((%m (z) z))
213            (values
214             (/ (expand-in-current-env (%m 1/2)))
215             (/ (expand-in-current-env (%m 2)) 3)
216             (/ 5 (expand-in-current-env (%m 7)))))
217  2 2/3 5/7)
Note: See TracBrowser for help on using the repository browser.