source: trunk/source/tests/ansi-tests/sqrt.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.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Sep  6 10:54:17 2003
4;;;; Contains: Tests of SQRT
5
6(in-package :cl-test)
7
8(compile-and-load "numbers-aux.lsp")
9
10(deftest sqrt.error.1
11  (signals-error (sqrt) program-error)
12  t)
13
14(deftest sqrt.error.2
15  (signals-error (sqrt 0 nil) program-error)
16  t)
17
18(deftest sqrt.error.3
19  (check-type-error #'sqrt #'numberp)
20  nil)
21
22(deftest sqrt.1
23  (let ((s (sqrt 0)))
24    (and (realp s)
25         (=t s 0)))
26  t)
27
28(deftest sqrt.2
29  (let ((s (sqrt 1)))
30    (and (realp s)
31         (=t s 1)))
32  t)
33
34(deftest sqrt.3
35  (loop for x in '(0.0s0 1.0s0 0.0f0 1.0f0 0.0d0 1.0d0 0.0l0 1.0l0)
36        for s = (sqrt x)
37        unless (eql s x)
38        collect (list x s))
39  nil)
40
41(deftest sqrt.4
42  (loop for x in '(0.0s0 1.0s0 0.0f0 1.0f0 0.0d0 1.0d0 0.0l0 1.0l0)
43        for c = (complex x 0)
44        for s = (sqrt c)
45        unless (eql s c)
46        collect (list x c s))
47  nil)
48
49(deftest sqrt.5
50  (loop for x in '(-1.0s0 -1.0f0 -1.0d0 -1.0l0)
51        for s = (sqrt x)
52        unless (eql s (complex 0 (- x)))
53        collect (list x s))
54  nil)
55
56;;; (deftest sqrt.6
57;;;  (let ((result (sqrt (ash 1 10000))))
58;;;    (if (integerp result)
59;;;     (=t result (ash 1 5000))
60;;;      (=t result (float (ash 1 5000) result))))
61;;;  t)
62
63(deftest sqrt.7
64  (let ((result (sqrt -1)))
65    (or (eqlt result #c(0 1))
66        (eqlt result #c(0.0 1.0))))
67  t)
68
69(deftest sqrt.8
70  (loop for x in *floats*
71        for s = (sqrt x)
72        unless (cond
73                ((zerop x) (=t x 0))
74                ((plusp x) (and (eqlt (float s x) s)
75                                (eqlt (float x s) x)))
76                (t (complexp s)))
77        collect (list x s))
78  nil)
79
80(deftest sqrt.9
81  (let ((upper (rational most-positive-double-float))
82        (lower (rational most-negative-double-float)))
83    (loop for x = (random-fixnum)
84          repeat 1000
85          unless (or (< x lower)
86                     (> x upper)
87                     (let ((s (sqrt x)))
88                       (or (and (rationalp s)
89                                (>= s 0)
90                                (eql (* s s) x))
91                           (and (floatp s) (>= x 0))
92                           (and (complexp s)
93                                (zerop (realpart s))
94                                (> (imagpart s) 0)
95                                (< x 0)))))
96          collect (list x (sqrt x))))
97  nil)
98
99(deftest sqrt.10
100  (loop for x from 1 to 1000
101        for x2 = (* x x)
102        for s = (sqrt x2)
103        unless (if (rationalp s) (eql x s)
104                 (and (typep s 'single-float)
105                      (= x s)))
106        collect (list x s))
107  nil)
108
109(deftest sqrt.11
110  (loop for x from 1 to 1000
111        for x2 = (* x x)
112        for s = (sqrt (- x2))
113        unless (and (complexp s)
114                    (zerop (realpart s))
115                    (let ((i (imagpart s)))
116                      (if (rationalp i)
117                          (eql i x)
118                        (= i x))))
119        collect (list x s))
120  nil)
121
122;;; Tests of the branch cut
123(deftest sqrt.12
124  (loop for xr = (random-fixnum)
125        for xi = (random-fixnum)
126        for c = (complex xr xi)
127        for s = (sqrt c)
128        repeat 1000
129        unless (or (> (realpart s) 0)
130                   (and (= (realpart s) 0)
131                        (>= (imagpart s) 0)))
132        collect (list c s))
133  nil)
134
135(deftest sqrt.13
136  (loop for xr = (random-from-interval 1.0f6 -1.0f6)
137        for xi = (random-from-interval 1.0f6 -1.0f6)
138        for c = (complex xr xi)
139        for s = (sqrt c)
140        repeat 1000
141        unless (or (> (realpart s) 0)
142                   (and (= (realpart s) 0)
143                        (>= (imagpart s) 0)))
144        collect (list c s))
145  nil)
146                       
147(deftest sqrt.14
148  (loop for xr = (random-from-interval 1.0s3 -1.0s3)
149        for xi = (random-from-interval 1.0s3 -1.0s3)
150        for c = (complex xr xi)
151        for s = (sqrt c)
152        repeat 1000
153        unless (or (> (realpart s) 0)
154                   (and (= (realpart s) 0)
155                        (>= (imagpart s) 0)))
156        collect (list c s))
157  nil)
158                       
159(deftest sqrt.15
160  (loop for xr = (random-from-interval 1.0d7 -1.0d7)
161        for xi = (random-from-interval 1.0d7 -1.0d7)
162        for c = (complex xr xi)
163        for s = (sqrt c)
164        repeat 1000
165        unless (or (> (realpart s) 0)
166                   (and (= (realpart s) 0)
167                        (>= (imagpart s) 0)))
168        collect (list c s))
169  nil)
170
171(deftest sqrt.16
172  (loop for xr = (random-from-interval 1.0l9 -1.0l9)
173        for xi = (random-from-interval 1.0l9 -1.0l9)
174        for c = (complex xr xi)
175        for s = (sqrt c)
176        repeat 1000
177        unless (or (> (realpart s) 0)
178                   (and (= (realpart s) 0)
179                        (>= (imagpart s) 0)))
180        collect (list c s))
181  nil)
182
183(deftest sqrt.17
184  (let ((b1 (find-largest-exactly-floatable-integer most-positive-fixnum)))
185    (loop for i = (random-from-interval (* b1 b1) 0)
186          repeat 1000
187          unless (>= (sqrt i) (isqrt i))
188          collect i))
189  nil)
190
191(deftest sqrt.18
192  (loop for x = (random-from-interval 1.0f6 0.0f0)
193        repeat 1000
194        unless (>= (sqrt x) (isqrt (floor x)))
195        collect x)
196  nil)
197
198(deftest sqrt.19
199  (loop for x in '(0.0s0 0.0f0 0.0d0 0.0l0)
200        for s = (sqrt x)
201        unless (= s x)
202        collect (list x s))
203  nil)
204
Note: See TracBrowser for help on using the repository browser.