source: trunk/source/tests/ansi-tests/minus.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 4.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Aug 31 11:15:14 2003
4;;;; Contains: Tests of the - function
5
6(in-package :cl-test)
7
8(compile-and-load "numbers-aux.lsp")
9
10(deftest minus.error.1
11  (signals-error (-) program-error)
12  t)
13
14;;; Unary minus tests
15(deftest minus.1
16  (loop for x in *numbers*
17        unless (eql (- (- x)) x)
18        collect x)
19  nil)
20
21(deftest minus.2
22  (locally
23   (declare (notinline -))
24   (loop for x in *numbers*
25         unless (eql (- (- x)) x)
26         collect x))
27  nil)
28
29(deftest minus.3
30  (loop for x in *reals*
31        when (and (integerp x)
32                  (not (eql (- x) (- 0 x))))
33        collect x)
34  nil)
35
36(deftest minus.4
37  (loop for x in *reals*
38        for neg = (- x)
39        when (and (floatp x)
40                  (not (zerop x))
41                  (not (eql neg (- 0.0s0 x)))
42                  (eql (float 1.0s0 x)
43                       (float 1.0s0 neg)))
44        collect x)
45  nil)
46
47(deftest minus.5
48  (loop for x in *numbers*
49        when (and (complexp x)
50                  (rationalp (realpart x))
51                  (not (eql (- x) (- 0 x))))
52        collect x)
53  nil)
54
55(deftest minus.6
56  (loop for x in *numbers*
57        for neg = (- x)
58        when (and (complexp x)
59                  (floatp (realpart x))
60                  (eql (float 1.0s0 (realpart x))
61                       (float 1.0s0 (realpart neg)))
62                  (or (/= neg (- 0 x))
63                      (and (not (zerop (realpart x)))
64                           (not (eqlzt neg (- 0 x))))))
65        collect x)
66  nil)
67
68(deftest minus.7
69  (let ((upper-bound most-positive-fixnum)
70        (lower-bound most-negative-fixnum))
71    (loop
72     for x = (+ (random (- upper-bound lower-bound)) lower-bound)
73     for neg = (- x)
74     repeat 1000
75     unless (and (integerp neg)
76                 (eql (abs x) (abs neg))
77                 (if (> x 0) (< neg 0) (>= neg 0))
78                 (zerop (+ x neg))
79                 (eql x (- neg)))
80     collect x))
81  nil)
82
83(deftest minus.8
84  (let ((upper-bound (ash 1 1000))
85        (lower-bound (- (ash 1 1000))))
86    (loop
87     for x = (+ (random (- upper-bound lower-bound)) lower-bound)
88     for neg = (- x)
89     repeat 1000
90     unless (and (integerp neg)
91                 (eql (abs x) (abs neg))
92                 (if (> x 0) (< neg 0) (>= neg 0))
93                 (zerop (+ x neg))
94                 (eql x (- neg)))
95     collect x))
96  nil)
97
98;;; Test that explicit calls to macroexpand in subforms
99;;; are done in the correct environment
100
101(deftest minus.9
102  (macrolet ((%m (z) z)) (- (expand-in-current-env (%m 1))))
103  -1)
104
105;;; Binary minus tests
106
107(deftest subtract.1
108  (loop
109   for x = (random-fixnum)
110   for y = (random-fixnum)
111   repeat 1000
112   unless (and (eql (+ x (- y)) (- x y))
113               (eql (+ 1 x (- y)) (- x (1- y)))
114               (eql (+ -1 x (- y)) (- x (1+ y))))
115   collect (list x y))
116  nil)
117
118(deftest subtract.2
119  (let ((bound (ash 1 1000)))
120    (loop
121     for x = (random-from-interval bound (- bound))
122     for y = (random-from-interval bound (- bound))
123     repeat 1000
124     unless  (and (eql (+ x (- y)) (- x y))
125               (eql (+ 1 x (- y)) (- x (1- y)))
126               (eql (+ -1 x (- y)) (- x (1+ y))))
127     collect (list x y)))
128  nil)
129
130(deftest subtract.3
131  (let ((args nil))
132    (loop for i from 1 below (min 256 (1- call-arguments-limit))
133          do (push 1 args)
134          always (eql (apply #'- 1000 args) (- 1000 i))))
135  t)
136
137;;; Float contagion
138
139(deftest subtract.4
140  (loop
141   for type1 in '(short-float single-float double-float long-float)
142   for bits1 in '(13 24 50 50)
143   for bound1 = (ash 1 (- bits1 2))
144   for c1 from 1
145   nconc
146   (loop for type2 in '(short-float single-float double-float long-float)
147         for bits2 in '(13 24 50 50)
148         for bound2 = (ash 1 (- bits2 2))
149         for c2 from 1
150         nconc
151         (loop
152          for i = (random-from-interval bound1)
153          for x = (coerce i type1)
154          for j = (random-from-interval bound2)
155          for y = (coerce j type2)
156          for idiff1 = (- i j)
157          for idiff2 = (- j i)
158          for diff1 = (- x y)
159          for diff2 = (- y x)
160          repeat 1000
161          unless (or (zerop idiff1)
162                     (and (eql idiff1 (- idiff2))
163                          (eql diff1 (- diff2))
164                          (if (<= c1 c2)
165                              (eql (float diff1 y) diff1)
166                            (eql (float diff1 x) diff1))
167                          (eql (float idiff1 diff1) diff1)))
168          collect (list i x j y idiff1 idiff2 diff1 diff2))))
169  nil)
170
171;;; Complex subtraction
172
173(deftest subtract.5
174  (loop for i = (random-fixnum)
175        for ci = (complex i (+ i 100))
176        for j = (random-fixnum)
177        for cj = (complex j (- j 200))
178        for diff = (- ci cj)
179        repeat 1000
180        unless (eql diff (complex (- i j) (+ (- i j) 300)))
181        collect (list i ci j cj (- ci cj)))
182  nil)
183
184;;; Test that explicit calls to macroexpand in subforms
185;;; are done in the correct environment
186
187(deftest subtract.6
188  (macrolet ((%m (z) z))
189            (values
190             (- (expand-in-current-env (%m 2)) 1)
191             (- 17 (expand-in-current-env (%m 5)))
192             (- 1/2 (expand-in-current-env (%m 1/6))
193                (expand-in-current-env (%m 0)))))
194  1 12 1/3)
Note: See TracBrowser for help on using the repository browser.