minus.lsp 5.14 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Aug 31 11:15:14 2003
;;;; Contains: Tests of the - function

6

7

8

9 10

(deftest minus.error.1
11 12
  (signals-error (-) program-error)
  t)
13 14 15 16

;;; Unary minus tests
(deftest minus.1
  (loop for x in *numbers*
sds's avatar
sds committed
17 18
        unless (eql (- (- x)) x)
        collect x)
19 20 21 22 23 24
  nil)

(deftest minus.2
  (locally
   (declare (notinline -))
   (loop for x in *numbers*
sds's avatar
sds committed
25 26
         unless (eql (- (- x)) x)
         collect x))
27 28 29 30
  nil)

(deftest minus.3
  (loop for x in *reals*
sds's avatar
sds committed
31 32 33
        when (and (integerp x)
                  (not (eql (- x) (- 0 x))))
        collect x)
34 35 36 37
  nil)

(deftest minus.4
  (loop for x in *reals*
sds's avatar
sds committed
38 39 40 41 42 43 44
        for neg = (- x)
        when (and (floatp x)
                  (not (zerop x))
                  (not (eql neg (- 0.0s0 x)))
                  (eql (float 1.0s0 x)
                       (float 1.0s0 neg)))
        collect x)
45 46 47 48
  nil)

(deftest minus.5
  (loop for x in *numbers*
sds's avatar
sds committed
49 50 51 52
        when (and (complexp x)
                  (rationalp (realpart x))
                  (not (eql (- x) (- 0 x))))
        collect x)
53 54 55 56
  nil)

(deftest minus.6
  (loop for x in *numbers*
sds's avatar
sds committed
57 58 59 60 61 62 63 64 65
        for neg = (- x)
        when (and (complexp x)
                  (floatp (realpart x))
                  (eql (float 1.0s0 (realpart x))
                       (float 1.0s0 (realpart neg)))
                  (or (/= neg (- 0 x))
                      (and (not (zerop (realpart x)))
                           (not (eqlzt neg (- 0 x))))))
        collect x)
66 67 68 69
  nil)

(deftest minus.7
  (let ((upper-bound most-positive-fixnum)
sds's avatar
sds committed
70
        (lower-bound most-negative-fixnum))
71 72 73
    (loop
     for x = (+ (random (- upper-bound lower-bound)) lower-bound)
     for neg = (- x)
74
     repeat 1000
sds's avatar
sds committed
75 76 77 78 79
     unless (and (integerp neg)
                 (eql (abs x) (abs neg))
                 (if (> x 0) (< neg 0) (>= neg 0))
                 (zerop (+ x neg))
                 (eql x (- neg)))
80 81 82 83 84
     collect x))
  nil)

(deftest minus.8
  (let ((upper-bound (ash 1 1000))
sds's avatar
sds committed
85
        (lower-bound (- (ash 1 1000))))
86 87 88 89 90
    (loop
     for x = (+ (random (- upper-bound lower-bound)) lower-bound)
     for neg = (- x)
     repeat 1000
     unless (and (integerp neg)
sds's avatar
sds committed
91 92 93 94
                 (eql (abs x) (abs neg))
                 (if (> x 0) (< neg 0) (>= neg 0))
                 (zerop (+ x neg))
                 (eql x (- neg)))
95 96 97
     collect x))
  nil)

98 99 100 101 102 103 104
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest minus.9
  (macrolet ((%m (z) z)) (- (expand-in-current-env (%m 1))))
  -1)

105 106 107 108 109 110
;;; Binary minus tests

(deftest subtract.1
  (loop
   for x = (random-fixnum)
   for y = (random-fixnum)
111
   repeat 1000
112
   unless (and (eql (+ x (- y)) (- x y))
sds's avatar
sds committed
113 114
               (eql (+ 1 x (- y)) (- x (1- y)))
               (eql (+ -1 x (- y)) (- x (1+ y))))
115 116 117 118 119 120 121 122 123 124
   collect (list x y))
  nil)

(deftest subtract.2
  (let ((bound (ash 1 1000)))
    (loop
     for x = (random-from-interval bound (- bound))
     for y = (random-from-interval bound (- bound))
     repeat 1000
     unless  (and (eql (+ x (- y)) (- x y))
sds's avatar
sds committed
125 126
               (eql (+ 1 x (- y)) (- x (1- y)))
               (eql (+ -1 x (- y)) (- x (1+ y))))
127 128 129 130 131
     collect (list x y)))
  nil)

(deftest subtract.3
  (let ((args nil))
132
    (loop for i from 1 below (min 256 (1- call-arguments-limit))
sds's avatar
sds committed
133 134
          do (push 1 args)
          always (eql (apply #'- 1000 args) (- 1000 i))))
135 136 137 138 139 140 141 142 143 144 145 146
  t)

;;; Float contagion

(deftest subtract.4
  (loop
   for type1 in '(short-float single-float double-float long-float)
   for bits1 in '(13 24 50 50)
   for bound1 = (ash 1 (- bits1 2))
   for c1 from 1
   nconc
   (loop for type2 in '(short-float single-float double-float long-float)
sds's avatar
sds committed
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168
         for bits2 in '(13 24 50 50)
         for bound2 = (ash 1 (- bits2 2))
         for c2 from 1
         nconc
         (loop
          for i = (random-from-interval bound1)
          for x = (coerce i type1)
          for j = (random-from-interval bound2)
          for y = (coerce j type2)
          for idiff1 = (- i j)
          for idiff2 = (- j i)
          for diff1 = (- x y)
          for diff2 = (- y x)
          repeat 1000
          unless (or (zerop idiff1)
                     (and (eql idiff1 (- idiff2))
                          (eql diff1 (- diff2))
                          (if (<= c1 c2)
                              (eql (float diff1 y) diff1)
                            (eql (float diff1 x) diff1))
                          (eql (float idiff1 diff1) diff1)))
          collect (list i x j y idiff1 idiff2 diff1 diff2))))
169 170 171 172 173 174
  nil)

;;; Complex subtraction

(deftest subtract.5
  (loop for i = (random-fixnum)
sds's avatar
sds committed
175 176 177 178 179 180 181
        for ci = (complex i (+ i 100))
        for j = (random-fixnum)
        for cj = (complex j (- j 200))
        for diff = (- ci cj)
        repeat 1000
        unless (eql diff (complex (- i j) (+ (- i j) 300)))
        collect (list i ci j cj (- ci cj)))
182
  nil)
183 184 185 186 187 188

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

(deftest subtract.6
  (macrolet ((%m (z) z))
sds's avatar
sds committed
189 190 191 192 193
            (values
             (- (expand-in-current-env (%m 2)) 1)
             (- 17 (expand-in-current-env (%m 5)))
             (- 1/2 (expand-in-current-env (%m 1/6))
                (expand-in-current-env (%m 0)))))
194
  1 12 1/3)