divide.lsp 5.8 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Aug 31 20:20:15 2003
;;;; Contains: Tests of the / function

6

7

8 9


10 11

(deftest /.error.1
12 13
  (signals-error (/) program-error)
  t)
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47

(deftest /.error.2
  (divide-by-zero-test 0))

(deftest /.error.3
  (divide-by-zero-test 1 0))

(deftest /.error.4
  (divide-by-zero-test 17 10 0 11))

(deftest /.error.5
  (divide-by-zero-test 0.0s0))

(deftest /.error.6
  (divide-by-zero-test 0.0f0))

(deftest /.error.7
  (divide-by-zero-test 0.0d0))

(deftest /.error.8
  (divide-by-zero-test 0.0l0))

;;;;;;;;;;

(deftest /.1
  (/ 1)
  1)

(deftest /.2
  (/ -1)
  -1)

(deftest /.3
  (loop for i = (random-fixnum)
sds's avatar
sds committed
48 49 50 51 52 53 54 55 56 57
        repeat 1000
        unless (or (zerop i)
                   (let ((q1 (/ i))
                         (q2 (/ 1 i)))
                     (and (rationalp q1)
                          (eql (denominator q1) (abs i))
                          (eql (numerator q1) (signum i))
                          (eql q1 q2)
                          (eql (* q1 i) 1))))
        collect i)
58 59 60 61
  nil)

(deftest /.4
  (loop for i = (random-from-interval 1000000 1)
sds's avatar
sds committed
62 63 64 65 66 67 68 69 70 71 72 73 74
        for j = (random-from-interval 1000000 1)
        for g = (gcd i j)
        for q = (/ i j)
        for q2 = (/ j)
        repeat 1000
        unless (and (integerp g)
                    (zerop (mod i g))
                    (zerop (mod j g))
                    (eql (numerator q) (/ i g))
                    (eql (denominator q) (/ j g))
                    (eql (/ q) (/ j i))
                    (eql q (* i q2)))
        collect (list i j q))
75 76 77 78
  nil)

(deftest /.5
  (loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20)
sds's avatar
sds committed
79 80 81 82 83 84 85
        nconc
        (loop for i = (1+ (random bound))
              for r1 = (/ i)
              for r2 = (/ 1 i)
              repeat 1000
              unless (eql r1 r2)
              collect (list i r1 r2)))
86 87 88 89 90
  nil)

;; Complex division
(deftest /.6
  (loop for i1 = (random-fixnum)
sds's avatar
sds committed
91 92 93 94 95 96
        for i = (if (zerop i1) 1 i1)
        for c = (complex 0 i)
        for r = (/ c)
        repeat 1000
        unless (eql r (complex 0 (- (/ i))))
        collect (list i c r))
97 98
  nil)

pfdietz's avatar
pfdietz committed
99
#|
100 101
(deftest /.7
  (loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20)
sds's avatar
sds committed
102 103 104 105 106 107 108
        nconc
        (loop for i = (1+ (random bound))
              for c = (complex 0 i)
              for r = (/ c)
              repeat 1000
              unless (= r (complex 0 (- (/ i))))
              collect (list i c r (complex 0 (- (/ i))))))
109
  nil)
pfdietz's avatar
pfdietz committed
110
|#
111 112 113

(deftest /.8
  (loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20)
sds's avatar
sds committed
114 115 116 117 118 119 120 121 122
        for one = (float 1.0 bound)
        for zero = (float 0.0 bound)
        nconc
        (loop for i = (1+ (random bound))
              for c = (complex i zero)
              for q = (/ c c)
              repeat 100
              unless (eql q (complex one zero))
              collect (list i c q (complex one zero))))
123 124 125 126 127
  nil)


(deftest /.9
  (loop for a = (random-fixnum)
sds's avatar
sds committed
128 129 130 131 132 133 134 135 136 137 138
        for b = (random-fixnum)
        for m = (+ (* a a) (* b b))
        repeat 1000
        unless
        (or (zerop m)
            (let* ((q (/ (complex a b)))
                   (c (/ a m))
                   (d (/ (- b) m))
                   (expected (complex c d)))
              (eql q expected)))
        collect (list a b (/ (complex a b))))
139 140 141 142 143
  nil)

(deftest /.10
  (let ((bound 1000000000000000000))
    (loop for a = (random-from-interval bound)
sds's avatar
sds committed
144 145 146 147 148 149 150 151 152 153 154
          for b = (random-from-interval bound)
          for m = (+ (* a a) (* b b))
          repeat 1000
          unless
          (or (zerop m)
              (let* ((q (/ (complex a b)))
                     (c (/ a m))
                     (d (/ (- b) m))
                     (expected (complex c d)))
                (eql q expected)))
          collect (list a b (/ (complex a b)))))
155 156 157 158
  nil)

(deftest /.11
  (loop for a = (random-fixnum)
sds's avatar
sds committed
159 160 161 162 163 164 165 166 167 168 169 170
        for b = (random-fixnum)
        for n = (complex (random-fixnum) (random-fixnum))
        for m = (+ (* a a) (* b b))
        repeat 1000
        unless
        (or (zerop m)
            (let* ((q (/ n (complex a b)))
                   (c (/ a m))
                   (d (/ (- b) m))
                   (expected (* n (complex c d))))
              (eql q expected)))
        collect (list a b (/ n (complex a b))))
171 172 173 174 175 176
  nil)

;;; More floating point tests

(deftest /.12
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205
        for lower in (mapcar
                     #'rational-safely
                     (list
                      least-positive-short-float least-positive-single-float
                      least-positive-double-float least-positive-long-float))
        for upper in (mapcar
                     #'rational-safely
                     (list
                      most-positive-short-float most-positive-single-float
                      most-positive-double-float most-positive-long-float))
        for one = (coerce 1 type)
        for radix = (float-radix one)
        nconc
        (loop
         for i from 1
         for rpos = radix then (* rpos radix)
         for rneg = (/ radix) then (/ rneg radix)
         while (<= lower rneg rpos upper)
         unless
         (let ((frpos (float rpos one))
               (frneg (float rneg one)))
           (and (eql (/ frpos) (/ one frpos))
                (eql (/ frpos) (/ 1.0s0 frpos))
                (eql (/ frpos) (/ 1 frpos))
                (eql (/ frpos) frneg)
                (eql (/ frneg) (/ 1.0s0 frneg))
                (eql (/ frneg) (/ 1 frneg))
                (eql (/ frneg) frpos)))
         collect (list i rpos rneg (float rpos one) (float rneg one))))
206
  nil)
207 208 209 210 211 212

;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest /.13
  (macrolet ((%m (z) z))
sds's avatar
sds committed
213 214 215 216
            (values
             (/ (expand-in-current-env (%m 1/2)))
             (/ (expand-in-current-env (%m 2)) 3)
             (/ 5 (expand-in-current-env (%m 7)))))
217
  2 2/3 5/7)