minus.lsp 3.93 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Aug 31 11:15:14 2003
;;;; Contains: Tests of the - function

(in-package :cl-test)

(compile-and-load "numbers-aux.lsp")

(deftest minus.error.1
  (classify-error (-))
  program-error)

;;; Unary minus tests
(deftest minus.1
  (loop for x in *numbers*
	unless (eql (- (- x)) x)
	collect x)
  nil)

(deftest minus.2
  (locally
   (declare (notinline -))
   (loop for x in *numbers*
	 unless (eql (- (- x)) x)
	 collect x))
  nil)

(deftest minus.3
  (loop for x in *reals*
	when (and (integerp x)
		  (not (eql (- x) (- 0 x))))
	collect x)
  nil)

(deftest minus.4
  (loop for x in *reals*
	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)
  nil)

(deftest minus.5
  (loop for x in *numbers*
	when (and (complexp x)
		  (rationalp (realpart x))
		  (not (eql (- x) (- 0 x))))
	collect x)
  nil)

(deftest minus.6
  (loop for x in *numbers*
	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)))
64
			   (not (eqlzt neg (- 0 x))))))
65
66
67
68
69
70
71
72
73
	collect x)
  nil)

(deftest minus.7
  (let ((upper-bound most-positive-fixnum)
	(lower-bound most-negative-fixnum))
    (loop
     for x = (+ (random (- upper-bound lower-bound)) lower-bound)
     for neg = (- x)
74
     repeat 1000
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
     unless (and (integerp neg)	
		 (eql (abs x) (abs neg))
		 (if (> x 0) (< neg 0) (>= neg 0))
		 (zerop (+ x neg))
		 (eql x (- neg)))
     collect x))
  nil)

(deftest minus.8
  (let ((upper-bound (ash 1 1000))
	(lower-bound (- (ash 1 1000))))
    (loop
     for x = (+ (random (- upper-bound lower-bound)) lower-bound)
     for neg = (- x)
     repeat 1000
     unless (and (integerp neg)
		 (eql (abs x) (abs neg))
		 (if (> x 0) (< neg 0) (>= neg 0))
		 (zerop (+ x neg))
		 (eql x (- neg)))
     collect x))
  nil)

;;; Binary minus tests

(deftest subtract.1
  (loop
   for x = (random-fixnum)
   for y = (random-fixnum)
104
   repeat 1000
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
   unless (and (eql (+ x (- y)) (- x y))
	       (eql (+ 1 x (- y)) (- x (1- y)))
	       (eql (+ -1 x (- y)) (- x (1+ y))))
   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))
	       (eql (+ 1 x (- y)) (- x (1- y)))
	       (eql (+ -1 x (- y)) (- x (1+ y))))
     collect (list x y)))
  nil)

(deftest subtract.3
  (let ((args nil))
125
    (loop for i from 1 to (min 256 (1- call-arguments-limit))
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
	  do (push 1 args)
	  always (eql (apply #'- 1000 args) (- 1000 i))))
  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)
	 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)
153
	  repeat 1000
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
	  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))))
  nil)

;;; Complex subtraction

(deftest subtract.5
  (loop for i = (random-fixnum)
	for ci = (complex i (+ i 100))
	for j = (random-fixnum)
	for cj = (complex j (- j 200))
	for diff = (- ci cj)
172
	repeat 1000
173
174
175
	unless (eql diff (complex (- i j) (+ (- i j) 300)))
	collect (list i ci j cj (- ci cj)))
  nil)