~ chicken-core (master) /tests/numbers-test.scm
Trap1;;;; numbers-test.scm23(include "test.scm")45(import (chicken bitwise)6 (chicken fixnum)7 (chicken flonum)8 (chicken format)9 (chicken platform)10 (chicken time))1112(import (only (scheme base) exact-integer? exact-integer-sqrt))1314;; The default "comparator" doesn't know how to deal with extended number types15(current-test-comparator16 (lambda (exp act)17 (or (equal? exp act)18 (if (or (and (cplxnum? exp) (number? act))19 (and (cplxnum? act) (number? exp)))20 (and (< (abs (real-part (- exp act)))21 (current-test-epsilon))22 (< (abs (imag-part (- exp act)))23 (current-test-epsilon)))24 (and (number? exp)25 (inexact? exp)26 (< (abs (- 1 (abs (if (zero? act) (+ 1 exp) (/ exp act)))))27 (current-test-epsilon)))))))2829(test-begin "numbers")3031(current-test-epsilon 0) ;; We want exact comparisons3233(define max-fix most-positive-fixnum)34(define min-fix most-negative-fixnum)35;; The minimal bignum in the sense that any smaller makes it a fixnum36(define min-big (+ most-positive-fixnum 1))3738(define 64-bits? (feature? #:64bit))3940(define (show x)41 (print (and x (number->string x)))42 x)4344;(set-gc-report! #t)4546(define max2 (+ max-fix max-fix))4748(define b1 (+ 22 max2)) ; 2147483668 or 46116860184273879284950(define c1 (make-rectangular 33 44))51(define c2 (make-rectangular -1.2 44))52(define cinf (make-rectangular +inf.0 1.0))5354(define b2 (- min-fix 22))55(define r1 (/ 33 44))56(define r2 (/ 1000 44))5758;; Found with the pi-ratios benchmark (find-pi 10 20 50)59(define pi 3.14159265358979323881089001960817518141234854964894)60(define ratpi 314159265358979323881089001960817518141234854964894/100000000000000000000000000000000000000000000000000)6162(test-group "basic constructors"63 (test-assert "some bignum (twice maxint)" (show max2))64 (test-assert "some other bignum (2147483668 or 9223372036854775828)" (show b1))65 (test-assert "negative bignum" (show b2))66 (test-assert "exact complex" (show c1))67 (test-assert "inexact complex" (show c2))68 (test-assert "rational" (show r1))69)7071(test-group "addition"72 (test-equal "+: no arguments" (+) 0)73 (test-equal "+: single argument" (+ 33) 33)74 (test-equal "+: adding fixnums" (+ 33 44) 77)75 (test-equal "+: adding fixnums (2nd negative)" (+ 33 -44) -11)76 (test-equal "+: adding fix/flo" (+ 33 44.5) 77.5)77 (test-assert "+: adding fix/big" (show (+ 22 max2)))78 (test-assert "+: adding fix/rat" (show (+ 22 r1)))79 (test-equal "+: adding fix/complex" (+ 99 c1) (make-rectangular 132 44))80 (test-equal "+: adding complex/fix (inexact)" (+ c2 99) (make-rectangular 97.8 44))81 (test-equal "+: flo/flo" (+ 3.4 5.6) 9.0)82 (test-equal "+: flo/big"83 (+ 3.4 b1)84 (if 64-bits? 9223372036854775809.4 2147483671.4))85 (test-assert "+: flo/rat" (show (+ 33.4 r1)))86 (test-equal "+: flo/comp" (+ 3.4 c1) (make-rectangular 36.4 44))87 (test-assert "+: big/rat" (show (+ b1 r1)))88 (test-equal "+: comp+comp" (+ c1 c1) (make-rectangular 66 88))89 (test-equal "+: comp+comp (inexact)" (+ c1 c2) (make-rectangular 31.8 88))90 (test-equal "+: multiarg" (+ 33 44 55) 132)91)9293(test-group "subtraction"9495 (test-equal "-: negate fix" (- 33) -33)96 (test-equal "-: negate most negative fix" (- min-fix) min-big)97 (test-equal "abs: most negative fix" (abs most-negative-fixnum) min-big)98 (test-equal "-: negate flo" (- 33.2) -33.2)99 (test-assert "-: negate rat" (show (- r1)))100 (test-equal "-: double-negate big" (- (- b1)) b1)101 (test-equal "-: negate comp" (- c1) (make-rectangular -33 -44))102 (test-equal "-: fixnums" (- 33 44) -11)103 (test-equal "-: fixnums (2nd negative)" (- 33 -44) 77)104 (test-assert "-: fixnums (overflow)" (show (- min-fix min-fix)))105 (test-equal "-: fix/flo" (- 33 44.5) -11.5)106 (test-equal "-: flo/fix" (- 44.5 33) 11.5)107 (test-assert "-: fix/big" (show (- 22 b2)))108 (test-assert "-: big/fix" (show (- b2 22)))109 (test-equal "-: big/fix (normalizing to fix)" (- min-big 1) max-fix)110 (test-assert "-: fix/rat" (show (- 22 r1)))111 (test-assert "-: rat/fix" (show (- r1 22)))112 (test-equal "-: fix/complex" (- 99 c1) (make-rectangular 66 -44))113 (test-equal "-: complex/fix" (- c1 99) (make-rectangular -66 44))114 (test-equal "-: complex/fix (inexact)" (- c2 99) (make-rectangular -100.2 44))115 (test-equal "-: fix/complex (inexact)" (- 99 c2) (make-rectangular 100.2 -44))116 (test-equal "-: fix/complex (negative im)" (- 99 1+2i) 98-2i)117 (test-equal "-: fix/complex (negative im, inexact)" (- 99 1.0+2.0i) 98.0-2.0i)118 (test-equal "-: fix/complex (negative real, inexact)" (- 99 -1.0+2.0i) 100.0-2.0i)119 (test-equal "-: rat/complex (negative real)" (- 3/2 -1+2i) 5/2-2i)120121 (parameterize ((current-test-epsilon 1e-10))122 (test-equal "-: flo/flo" (- 5.6 3.4) 2.2))123124 (test-assert "-: flo/big" (show (- 3.4 b1)))125 (test-assert "-: big/flo" (show (- b1 3.4)))126 (test-assert "-: flo/rat" (show (- 3.4 r1)))127 (test-assert "-: rat/flo" (show (- r1 3.4)))128 (test-assert "-: big/rat" (show (- b1 r1)))129 (test-assert "-: rat/big" (show (- r1 b1)))130 (test-equal "-: flo/comp" (- 3.4 c1) (make-rectangular -29.6 -44))131 (test-equal "-: comp/flo" (- c1 3.4) (make-rectangular 29.6 44))132 (test-equal "-: comp-comp" (- c1 c1) 0)133 (test-equal "-: comp-comp (inexact)" (- c1 c2) 34.2)134 (test-equal "-: multiarg" (- 33 44 55) -66)135)136137138(test-group "multiplication"139140 (test-equal "*: no arguments" (*) 1)141 (test-equal "*: single argument" (* 33) 33)142 (test-equal "*: multiplying fixnums" (* 33 44) 1452)143 (test-equal "*: multiplying fixnums (2nd negative)" (* 33 -44) -1452)144 (test-equal "*: multiplying fix/flo" (* 33 44.5) 1468.5)145 (test-assert "*: multiplying fix/big (-> 47244640212)" (show (* 22 max2)))146 (test-assert "*: multiplying fix/rat" (show (* 33 r1)))147 (test-equal "*: multiplying fix/complex" (* 99 c1) (make-rectangular 3267 4356))148 (test-equal "*: multiplying fix/complex(inf)" (* 99 cinf) (make-rectangular +inf.0 99.0))149 (test-equal "*: multiplying complex/fix (inexact)" (* c2 99) (make-rectangular -118.8 4356.0))150 (test-equal "*: multiplying most negative fixnum by one (edge case)"151 (list (* most-negative-fixnum 1) (fixnum? (* most-negative-fixnum 1)))152 (list most-negative-fixnum #t))153 (test-equal "*: flo/flo" (* 3.4 5.6) 19.04)154 (test-equal "*: flo/big"155 (* 0.001 b1)156 (if 64-bits? 9223372036854775.806 2147483.668))157 (test-assert "*: flo/rat" (show (* 3.4 r1)))158 (test-assert "*: big/rat" (show (* b1 r1)))159 (test-equal "*: flo/comp" (* 3.4 c1) (make-rectangular 112.2 149.6))160 (test-equal "*: flo/comp(inf)" (* 99.0 cinf) (make-rectangular +inf.0 99.0))161 (test-equal "*: comp*comp" (* c1 c1) (make-rectangular -847 2904))162 (test-equal "*: comp*comp (inexact)" (* c1 c2) (make-rectangular -1975.6 1399.2))163 (test-equal "*: multiarg" (* 33 44 55) 79860)164 (test-equal "*: (* 0 z) => 0 for all z" (* 0 1.0) 0)165 (test-equal "*: (* 0 +inf.0) => 0" (* 0 +inf.0) 0)166 (test-equal "*: (* 0 -inf.0) => 0" (* 0 -inf.0) 0)167 (test-equal "*: (* 0 +nan.0) => 0" (* 0 +nan.0) 0)168 (test-equal "*: (* 1 0.0+inf.0i) => 0.0+inf.0i" (* 1 0.0+inf.0i) 0.0+inf.0i)169 (test-equal "*: (* +i 0.0+inf.0i) => -inf.0+0.0i" (* +i 0.0+inf.0i) -inf.0+0.0i)170)171172(test-group "division"173174 (test-assert "/: rec. fix" (show (/ 33)))175 (test-assert "/: rec. flo" (show (/ 33.2)))176 (test-assert "/: rec. rat" (show (/ r1)))177 (test-assert "/: rec. big" (show (/ b1)))178 (test-assert "/: rec. comp" (/ c1))179 (test-assert "/: fixnums" (show (/ 33 44)))180 (test-equal "/: fixnums (both negative, fixnum result)" (show (/ -2 -2)) 1)181 (test-assert "/: fixnums (2nd negative)" (show (/ 33 -44)))182 (test-assert "/: fixnums" (show (/ min-fix min-fix)))183 (test-equal "/: fix/flo" (/ 33 44.5) (fp/ 33.0 44.5))184 (test-equal "/: flo/fix" (/ 44.5 33) (fp/ 44.5 33.0))185 (test-assert "/: fix/big" (show (/ 22 b2)))186 (test-assert "/: big/fix" (show (/ b2 22)))187 (test-assert "/: fix/rat" (show (/ 22 r1)))188 (test-assert "/: rat/fix" (show (/ r1 22)))189 (test-assert "/: fix/complex" (show (/ 99 c1)))190 (test-assert "/: complex/fix" (show (/ c1 99)))191 (test-assert "/: complex/fix (inexact)" (show (- c2 99)))192 (test-assert "/: fix/complex (inexact)" (show (- 99 c2)))193 (test-equal "/: flo/flo" (/ 5.6 3.4) (fp/ 5.6 3.4))194 (test-assert "/: flo/big" (show (/ 3.4 b1)))195 (test-assert "/: big/flo" (show (/ b1 3.4)))196 (test-assert "/: flo/rat" (show (/ 3.4 r1)))197 (test-assert "/: rat/flo" (show (/ r1 3.4)))198 (test-assert "/: big/rat" (show (/ b1 r1)))199 (test-assert "/: rat/big" (show (/ r1 b1)))200 (test-assert "/: rat/rat" (show (/ r1 r1)))201 (test-assert "/: flo/comp" (show (/ 3.4 c1)))202 (test-assert "/: comp/flo" (show (/ c1 3.4)))203 (test-assert "/: comp/comp" (show (/ c1 c1)))204 (test-assert "/: comp/comp (inexact)" (show (/ c1 c2)))205 (test-equal "/: rat/complex" (/ 1/2 1+2i) 1/10-1/5i)206 (test-equal "/: rat/complex (negative im)" (/ 1/2 1-2i) 1/10+1/5i)207 (test-equal "/: rat/complex (negative real)" (/ 1/2 -1+2i) -1/10-1/5i)208 (test-equal "/: rat/complex (negative real&im)" (/ 1/2 -1-2i) -1/10+1/5i)209 (test-equal "/: complex/noncomplex" (/ +inf.0+i 1) +inf.0+i)210211 (test-assert "/: multiarg" (show (/ 66 2 44)))212 (test-error "/: div fixnum by 0" (/ 33 0))213 ;; R7RS says it is an error if any but the first argument is an exact214 ;; zero. R5RS doesn't say anything at all (??).215 (test-error "/: div flonum by 0" (/ 33.0 0))216 (test-equal "/: div fixnum by 0.0" (/ 33 0.0) +inf.0)217 (test-equal "/: div flonum by 0.0" (/ 33.0 0.0) +inf.0)218 (test-equal "/: div by 0 (inexact)" (/ 33 0.0) +inf.0)219 (test-equal "/: (/ 0 z) => 0 for any z" (/ 0 10.0) 0)220 (test-equal "/: (/ 0 +inf.0) => 0" (/ 0 +inf.0) 0)221 (test-equal "/: (/ 0 -inf.0) => 0" (/ 0 -inf.0) 0)222 (test-assert "/: big result" (show (/ b1 2)))223)224225(test-group "quotient"226 (test-equal "quotient: fix/fix" (quotient 22 11) 2)227 (test-equal "quotient: fix/big" (quotient 22 b1) 0)228 (test-equal "quotient: fix/big (most negative)" (quotient min-fix (- min-fix)) -1)229 (test-equal "quotient: big/fix (most negative)" (quotient (- min-fix) min-fix) -1)230 (test-equal "quotient: fix/fix (most negative)" (quotient min-fix -1) (* min-fix -1))231 (test-equal "quotient: flo/flo" (quotient 22.0 11.0) 2.0)232 (test-equal "quotient: fix/flo" (quotient 22 11.0) 2.0)233 (test-equal "quotient: flo/fix" (quotient 22.0 11) 2.0)234 (test-equal "quotient: flo/big" (quotient 22.0 b1) 0.0)235 (test-equal "quotient: big/flo" (quotient b1 (/ b1 2.0)) 2.0)236 (test-equal "quotient: big/big" (quotient (- min-fix) (- min-fix)) 1)237 (test-equal "quotient: big/big" (quotient (+ (- min-fix) 5) (- min-fix)) 1)238239 (test-error "quotient: flo/flo (fractional)" (quotient 23.0 11.5))240 (test-error "quotient: fix/flo (fractional)" (quotient 23 11.5))241 (test-error "quotient: flo/fix (fractional)" (quotient 13.5 6))242)243244(test-group "remainder"245 (test-equal "remainder: fix/fix" (remainder 22 11) 0)246 (test-equal "remainder: fix/big" (remainder 22 b1) 22)247 (test-equal "remainder: fix/big (most negative)" (remainder min-fix (- min-fix)) 0)248 (test-equal "remainder: big/fix (most negative)" (remainder (- min-fix) min-fix) 0)249 (test-equal "remainder: big/big" (remainder (- min-fix) (- min-fix)) 0)250 (test-equal "remainder: big/big" (remainder (+ (- min-fix) 5) (- min-fix)) 5)251252 (test-equal "remainder: flo/flo" (remainder 22.0 11.0) 0.0)253 (test-equal "remainder: fix/flo" (remainder 22 11.0) 0.0)254 (test-equal "remainder: flo/fix" (remainder 22.0 11) 0.0)255 (unless 64-bits? ;; We lose so much precision when converting to double this makes no sense256 (test-equal "remainder: flo/big" (remainder 22.0 b1) 22.0))257258 (test-error "remainder: flo/flo (fractional)" (remainder 22.5 2.25))259 (test-error "remainder: fix/flo (fractional)" (remainder 6 12.5))260 (test-error "remainder: flo/fix (fractional)" (remainder 13.5 6))261 (unless 64-bits?262 (test-error "remainder: flo/big (fractional)" (remainder (+ b1 0.5) b1)))263)264265(test-group "quotient&remainder"266 (test-equal "quotient&remainder: fix/fix"267 (receive (quotient&remainder 22 11)) '(2 0))268 (test-equal "quotient&remainder: fix/big"269 (receive (quotient&remainder 22 b1)) '(0 22))270 (test-equal "quotient&remainder: fix/big (most negative)"271 (receive (quotient&remainder min-fix (- min-fix))) '(-1 0))272 (test-equal "quotient&remainder: big/fix (most negative)"273 (receive (quotient&remainder (- min-fix) min-fix)) '(-1 0))274 (test-equal "quotient&remainder: fix/fix (most negative)"275 (receive (quotient&remainder min-fix -1)) `(,(* min-fix -1) 0))276 (test-equal "quotient&remainder: big/big" (receive (quotient&remainder (- min-fix) (- min-fix)))277 '(1 0))278 (test-equal "quotient&remainder: big/big" (receive (quotient&remainder (+ (- min-fix) 5) (- min-fix)))279 '(1 5))280281 (test-equal "quotient&remainder: flo/flo"282 (receive (quotient&remainder 22.0 4.0)) '(5.0 2.0))283 (test-equal "quotient&remainder: flo/fix"284 (receive (quotient&remainder 22.0 4)) '(5.0 2.0))285 (test-equal "quotient&remainder: fix/flo"286 (receive (quotient&remainder 22 4.0)) '(5.0 2.0))287 (test-error "quotient&remainder: flo/fix (fractional)"288 (receive (quotient&remainder 0.1 2)))289 (test-error "quotient&remainder: flo/big (fractional)"290 (receive (quotient&remainder 0.5 b1)))291 (test-error "quotient&remainder: big/flo (fractional)"292 (receive (quotient&remainder b1 0.5)))293)294295(test-group "gcd"296 (test-equal "gcd: fix (64-bit)/big" (gcd 907947775416515 11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111) 1)297 (test-equal "gcd: big/big" (gcd 234897235923342343242 234790237101762305340234) 6)298 (test-equal (gcd) 0)299 (test-equal (gcd 6) 6)300 (test-equal (gcd -2) 2)301 (test-equal (gcd 6 8) 2)302 (test-equal (gcd 6 8 5) 1)303 (test-equal (gcd 6 -8 5) 1)304 (test-equal (gcd 6.0) 6.0)305 (test-equal (gcd 6.0 8.0) 2.0)306 (test-error (gcd 6.1))307 (test-error (gcd 6.1 8.0))308 (test-error (gcd 6.0 8.1))309 (test-error (gcd +inf.0))310 (test-error (gcd +nan.0))311 (test-error (gcd 6.0 +inf.0))312 (test-error (gcd +inf.0 6.0))313 (test-error (gcd +nan.0 6.0))314 (test-error (gcd 6.0 +nan.0))315 (test-error (gcd 1+2i 3+4i))316 (test-error (gcd 1/2 3/4)))317318(test-group "lcm"319 (test-equal (lcm) 1)320 (test-equal (lcm 5) 5)321 (test-equal (lcm -8) 8)322 (test-equal (lcm 6 8) 24)323 (test-equal (lcm 6 8 5) 120)324 (test-equal (lcm 6.0 8.0) 24.0)325 (test-error (lcm 6.1 8.0))326 (test-error (lcm 6.0 8.1))327 (test-error (lcm +inf.0))328 (test-error (lcm +nan.0))329 (test-error (lcm 6.0 +inf.0))330 (test-error (lcm +inf.0 6.0))331 (test-error (lcm +nan.0 6.0))332 (test-error (lcm 6.0 +nan.0))333 (test-error (lcm 1+2i 3+4i))334 (test-error (lcm 1/2 3/4)))335336337(test-group "equality"338339 (test-equal "=: fix/fix" (= 33 33) #t)340 (test-equal "=: fix/flo" (= 33 33.0) #t)341 (test-equal "=: !fix/fix" (= 33 34) #f)342 (test-equal "=: !fix/flo" (= 33 33.1) #f)343 (test-equal "=: !fix/flo (overflow)" (= 9007199254740993 9007199254740992.0) #f)344 (test-equal "=: !fix/flo (inf)" (= 0 +inf.0) #f)345 (test-equal "=: !fix/flo (-inf)" (= 0 -inf.0) #f)346 (test-equal "=: !fix/flo (+nan)" (= 0 -nan.0) #f)347 (test-equal "=: flo/fix" (= 33.0 33) #t)348 (test-equal "=: !flo/fix (overflow)" (= 9007199254740992.0 9007199254740993) #f)349 (test-equal "=: !flo/fix (inf)" (= +inf.0 0) #f)350 (test-equal "=: !flo/fix (-inf)" (= -inf.0 0) #f)351 (test-equal "=: !flo/fix (+nan)" (= -nan.0 0) #f)352 (test-equal "=: flo/flo" (= 33.1 33.1) #t)353 (test-equal "=: !flo/flo" (= 33.1 -33.1) #f)354 ;; Flonums are only 53 bits of precision, so it will drop data.355 ;; Comparison is exact356 (unless 64-bits?357 (test-equal "=: big/flo" (= b1 (+ 0.0 b1)) #t))358 (test-equal "=: big/big" (= b1 b1) #t)359 (test-equal "=: !big/big" (= b2 b1) #f)360 (test-equal "=: !big/fix" (= b2 22) #f)361 (test-equal "=: rat/flo" (= r1 (+ r1 0.0)) #t)362 (test-equal "=: rat/rat" (= r1 r1) #t)363 (test-equal "=: !rat/rat" (= r1 r2) #f)364 (test-equal "=: comp/comp" (= c1 c1) #t)365 (test-equal "=: !comp/comp" (= c1 c2) #f)366)367368(test-group "generic equality"369 (test-equal "equal?: fix/fix" (equal? 33 33) #t)370 (test-equal "equal?: fix/flo" (equal? 33 33.0) #f)371 (test-equal "equal?: !fix/fix" (equal? 33 34) #f)372 (test-equal "equal?: !fix/flo" (equal? 33 33.1) #f)373 (test-equal "equal?: flo/fix" (equal? 33.0 33) #f)374 (test-equal "equal?: flo/flo" (equal? 33.1 33.1) #t)375 (test-equal "equal?: !flo/flo" (equal? 33.1 -33.1) #f)376 (test-equal "equal?: big/flo" (equal? b1 (+ 0.0 b1)) #f)377 (test-equal "equal?: big/big" (equal? b1 b1) #t)378 (test-equal "equal?: big/big2" (equal? b1 (+ 1 b1 -1)) #t)379 (test-equal "equal?: !big/big" (equal? b2 b1) #f)380 (test-equal "equal?: rat/flo" (equal? r1 (+ r1 0.0)) #f)381 (test-equal "equal?: rat/rat" (equal? r1 r1) #t)382 (test-equal "equal?: !rat/rat" (equal? r1 r2) #f)383 (test-equal "equal?: comp/comp" (equal? c1 c1) #t)384 (test-equal "equal?: !comp/comp" (equal? c1 c2) #f)385 (test-equal "equal?: nan/nan" (equal? (/ 0.0 0.0) (/ 0.0 0.0)) #f)386 (test-equal "equal?: nan+nan/nan+nan" (equal? (make-rectangular (/ 0.0 0.0)387 (/ 0.0 0.0))388 (make-rectangular (/ 0.0 0.0)389 (/ 0.0 0.0))) #f)390)391392393(test-group "greater & greater/equal"394395 (test-equal ">: fix/fix" (> 44 33) #t)396 (test-equal ">=: fix/fix" (>= 44 33) #t)397 (test-equal ">: fix/fix/fix" (> 44 33 22) #t)398 (test-equal ">=: fix/fix/fix" (>= 44 33 22) #t)399 (test-equal ">: !fix/fix" (> 33 44) #f)400 (test-equal ">=: !fix/fix" (>= 33 44) #f)401 (test-equal ">: !fix/fix/fix" (> 22 33 44) #f)402 (test-equal ">=: !fix/fix/fix" (>= 22 33 44) #f)403 (test-equal ">: fix/fix" (> 33 33) #f)404 (test-equal ">=: !fix/fix" (>= 33 33) #t)405 (test-equal ">: fix/flo" (> 44 33.0) #t)406 (test-equal ">=: fix/flo" (>= 44 33.0) #t)407 (test-equal ">: !fix/flo" (> 33 44.0) #f)408 (test-equal ">=: !fix/flo" (>= 33 44.0) #f)409 (test-equal ">: !fix/flo" (> 33 33.0) #f)410 (test-equal ">=: !fix/flo" (>= 33 33.0) #t)411 (test-equal ">: fix/flo (flo overflow), on 64 bits"412 (> 9007199254740993 9007199254740992.0) #t) ; 2^53413 (test-equal ">=: fix/flo (flo overflow), on 64 bits"414 (>= 9007199254740993 9007199254740992.0) #t)415 (test-equal ">: fix/flo (flo underflow), on 64 bits"416 (> -9007199254740992 -9007199254740991.0) #f)417 (test-equal ">=: fix/flo (flo underflow), on 64 bits"418 (>= -9007199254740992 -9007199254740991.0) #f)419 (test-equal ">: fix/big" (> 44 b2) #t)420 (test-equal ">=: fix/big" (>= 44 b2) #t)421 (test-equal ">: !fix/big" (> 33 b1) #f)422 (test-equal ">=: !fix/big" (>= 33 b1) #f)423 (test-equal ">: fix/rat" (> 44 r1) #t)424 (test-equal ">=: fix/rat" (>= 44 r1) #t)425 (test-equal ">: !fix/rat" (> 0 r1) #f)426 (test-equal ">=: !fix/rat" (>= 0 r1) #f)427428 (test-equal ">: flo/fix" (> 44.0 33) #t)429 (test-equal ">=: flo/fix" (>= 44.0 33) #t)430 (test-equal ">: !flo/fix" (> 33.0 44) #f)431 (test-equal ">=: !flo/fix" (>= 33.0 44) #f)432 (test-equal ">: !flo/fix" (> 33.0 33) #f)433 (test-equal ">=: flo/fix" (>= 33.0 33) #t)434 (test-equal ">: flo/flo" (> 44.0 33.0) #t)435 (test-equal ">=: flo/flo" (>= 44.0 33.0) #t)436 (test-equal ">: !flo/flo" (> 33.0 44.0) #f)437 (test-equal ">=: !flo/flo" (>= 33.0 44.0) #f)438 (test-equal ">: flo/big" (> 44.0 b2) #t)439 (test-equal ">=: flo/big" (>= 44.0 b2) #t)440 (test-equal ">: flo/fix (flo overflow), on 64 bits"441 (> 9007199254740992.0 9007199254740993) #f) ; 2^53442 (test-equal ">=: flo/fix (flo overflow), on 64 bits"443 (>= 9007199254740992.0 9007199254740993) #f)444 (test-equal ">: fix/flo (flo underflow), on 64 bits"445 (> -9007199254740991.0 -9007199254740992) #t)446 (test-equal ">=: fix/flo (flo underflow), on 64 bits"447 (>= -9007199254740991.0 -9007199254740992) #t)448 (test-equal ">: flo/big (flo overflow)"449 (> 1237940039285380274899124224.0 1237940039285380274899124225) #f)450 (test-equal ">=: flo/big (flo overflow)"451 (>= 1237940039285380274899124224.0 1237940039285380274899124225) #f)452 (test-equal ">: !flo/big" (> 33.0 b1) #f)453 (test-equal ">=: !flo/big" (>= 33.0 b1) #f)454 (test-equal ">: flo/rat" (> 44.0 r1) #t)455 (test-equal ">=: flo/rat" (>= 44.0 r1) #t)456 (test-equal ">: !flo/rat" (> 0.0 r1) #f)457 (test-equal ">=: !flo/rat" (>= 0.0 r1) #f)458 (test-equal ">: !rat/rat" (> r1 r1) #f)459 (test-equal ">=: rat/rat" (>= r1 r1) #t)460 (test-equal ">: flo/nan" (> 0.0 +nan.0) #f)461 (test-equal ">=: flo/nan" (>= 0.0 +nan.0) #f)462 (test-equal ">: nan/flo" (> +nan.0 0.0) #f)463 (test-equal ">=: nan/flo" (>= +nan.0 0.0) #f)464 (test-equal ">: flo/flo/nan" (> 1.0 0.0 +nan.0) #f)465 (test-equal ">=: flo/flo/nan" (>= 1.0 0.0 +nan.0) #f)466467 (test-equal ">: big/fix" (> b1 33) #t)468 (test-equal ">=: big/fix" (>= b1 33) #t)469 (test-equal ">: !big/fix" (> b2 44) #f)470 (test-equal ">=: !big/fix" (>= b2 44) #f)471 (test-equal ">: big/flo" (> b1 33.0) #t)472 (test-equal ">=: big/flo" (>= b1 33.0) #t)473 (test-equal ">: big/flo (flo overflow)"474 (> 1237940039285380274899124225 1237940039285380274899124224.0) #t)475 (test-equal ">=: big/flo (flo overflow)"476 (>= 1237940039285380274899124225 1237940039285380274899124224.0) #t)477 (test-equal ">: !big/flo" (> b2 44.0) #f)478 (test-equal ">=: !big/flo" (>= b2 44.0) #f)479 (test-equal ">: big/big" (> b1 b2) #t)480 (test-equal ">=: big/big" (>= b1 b2) #t)481 (test-equal ">: !big/big" (> b2 b1) #f)482 (test-equal ">=: !big/big" (>= b2 b1) #f)483 (test-equal ">: big/rat" (> b1 r1) #t)484 (test-equal ">=: big/rat" (>= b1 r1) #t)485 (test-equal ">: !big/rat" (> b2 r1) #f)486 (test-equal ">=: !big/rat" (>= b2 r1) #f)487488 (test-equal ">: rat/fix" (> r1 2) #f)489 (test-equal ">=: rat/fix" (>= r1 2) #f)490 (test-equal ">: !rat/fix" (> r1 44) #f)491 (test-equal ">=: !rat/fix" (>= r1 44) #f)492 (test-equal ">: rat/flo" (> r2 2.0) #t)493 (test-equal ">=: rat/flo" (>= r2 2.0) #t)494 (test-equal ">: !rat/flo" (> b2 44.0) #f)495 (test-equal ">=: !rat/flo" (>= b2 44.0) #f)496 (test-equal ">: !rat/big" (> r1 b1) #f)497 (test-equal ">=: !rat/big" (>= r1 b1) #f)498 (test-equal ">: rat/rat" (> r2 r1) #t)499 (test-equal ">=: rat/rat" (>= r2 r1) #t)500 (test-equal ">: !rat/rat" (> r1 r2) #f)501 (test-equal ">=: !rat/rat" (>= r1 r2) #f)502 (test-equal ">: rat/flo (flo overflow)"503 (> 1237940039285380274899124224/1237940039285380274899124223 1.0) #t)504 (test-equal ">: rat/flo (flo overflow)"505 (> 1237940039285380274899124224/1237940039285380274899124223 1.5) #f)506 (test-equal ">=: rat/flo (flo overflow)"507 (>= 1237940039285380274899124224/1237940039285380274899124223 1.0) #t)508 (test-equal ">=: rat/flo (flo overflow)"509 (>= 1237940039285380274899124224/1237940039285380274899124223 1.5) #f)510 (test-equal ">: rat/flo (flo underflow)"511 (> -1237940039285380274899124224/1237940039285380274899124223 -1.0) #f)512 (test-equal ">: rat/flo (flo underflow)"513 (> -1237940039285380274899124224/1237940039285380274899124223 -1.5) #t)514 (test-equal ">=: rat/flo (flo underflow)"515 (>= -1237940039285380274899124224/1237940039285380274899124223 -1.0) #f)516 (test-equal ">=: rat/flo (flo underflow)"517 (>= -1237940039285380274899124224/1237940039285380274899124223 -1.5) #t)518)519520521(test-group "less & less/equal"522523 (test-equal "<: !fix/fix" (< 44 33) #f)524 (test-equal "<=: !fix/fix" (<= 44 33) #f)525 (test-equal "<: fix/fix/fix" (< 33 44 55) #t)526 (test-equal "<=: fix/fix/fix" (<= 33 44 55) #t)527 (test-equal "<: !fix/fix/fix" (< 33 55 44) #f)528 (test-equal "<=: !fix/fix/fix" (<= 33 55 44) #f)529 (test-equal "<: !fix/fix/fix" (< 44 33 55) #f)530 (test-equal "<=: !fix/fix/fix" (<= 44 33 55) #f)531 (test-equal "<: !fix/fix/fix" (< 44 44 44) #f)532 (test-equal "<=: fix/fix/fix" (<= 44 44 44) #t)533 (test-equal "<: fix/fix" (< 33 44) #t)534 (test-equal "<=: fix/fix" (<= 33 44) #t)535 (test-equal "<: !fix/fix" (< 33 33) #f)536 (test-equal "<=: fix/fix" (<= 33 33) #t)537 (test-equal "<: !fix/flo" (< 44 33.0) #f)538 (test-equal "<=: !fix/flo" (<= 44 33.0) #f)539 (test-equal "<: fix/flo" (< 33 44.0) #t)540 (test-equal "<=: fix/flo" (<= 33 44.0) #t)541 (test-equal "<: fix/flo (flo overflow), on 64 bits"542 (< 9007199254740993 9007199254740992.0) #f) ; 2^53543 (test-equal "<=: fix/flo (flo overflow), on 64 bits"544 (< 9007199254740993 9007199254740992.0) #f)545 (test-equal "<: fix/flo (flo underflow), on 64 bits"546 (< -9007199254740993 -9007199254740992.0) #t)547 (test-equal "<=: fix/flo (flo underflow), on 64 bits"548 (<= -9007199254740993 -9007199254740992.0) #t)549 (test-equal "<: !fix/flo" (< 33.0 33.0) #f)550 (test-equal "<=: fix/flo" (<= 33.0 33.0) #t)551 (test-equal "<: !fix/big" (< 44 b2) #f)552 (test-equal "<=: !fix/big" (<= 44 b2) #f)553 (test-equal "<: fix/big" (< 33 b1) #t)554 (test-equal "<=: fix/big" (<= 33 b1) #t)555 (test-equal "<: !big/big" (< b1 b1) #f)556 (test-equal "<=: big/big" (<= b1 b1) #t)557 (test-equal "<: !fix/rat" (< 44 r1) #f)558 (test-equal "<=: !fix/rat" (<= 44 r1) #f)559 (test-equal "<: fix/rat" (< 0 r1) #t)560 (test-equal "<=: fix/rat" (<= 0 r1) #t)561562 (test-equal "<: !flo/fix" (< 44.0 33) #f)563 (test-equal "<=: !flo/fix" (<= 44.0 33) #f)564 (test-equal "<: flo/fix" (< 33.0 44) #t)565 (test-equal "<=: flo/fix" (<= 33.0 44) #t)566 (test-equal "<: !flo/flo" (< 44.0 33.0) #f)567 (test-equal "<=: !flo/flo" (<= 44.0 33.0) #f)568 (test-equal "<: flo/flo" (< 33.0 44.0) #t)569 (test-equal "<=: flo/flo" (<= 33.0 44.0) #t)570 (test-equal "<: !flo/big" (< 44.0 b2) #f)571 (test-equal "<=: !flo/big" (<= 44.0 b2) #f)572 (test-equal "<: flo/big" (< 33.0 b1) #t)573 (test-equal "<=: flo/big" (<= 33.0 b1) #t)574 (test-equal "<: flo/fix (flo overflow), on 64 bits"575 (< 9007199254740992.0 9007199254740993) #t) ; 2^53576 (test-equal "<=: flo/fix (flo overflow), on 64 bits"577 (< 9007199254740992.0 9007199254740993) #t)578 (test-equal "<: flo/fix (flo underflow), on 64 bits"579 (< -9007199254740992.0 -9007199254740993) #f)580 (test-equal "<=: flo/fix (flo underflow), on 64 bits"581 (<= -9007199254740992.0 -9007199254740993) #f)582 (test-equal "<: flo/big (flo overflow)"583 (< 1237940039285380274899124224.0 1237940039285380274899124225) #t)584 (test-equal "<=: flo/big (flo overflow)"585 (<= 1237940039285380274899124224.0 1237940039285380274899124225) #t)586 (test-equal "<: !flo/rat" (< 44.0 r1) #f)587 (test-equal "<=: !flo/rat" (<= 44.0 r1) #f)588 (test-equal "<: flo/rat" (< 0.0 r1) #t)589 (test-equal "<=: flo/rat" (<= 0.0 r1) #t)590 (test-equal "<: flo/nan" (< 0.0 +nan.0) #f)591 (test-equal "<=: flo/nan" (<= 0.0 +nan.0) #f)592 (test-equal "<: nan/flo" (< +nan.0 0.0) #f)593 (test-equal "<=: nan/flo" (<= +nan.0 0.0) #f)594 (test-equal "<: flo/flo/nan" (< 0.0 1.0 +nan.0) #f)595 (test-equal "<=: flo/flo/nan" (<= 0.0 1.0 +nan.0) #f)596597 (test-equal "<: !big/fix" (< b1 33) #f)598 (test-equal "<=: !big/fix" (<= b1 33) #f)599 (test-equal "<: big/fix" (< b2 44) #t)600 (test-equal "<=: big/fix" (<= b2 44) #t)601 (test-equal "<: !big/flo" (< b1 33.0) #f)602 (test-equal "<=: !big/flo" (<= b1 33.0) #f)603 (test-equal "<: big/flo" (< b2 44.0) #t)604 (test-equal "<=: big/flo" (<= b2 44.0) #t)605 (test-equal "<: big/flo (max flo)"606 (< 1237940039285380274899124224 1237940039285380274899124224.0) #f)607 (test-equal "<=: big/flo (max flo)"608 (<= 1237940039285380274899124224 1237940039285380274899124224.0) #t)609 (test-equal "<: big/flo (max flo, smaller bignum)"610 (< 1237940039285380274899124223 1237940039285380274899124224.0) #t)611 (test-equal "<: big/flo (max flo, smaller bignum)"612 (<= 1237940039285380274899124223 1237940039285380274899124224.0) #t)613 (test-equal "<: !big/big" (< b1 b2) #f)614 (test-equal "<=: !big/big" (<= b1 b2) #f)615 (test-equal "<: big/big" (< b2 b1) #t)616 (test-equal "<=: big/big" (<= b2 b1) #t)617 (test-equal "<: !big/rat" (< b1 r1) #f)618 (test-equal "<=: !big/rat" (<= b1 r1) #f)619 (test-equal "<: big/rat" (< b2 r1) #t)620 (test-equal "<=: big/rat" (<= b2 r1) #t)621622 (test-equal "<: !rat/fix" (< r2 2) #f)623 (test-equal "<=: !rat/fix" (<= r2 2) #f)624 (test-equal "<: rat/fix" (< r1 44) #t)625 (test-equal "<=: rat/fix" (<= r1 44) #t)626 (test-equal "<: !rat/flo" (< r2 2.0) #f)627 (test-equal "<=: !rat/flo" (<= r2 2.0) #f)628 (test-equal "<: rat/flo" (< b2 44.0) #t)629 (test-equal "<=: rat/flo" (<= b2 44.0) #t)630 (test-equal "<: rat/big" (< r1 b1) #t)631 (test-equal "<=: rat/big" (<= r1 b1) #t)632 (test-equal "<: !rat/rat" (< r2 r1) #f)633 (test-equal "<=: !rat/rat" (<= r2 r1) #f)634 (test-equal "<: rat/rat" (< r1 r2) #t)635 (test-equal "<=: rat/rat" (<= r1 r2) #t)636 (test-equal "<: rat/flo (flo overflow)"637 (< 1237940039285380274899124224/1237940039285380274899124223 1.0) #f)638 (test-equal "<: rat/flo (flo overflow)"639 (< 1237940039285380274899124224/1237940039285380274899124223 1.5) #t)640 (test-equal "<=: rat/flo (flo overflow)"641 (<= 1237940039285380274899124224/1237940039285380274899124223 1.0) #f)642 (test-equal "<=: rat/flo (flo overflow)"643 (<= 1237940039285380274899124224/1237940039285380274899124223 1.5) #t)644 (test-equal "<: rat/flo (flo underflow)"645 (< -1237940039285380274899124224/1237940039285380274899124223 -1.0) #t)646 (test-equal "<: rat/flo (flo underflow)"647 (< -1237940039285380274899124224/1237940039285380274899124223 -1.5) #f)648 (test-equal "<=: rat/flo (flo underflow)"649 (<= -1237940039285380274899124224/1237940039285380274899124223 -1.0) #t)650 (test-equal "<=: rat/flo (flo underflow)"651 (<= -1237940039285380274899124224/1237940039285380274899124223 -1.5) #f)652)653654(test-group "complex"655656 (test-equal "real-part" (real-part c1) 33)657 (test-equal "real-part of flonum" (real-part 1.23) 1.23)658 (test-equal "real-part of fixnum" (real-part 123) 123)659 (test-equal "real-part of ratnum" (real-part 1/2) 1/2)660 (test-equal "real-part of bignum" (real-part b1) b1)661 (test-equal "real-part of negative flonum" (real-part -1.23) -1.23)662 (test-equal "real-part of negative fixnum" (real-part -123) -123)663 (test-equal "real-part of negative ratnum" (real-part -1/2) -1/2)664 (test-equal "real-part of negative bignum" (real-part (- b1)) (- b1))665 (test-equal "imag-part" (imag-part c1) 44)666 (test-equal "imag-part of flonum" (imag-part 1.23) 0)667 (test-equal "imag-part of fixnum" (imag-part 123) 0)668 (test-equal "imag-part of ratnum" (imag-part 1/2) 0)669 (test-equal "imag-part of bignum" (imag-part b1) 0)670 (test-assert "make-polar" (show (make-polar 33 44)))671 (test-equal "magnitude" (magnitude 0+8i) 8)672 (test-equal "magnitude" (magnitude 0+1/2i) 1/2)673 (test-equal "magnitude of flonum" (magnitude 1.23) 1.23)674 (test-equal "magnitude of fixnum" (magnitude 123) 123)675 (test-equal "magnitude of ratnum" (magnitude 1/2) 1/2)676 (test-equal "magnitude of bignum" (magnitude b1) b1)677 (test-equal "magnitude of negative flonum" (magnitude -1.23) 1.23)678 (test-equal "magnitude of negative fixnum" (magnitude -123) 123)679 (test-equal "magnitude of negative ratnum" (magnitude -1/2) 1/2)680 (test-equal "magnitude of negative bignum" (magnitude (- b1)) b1)681 (test-assert "angle" (show (angle c1)))682 (test-equal "angle of flonum" (angle 1.23) 0.0)683 (test-equal "angle of fixnum" (angle 123) 0.0)684 (test-equal "angle of ratnum" (angle 1/2) 0.0)685 (test-equal "angle of bignum" (angle b1) 0.0)686 (test-equal "angle of negative flonum" (angle -1.23) pi)687 (test-equal "angle of negative fixnum" (angle -123) pi)688 (test-equal "angle of negative ratnum" (angle -1/2) pi)689 (test-equal "angle of negative bignum" (angle (- b1)) pi)690)691692(test-group "rational"693694 ;; Use equal? instead of = to check equality and exactness in one go695 (parameterize ((current-test-comparator equal?))696 (test-assert (show (numerator b1)))697 (test-equal (numerator r1) 3)698 (test-equal (numerator 33) 33)699 (test-equal (denominator r1) 4)700 (test-equal (denominator b1) 1)701 (test-equal (denominator 33) 1)702 (test-equal (numerator 0) 0)703 (test-equal (denominator 0) 1)704 (test-equal (numerator 3) 3)705 (test-equal (denominator 3) 1)706 (test-equal (numerator -3) -3)707 (test-equal (denominator -3) 1)708 (test-equal (numerator 0.5) 1.0)709 (test-equal (denominator 0.5) 2.0)710 (test-equal (numerator 1.25) 5.0)711 (test-equal (denominator 1.25) 4.0)712 (test-equal (numerator -1.25) -5.0)713 (test-equal (denominator -1.25) 4.0)714 (test-equal (numerator 1e10) 1e10)715 (test-equal (denominator 1e10) 1.0))716 (test-error (numerator +inf.0))717 (test-error (numerator +nan.0))718 (test-error (denominator +inf.0))719 (test-error (denominator +nan.0))720721)722723(test-group "misc"724725 (test-equal "inexact->exact" (inexact->exact 2.3) 2589569785738035/1125899906842624)726 (test-error "inexact->exact +inf" (inexact->exact +inf.0))727 (test-error "inexact->exact -inf" (inexact->exact -inf.0))728 (test-error "inexact->exact -NaN" (inexact->exact +nan.0))729 (test-equal "sqrt (integer result)" (sqrt 16) 4)730 (test-equal "sqrt (exact result)" (sqrt 1/4) 1/2)731 (parameterize ((current-test-epsilon 1e-10))732 (test-equal "sqrt (inexact result)" (sqrt 2) 1.4142135623730951))733 (test-equal "sqrt (inexact input)" (sqrt 4.0) 2.0)734 (test-equal "sqrt (exact large number)" (sqrt (* max-fix max-fix)) max-fix)735 (test-error "exact-integer-sqrt (nonint flonum)" (exact-integer-sqrt 1.5))736 (test-error "exact-integer-sqrt (ratnum)" (exact-integer-sqrt 1/2))737 (test-error "exact-integer-sqrt (int flonum)" (exact-integer-sqrt 4.0))738 (test-equal "exact-integer-sqrt (w/o rest)"739 (receive x (exact-integer-sqrt (* max-fix max-fix)) x)740 (list max-fix 0))741 (test-equal "exact-integer-sqrt (with rest)"742 (receive x (exact-integer-sqrt (+ (* max-fix max-fix) 5)) x)743 (list max-fix 5))744 (test-equal "exact-integer-nth-root without rest"745 (receive x (exact-integer-nth-root 243 5) x)746 (list 3 0))747 (test-equal "exact-integer-nth-root with rest"748 (receive x (exact-integer-nth-root 128 4) x)749 (list 3 47))750 (test-equal "exact-integer-nth-root with insanely large base"751 (receive x (exact-integer-nth-root 5 (if 64-bits? 10000000000 100000000)) x)752 (list 1 4))753 (test-equal "expt" (expt 2 4) 16)754 (test-assert "expt" (show (expt 2 100)))755 ;; The next three according to R7RS756 (test-equal "expt 0.0^0.0)" (expt 0.0 0.0) 1.0)757 (test-equal "expt 0.0^{pos}" (expt 0.0 1.0) 0.0)758 ;; An error is not mandatory:759 ;; "[...] either an error is signalled or an unspecified number is returned."760 ;(test-error "expt 0.0^{neg}" (expt 0.0 -1.0))761 ;; R7 doesn't say anything specific about fixnums, so I guess this should behave the same762 (test-equal "expt 0^0" (expt 0 0) 1)763 (test-equal "expt 0^{pos}" (expt 0 1) 0)764 (test-error "expt 0^{neg}" (expt 0 -1))765 (test-equal "expt (rat base)" (expt 1/2 2) 1/4)766 (test-equal "expt (rat exponent)" (expt 16 1/4) 2)767 (test-equal "expt (negative rat exponent)" (expt 16 -1/4) 1/2)768 (test-equal "expt (inexact from rat exponent)" (expt 2 1/7) 1.1040895136738123)769 (test-equal "expt (> 1 rat exponent)" (expt 1/64 3/2) 1/512)770 (test-equal "expt (rat base & exponent)" (expt 1/4 1/2) 1/2)771 (parameterize ((current-test-epsilon 1e-10))772 (test-equal "expt (negative w/ rat exponent)" (expt -16 1/4) 1.4142135623731+1.41421356237309i))773 (test-assert "expt" (show (expt 2 2.0)))774 (test-assert "expt" (show (expt 2 -1)))775 (test-equal "expt between double and 64-bit integer value"776 (expt 999 6) 994014980014994001)777 (parameterize ((current-test-epsilon 1e-10))778 (test-equal "expt with complex result" (expt -1 1.5) -1.836909530733566e-16-1.0i))779 (test-equal "exact expt with complex number" (expt 0+1i 5) 0+1i)780 (test-equal "exact expt with complex number, real result" (expt 0+1i 6) -1)781 (test-equal "inexact expt with complex number" (expt 0.0+1.0i 5.0) 0.0+1.0i)782 (test-equal "inexact expt with complex number, real result"783 (expt 0.0+1.0i 6.0) -1.0+0.0i)784 (parameterize ((current-test-epsilon 1e-10))785 (test-equal "inexact noninteger expt with complex number"786 (expt 0.0+4.0i 0.5) 1.4142135623731+1.41421356237309i)787 (test-equal "exp with complex numbers" (exp 1+i) 1.4686939399158851+2.2873552871788423i))788789 (test-equal "log of exp = 1" (log (exp 1)) 1.0)790 (test-assert "log(-x) = compnum" (cplxnum? (log -2.0)))791 (parameterize ((current-test-epsilon 1e-10))792 (test-equal "log of -1" (log -1) 0.0+3.141592653589793i))793 ;; XXX We should probably attempt to make this return an exact number794 (parameterize ((current-test-epsilon 1e-10))795 (test-equal "log(expt(2,x),2) = x" (log (expt 2 500) 2) 500.0)796 (test-equal "log with complex number" (log +i) 0.0+1.5707963267948966i)797798 (test-equal "exp(log(x)) = x" (exp (log 2.0-3.0i)) 2.0-3.0i)799 (test-equal "log(exp(x)) = x" (log (exp 2.0-3.0i)) 2.0-3.0i)800 (test-equal "log(expt(2,x),2) = x" (log (expt 2 2.0-3.0i) 2) 2.0-3.0i))801802 (letrec ((fac (lambda (n)803 (if (zero? n)804 1805 (* n (fac (- n 1))) ) ) ) )806 (test-assert "bigfac" (show (fac 100)))807 (test-equal "zero signum fixnum" (signum 0) 0)808 (test-equal "zero signum flonum" (signum .0) 0.0)809 (test-equal "positive signum fixnum" (signum 2) 1)810 (test-equal "positive signum ratnum" (signum 1/2) 1)811 (test-equal "positive signum flonum" (signum 2.0) 1.0)812 (test-equal "positive signum bignum" (signum b1) 1)813 (test-equal "negative signum fixnum" (signum -2) -1)814 (test-equal "negative signum ratnum" (signum -1/2) -1)815 (test-equal "negative signum flonum" (signum -2) -1)816 (test-equal "negative signum bignum" (signum (- b1)) -1)817 ;; From CLHS818 (parameterize ((current-test-epsilon 1e-10))819 (test-equal "positive signum compnum(1)" (signum 0+33i) 0+1i)820 (test-equal "positive signum compnum(2)" (signum 7.5+10.0i) 0.6+0.8i)821 (test-equal "negative signum compnum " (signum 0.0-14.7i) 0.0-1.0i)))822 (test-equal "most-negative-fixnum + most-negative-fixnum = 2 * most-negative-fixnum"823 (+ most-negative-fixnum most-negative-fixnum) (* 2 most-negative-fixnum))824 (test-equal "most-negative-fixnum - most-negative-fixnum = 0"825 (- most-negative-fixnum most-negative-fixnum) 0)826 (test-equal "most-positive-fixnum + most-positive-fixnum = 2 * most-positive-fixnum"827 (+ most-positive-fixnum most-positive-fixnum) (* 2 most-positive-fixnum))828 (test-equal "most-positive-fixnum - most-positive-fixnum = 0"829 (- most-positive-fixnum most-positive-fixnum) 0)830)831832833(test-group "R5RS"834835 (test-equal "+" (+ 3 4) 7)836 (test-equal "+" (+ 3) 3)837 (test-equal "+" (+) 0)838 (test-equal "*" (* 4) 4)839 (test-equal "*" (*) 1)840841 (test-equal "-" (- 3 4) -1)842 (test-equal "-" (- 3 4 5) -6)843 (test-equal "-" (- 3) -3)844 (test-assert "/ (3/20)" (show (/ 3 4 5)))845 (test-assert "/ (1/3)" (show (/ 3)))846847 (test-equal "numerator" (numerator (/ 6 4)) 3)848 (test-equal "denominator" (denominator (/ 6 4)) 2)849850 (test-equal "complex?" (complex? c1) #t)851 (test-equal "complex?" (complex? 3) #t)852 (test-equal "real?" (real? 3) #t)853 (test-equal "real?" (real? (make-rectangular -2.5 0.0)) #f)854 (test-equal "real?" (real? -2+1i) #f)855 (test-equal "real?" (real? 1e0) #t)856 (test-equal "rational?" (rational? (/ 6 10)) #t)857 (test-assert "check rational" (show (/ 6 3)))858 (test-equal "rational?" (rational? (/ 6 3)) #t)859 (test-equal "integer?" (integer? (make-rectangular 3 0)) #t)860 (test-equal "integer?" (integer? 1+3i) #f)861 (test-equal "integer?" (integer? 3.0) #t)862 (test-equal "integer?" (integer? (/ 8 4)) #t)863 (test-equal "integer?" (integer? 1/2) #f)864 (test-equal "exact-integer?" (exact-integer? (make-rectangular 3 0)) #t)865 (test-equal "exact-integer?" (exact-integer? 1+3i) #f)866 (test-equal "exact-integer?" (exact-integer? 3.0) #f)867 (test-equal "exact-integer?" (exact-integer? (/ 8 4)) #t)868 (test-equal "exact-integer?" (exact-integer? 1/2) #f)869870 (test-equal "max" (max 3 4) 4)871 (test-equal "max" (max 3.9 4) 4.0)872 (test-equal "max" (max +nan.0 1.0 2.0) 2.0)873 (test-equal "max" (max 1.0 +nan.0 2.0) 2.0)874 (test-equal "max" (max 1.0 2.0 +nan.0) 2.0)875 (test-equal "max" (max +nan.0 1.0 2) 2.0)876 (test-equal "max" (max 1.0 +nan.0 2) 2.0)877 (test-equal "max" (max 1.0 2 +nan.0) 2.0)878 (test-assert "max" (nan? (max +nan.0)))879 (test-assert "max" (nan? (max +nan.0 +nan.0)))880881 (test-equal "min" (min +nan.0 1.0 2.0) 1.0)882 (test-equal "min" (min 1.0 +nan.0 2.0) 1.0)883 (test-equal "min" (min 1.0 2.0 +nan.0) 1.0)884 (test-equal "min" (min +nan.0 1 2.0) 1.0)885 (test-equal "min" (min 1 +nan.0 2.0) 1.0)886 (test-equal "min" (min 1 2.0 +nan.0) 1.0)887 (test-assert "min" (nan? (min +nan.0)))888 (test-assert "min" (nan? (min +nan.0 +nan.0)))889890 (test-equal "modulo" (modulo 13 4) 1)891 (test-equal "modulo" (modulo 13.0 4) 1.0)892 (test-equal "modulo" (modulo 13 4.0) 1.0)893 (test-error "modulo" (modulo 13.1 4.0))894 (test-error "modulo" (modulo 13.0 4.1))895 (test-equal "remainder" (remainder 13 4) 1)896 (test-error "remainder" (remainder 13.1 4.0))897 (test-error "remainder" (remainder 13.0 4.1))898 (test-equal "modulo" (modulo -13 4) 3)899 (test-equal "remainder" (remainder -13 4) -1)900 (test-equal "modulo" (modulo 13 -4) -3)901 (test-equal "remainder" (remainder 13 -4) 1)902 (test-equal "modulo" (modulo -13 -4) -1)903 (test-equal "remainder" (remainder -13 -4) -1)904 (test-equal "remainder" (remainder -13 -4.0) -1.0)905906 (test-assert (even? 2))907 (test-assert (not (even? 1)))908 (test-assert (even? -2))909 (test-assert (not (even? -1)))910 (test-assert (even? 2.0))911 (test-assert (not (even? 1.0)))912 (test-assert (even? -2.0))913 (test-assert (not (even? -1.0)))914 (test-error (even? 2.1))915 (test-error (even? -2.3))916 (test-error (even? +inf.0))917 (test-error (even? +nan.0))918 (test-assert (even? (* most-positive-fixnum 2)))919 (test-assert (not (even? (+ (* most-positive-fixnum 2) 1))))920 (test-assert (odd? (+ (* most-positive-fixnum 2) 1)))921 (test-assert (not (odd? (* most-positive-fixnum 2))))922 (test-error (even? 2.0+3.0i))923 (test-error (even? 2+3i))924 (test-error (odd? 2.0+3.0i))925 (test-error (odd? 2+3i))926927 (test-equal "floor" (floor -4.3) -5.0)928 (test-equal "ceiling" (ceiling -4.3) -4.0)929 (test-equal "truncate" (truncate -4.3) -4.0)930 (test-equal "round" (round -4.3) -4.0)931 (test-equal "floor" (floor 3.5) 3.0)932 (test-equal "ceiling" (ceiling 3.5) 4.0)933 (test-equal "truncate" (truncate 3.5) 3.0)934 (test-equal "round" (round 3.5) 4.0)935 (test-equal "round" (round 4.5) 4.0)936 (test-equal "round" (round (/ 7 2)) 4)937 (test-equal "round" (round 7) 7)938939 (test-equal "rationalize (1/3)" (rationalize (inexact->exact .3) (/ 1 10)) 1/3)940 (test-equal "rationalize (#i1/3)" (rationalize .3 (/ 1 10)) #i1/3)941)942943(test-group "bitwise ops"944945 (test-equal "and" (bitwise-and #xff #x1) 1)946 (test-equal "zero-arg and" (bitwise-and) -1) ; Arbitrary, but specified by srfi-33947 (test-equal "ior" (bitwise-ior #x0f #x1) #xf)948 (test-equal "zero-arg ior" (bitwise-ior) 0) ; Same949 (test-equal "xor" (bitwise-xor #x0f #x1) 14)950 (test-equal "zero-arg xor" (bitwise-xor) 0) ; Same951 (test-assert "not" (show (bitwise-not #x0f)))952 (test-error (bitwise-and 'x))953 (test-error (bitwise-xor 'x))954 (test-error (bitwise-ior 'x))955 (test-error (bitwise-and 1 'x))956 (test-error (bitwise-xor 1 'x))957 (test-error (bitwise-ior 1 'x))958 (test-error (bit->boolean 1 -1))959 (test-error (bit->boolean b1 -1))960 (test-error (bit->boolean 1 1.0))961 (test-error (bit->boolean 1.0 1))962 (test-equal (bit->boolean -1 b1) #t)963 (test-equal (bit->boolean 0 b1) #f)964 (test-equal (bit->boolean 5 2) #t)965 (test-equal (bit->boolean 5 0) #t)966 (test-equal (bit->boolean 5 1) #f)967 (test-equal (bit->boolean -2 0) #f)968 (test-equal (bit->boolean -2 1) #t)969 (test-equal (bit->boolean (expt -2 63) 256) #t)970 (test-equal (bit->boolean (expt -2 65) 256) #t)971 (test-equal (bit->boolean (expt -2 65) 1) #f)972 (test-equal (bit->boolean (expt -2 65) 0) #f)973 (test-equal (bit->boolean (expt -2 65) 65) #t)974 (test-equal (bit->boolean (expt 2 63) 256) #f)975 (test-equal (bit->boolean (expt 2 65) 256) #f)976 (test-equal (bit->boolean (expt 2 65) 65) #t)977 (test-equal (bit->boolean (expt 2 65) 1) #f)978 (test-equal (bit->boolean (expt 2 65) 0) #f)979 (test-equal (arithmetic-shift 15 2) 60)980 (test-equal (arithmetic-shift 15 -2) 3)981 (test-equal (arithmetic-shift -15 2) -60)982 (test-equal (arithmetic-shift -15 -2) -4) ; 2's complement983 (test-equal (arithmetic-shift -31 most-negative-fixnum) -1)984 (test-equal (arithmetic-shift 31 most-negative-fixnum) 0)985 (test-equal (arithmetic-shift b1 0) b1)986 (test-equal (arithmetic-shift (arithmetic-shift b1 -1) 1) b1)987 (test-error (arithmetic-shift 0.1 2))988 ;; XXX Do the following two need to fail? Might as well use the integral value989 (test-error (arithmetic-shift #xf 2.0))990 (test-error (arithmetic-shift #xf -2.0))991 (test-error (arithmetic-shift #xf 2.1))992 (test-error (arithmetic-shift #xf -2.1))993 (test-error (arithmetic-shift +inf.0 2))994 (test-error (arithmetic-shift +nan.0 2))995 (when 64-bits?996 (test-equal (arithmetic-shift (expt 2 31) (- (expt 2 31))) 0))997998 ;; by Jeremy Sydik999 (let ((leftrot321000 (lambda (value amount)1001 (let ((shifted (arithmetic-shift value amount)))1002 (let ((anded (bitwise-and #xFFFFFFFF shifted)))1003 (bitwise-ior anded1004 (arithmetic-shift shifted -32)))) )))1005 (test-equal "leftrot32 28" (leftrot32 1 28) 268435456)1006 (test-equal "leftrot32 29" (leftrot32 1 29) 536870912)1007 (test-equal "leftrot32 30" (leftrot32 1 30) 1073741824))1008)10091010(test-group "string conversion"10111012 (test-assert "fix" (number->string 123))1013 (test-assert "fix/base" (number->string 123 16))1014 (test-assert "flo" (number->string 99.2))1015 (test-assert "big" (number->string b1))1016 (test-assert "big/base" (number->string b1 2))1017 (test-assert "rat" (number->string r1))1018 (test-assert "comp" (number->string c1))10191020 (test-equal "edge case printing"1021 (number->string (expt 2 256) 16)1022 "10000000000000000000000000000000000000000000000000000000000000000")1023 (test-equal "non-exact multiple of 64 length edge case printing"1024 "4000000000000000000000" (number->string (expt 2 65) 8))1025 (test-equal "another non-exact multiple of 64 length edge case printing"1026 "200000000000000000000000" (number->string (expt 2 70) 8))1027 (test-equal "edge case length calculation"1028 "10000000000000000000000000000000000000000000000000000000000000000000000" (number->string (expt 2 210) 8))1029 (test-equal "positive hexdigit invariance"1030 (number->string1031 (string->number "123456789abcdef123456789abcdef123456789abcdef" 16)1032 16)1033 "123456789abcdef123456789abcdef123456789abcdef")1034 (test-equal "negative hexdigit invariance"1035 (number->string1036 (string->number "-123456789abcdef123456789abcdef123456789abcdef" 16)1037 16)1038 "-123456789abcdef123456789abcdef123456789abcdef")10391040 (test-equal "fix" (string->number "123") 123)1041 (test-equal "fix/base" (string->number "ff" 16) 255)1042 (test-equal "fix/base-o" (string->number "16" 8) 14)1043 (test-equal "fix/unusual-base" (string->number "1234" 5) 194)1044 (test-equal "fix/wrong-base" (string->number "1234" 4) #f)1045 (test-error "fix/invalid-base" (string->number "1234" 0))1046 (test-error "fix/invalid-base" (string->number "1234" 1))1047 (test-equal "embedded base overrides supplied base" (string->number "#x10" 10) 16)1048 (test-equal "flo" (string->number "123.23") 123.23)1049 (test-equal "flo2" (string->number "1e2") 100.0)1050 (test-assert "big" (show (string->number "123873487384737447")))1051 (test-assert "big/neg" (show (string->number "-123873487384737447")))1052 (test-assert "big/pos" (show (string->number "+123873487384737447")))1053 (test-assert "rat" (show (string->number "123/456")))1054 (test-assert "rat/neg" (show (string->number "-123/456")))1055 (test-assert "rat/pos" (show (string->number "+123/456")))1056 (test-assert "rat2" (show (string->number "#o123/456")))1057 (test-equal "rat/inexact" (show (string->number "#i123/456")) (/ 123.0 456))1058 (test-equal "invalid rat" (string->number "123/0") #f)1059 (test-assert "comp" (show (string->number "+12i")))1060 (test-assert "comp" (show (string->number "12+34i")))1061 (test-assert "comp" (show (string->number "-i")))1062 (test-assert "comp" (show (string->number "99@55")))1063 (test-assert "comp" (show (string->number "1/2@3/4")))1064 (test-assert "comp2" (show (string->number "#x99+55i")))1065 ;; This is to check for a silly problem cause by representing numbers exactly1066 ;; all the way until the end, then converting to inexact. This "silly problem"1067 ;; could probably be exploited in a resource consumption attack.1068 (let* ((t1 (current-seconds))1069 (i1 (string->number "1e1000000"))1070 (i2 (string->number "1.0e1000000"))1071 (e1 (string->number "#e1e1000000"))1072 (e2 (string->number "#e1.0e1000000"))1073 (t2 (current-seconds)))1074 (test-assert "read time for inexacts with large positive exp isn't insanely high" (< (- t2 t1) 2))1075 (test-equal "inexact read back are equal" i2 i1)1076 (test-equal "inexact are inf" +inf.0 i1)1077 (test-equal "exact are equal" e2 e1)1078 (test-equal "exact are false" #f e1))1079 (let* ((t1 (current-seconds))1080 (i1 (string->number "-1e1000000"))1081 (i2 (string->number "-1.0e1000000"))1082 (e1 (string->number "#e-1e1000000"))1083 (e2 (string->number "#e-1.0e1000000"))1084 (t2 (current-seconds)))1085 (test-assert "read time for inexacts with large positive exp isn't insanely high" (< (- t2 t1) 2))1086 (test-equal "negative inexact read back are equal" i2 i1)1087 (test-equal "negative inexact are negative inf" -inf.0 i1)1088 (test-equal "negative exact are equal" e2 e1)1089 (test-equal "negative exact are false" #f e1))1090 (let* ((t1 (current-seconds))1091 (i1 (string->number "1e-1000000"))1092 (i2 (string->number "1.0e-1000000"))1093 (e1 (string->number "#e1e-1000000"))1094 (e2 (string->number "#e1.0e-1000000"))1095 (t2 (current-seconds)))1096 (test-assert "read time for inexacts with large negative exp isn't insanely high" (< (- t2 t1) 2))1097 (test-equal "inexact read back are equal" i2 i1)1098 (test-equal "inexact are 0" +0.0 i1)1099 (test-equal "exact are equal" e2 e1)1100 (test-equal "exact are false" #f e1))11011102 (test-group "read/write invariance of simple integers for different radices"1103 (let lp ((radix 2)1104 (digit 0))1105 (cond ((= digit radix) (lp (add1 radix) 0))1106 ((<= radix 36)1107 (let* ((char (string-ref (number->string digit radix) 0))1108 (str (make-string 10 char)))1109 (test-equal (sprintf "radix ~A digits ~S" radix digit)1110 (number->string (string->number str) radix)1111 (if (char=? char #\0) "0" str)))))))1112)11131114(test-group "non-standard type procedures"11151116 (test-equal "fixnum" (fixnum? max-fix) #t)11171118 (test-equal "bignum" (bignum? b1) #t)1119 (test-equal "bignum" (bignum? min-big) #t)11201121 (test-equal "ratnum" (ratnum? r1) #t)11221123 (test-equal "nan: fix" (nan? 1) #f)1124 (test-equal "nan: flo" (nan? 1.0) #f)1125 (test-equal "nan: +inf" (nan? (/ 1.0 0.0)) #f)1126 (test-equal "nan: -inf" (nan? (/ -1.0 0.0)) #f)1127 (test-equal "nan: nan" (nan? (/ 0.0 0.0)) #t)1128 (test-equal "nan: nan+nani" (nan? (make-rectangular (/ 0.0 0.0) (/ 0.0 0.0))) #t)1129 (test-equal "nan: flo+nani" (nan? (make-rectangular 1.0 (/ 0.0 0.0))) #t)1130 (test-equal "nan: nan+floi" (nan? (make-rectangular (/ 0.0 0.0) 1.0)) #t)1131 (test-error "nan: no number" (nan? 'x))11321133 (test-equal "finite: fix" (finite? 1) #t)1134 (test-equal "finite: flo" (finite? 1.0) #t)1135 (test-equal "finite: +inf" (finite? (/ 1.0 0.0)) #f)1136 (test-equal "finite: -inf" (finite? (/ 1.0 0.0)) #f)1137 (test-equal "finite: nan" (finite? (/ 0.0 0.0)) #f)1138 (test-equal "finite: nan+floi" (finite? (make-rectangular (/ 0.0 0.0) 1.0)) #f)1139 (test-equal "finite: inf+infi" (finite? (make-rectangular (/ 1.0 0.0) (/ 1.0 0.0))) #f)1140 (test-equal "finite: flo+infi" (finite? (make-rectangular 1.0 (/ 1.0 0.0))) #f)1141 (test-equal "finite: inf+floi" (finite? (make-rectangular (/ 1.0 0.0) 1.0)) #f)1142 (test-error "finite: no number" (finite? 'x))11431144 (test-equal "infinite: fix" (infinite? 1) #f)1145 (test-equal "infinite: flo" (infinite? 1.0) #f)1146 (test-equal "infinite: +inf" (infinite? (/ 1.0 0.0)) #t)1147 (test-equal "infinite: -inf" (infinite? (/ 1.0 0.0)) #t)1148 (test-equal "infinite: nan" (infinite? (/ 0.0 0.0)) #f)1149 (test-equal "infinite: inf+infi" (infinite? (make-rectangular (/ 1.0 0.0) (/ 1.0 0.0))) #t)1150 (test-equal "infinite: flo+infi" (infinite? (make-rectangular 1.0 (/ 1.0 0.0))) #t)1151 (test-equal "infinite: inf+floi" (infinite? (make-rectangular (/ 1.0 0.0) 1.0)) #t)1152 (test-error "infinite: no number" (infinite? 'x))11531154 (test-equal "cplxnum: compintintnum" (cplxnum? c1) #t)1155 (test-equal "cplxnum: compintflointnum" (cplxnum? 1.0+1i) #t)1156 (test-equal "cplxnum: compflointnum" (cplxnum? c2) #t)1157 (test-equal "cplxnum: compfloflonum" (cplxnum? 3.4-4.3i) #t)1158 (test-equal "not cplxnum: fixnum" (cplxnum? 1) #f)1159)11601161;; The usual comparator doesn't work, because zero or a very small number1162;; is many times any other small number, but the absolute difference should1163;; be minimal, so we compare for that instead.1164(parameterize ((current-test-epsilon 1e-9)1165 (current-test-comparator1166 (lambda (exp act)1167 (or (and (nan? exp) (nan? act))1168 (and (or (eqv? (real-part exp) (real-part act))1169 (< (abs (- (real-part exp) (real-part act)))1170 (current-test-epsilon)))1171 (or (eqv? (imag-part exp) (imag-part act))1172 (< (abs (- (imag-part exp) (imag-part act)))1173 (current-test-epsilon))))))))11741175 ;; We're using (acos (cos x)) instead of just (acos y) because we want1176 ;; to test the compiler's specialization rules of cos output.11771178 (test-group "trigonometric functions"1179 (test-group "flonums"1180 (test-equal "acos(-inf)" (acos -inf.0)1181 (make-rectangular pi -inf.0))1182 (test-equal "acos(<small number>)" (real-part (acos -1e100)) pi)1183 (test-equal "cos(-1/3pi)" (cos (- (/ pi 3))) 0.5)1184 (test-equal "acos(cos(-1/3pi))" (acos (cos (- (/ pi 3)))) (/ pi 3))1185 (test-equal "cos(-1/4pi)" (cos (- (/ pi 4))) 0.7071067811865476)1186 (test-equal "acos(cos(-1/4pi))" (acos (cos (- (/ pi 4)))) (/ pi 4))1187 (test-equal "cos(-1/2pi)" (cos (- (/ pi 2))) 0.0)1188 (test-equal "acos(cos(-1/2pi))" (acos (cos (- (/ pi 2)))) (/ pi 2))1189 (test-equal "cos(-pi)" (cos (- pi)) -1.0)1190 (test-equal "acos(cos(-pi))" (acos (cos (- pi))) pi)1191 (test-equal "cos(0)" (cos 0.0) 1.0)1192 (test-equal "acos(cos(0))" (acos (cos 0.0)) 0.0)1193 (test-equal "cos( 1/4pi)" (cos (/ pi 4)) 0.7071067811865476)1194 (test-equal "acos(cos( 1/4pi))" (acos (cos (/ pi 4))) (/ pi 4))1195 (test-equal "cos( 1/3pi)" (cos (/ pi 3)) 0.5)1196 (test-equal "acos(cos( 1/3pi))" (acos (cos (/ pi 3))) (/ pi 3))1197 (test-equal "cos( 1/2pi)" (cos (/ pi 2)) 0.0)1198 (test-equal "acos(cos( 1/2pi))" (acos (cos (/ pi 2))) (/ pi 2))1199 (test-equal "cos( 2/3pi)" (cos (/ (* 2 pi) 3)) -0.5)1200 (test-equal "acos(cos( 2/3pi))" (acos (cos (/ (* 2 pi) 3))) (/ (* 2 pi) 3))1201 (test-equal "cos( 3/4pi)" (cos (* (/ pi 4) 3)) -0.7071067811865476)1202 (test-equal "acos(cos( 3/4pi))" (acos (cos (* (/ pi 4) 3))) (* (/ pi 4) 3))1203 (test-equal "cos( pi)" (cos pi) -1.0)1204 (test-equal "acos(cos( pi))" (acos (cos pi)) pi)1205 (test-equal "cos( 3/2pi)" (cos (+ pi (/ pi 2))) 0.0)1206 (test-equal "acos(cos( 3/2pi))" (acos (cos (+ pi (/ pi 2)))) (/ pi 2))1207 (test-equal "cos( 4/3pi)" (cos (+ pi (/ pi 3))) -0.5)1208 (test-equal "acos(cos( 4/3pi))" (acos (cos (+ pi (/ pi 3)))) (* 2 (/ pi 3)))1209 (test-equal "cos( 5/4pi)" (cos (+ pi (/ pi 4))) -0.7071067811865476)1210 (test-equal "acos(cos( 5/4pi))" (acos (cos (+ pi (/ pi 4)))) (* 3 (/ pi 4)))1211 (test-equal "cos( 2pi)" (cos (* 2 pi)) 1.0)1212 (test-equal "acos(cos( 2pi))" (acos (cos (* 2 pi))) 0)1213 (test-equal "acos(pi)" (acos pi) 0.0+1.81152627246085i)1214 (test-equal "acos(+inf)" (acos +inf.0) 0+inf.0i)12151216 (test-equal "asin(-inf)" (asin -inf.0)1217 (make-rectangular (- (/ pi 2)) +inf.0))1218 (test-equal "asin(<small number>)" (real-part (asin -1e100)) (- (/ pi 2)))1219 (test-equal "sin(-1/3pi)" (sin (- (/ pi 3))) -0.8660254037844386)1220 (test-equal "asin(sin(-1/3pi))" (asin (sin (- (/ pi 3)))) (- (/ pi 3)))1221 (test-equal "sin(-1/4pi)" (sin (- (/ pi 4))) -0.7071067811865476)1222 (test-equal "asin(sin(-1/4pi))" (asin (sin (- (/ pi 4)))) (- (/ pi 4)))1223 (test-equal "sin(-1/2pi)" (sin (- (/ pi 2))) -1.0)1224 (test-equal "asin(sin(-1/2pi))" (asin (sin (- (/ pi 2)))) (- (/ pi 2)))1225 (test-equal "sin(-pi)" (sin (- pi)) 0.0)1226 (test-equal "asin(sin(-pi))" (asin (sin (- pi))) 0.0)1227 (test-equal "sin(0)" (sin 0.0) 0.0)1228 (test-equal "asin(sin(0))" (asin (sin 0.0)) 0.0)1229 (test-equal "sin( 1/4pi)" (sin (/ pi 4)) 0.7071067811865476)1230 (test-equal "asin(sin( 1/4pi))" (asin (sin (/ pi 4))) (/ pi 4))1231 (test-equal "sin( 1/3pi)" (sin (/ pi 3)) 0.8660254037844386)1232 (test-equal "asin(sin( 1/3pi))" (asin (sin (/ pi 3))) (/ pi 3))1233 (test-equal "sin( 1/2pi)" (sin (/ pi 2)) 1.0)1234 (test-equal "asin(sin( 1/2pi))" (asin (sin (/ pi 2))) (/ pi 2))1235 (test-equal "sin( 2/3pi)" (sin (/ (* 2 pi) 3)) 0.8660254037844386)1236 (test-equal "asin(sin( 2/3pi))" (asin (sin (/ (* 2 pi) 3))) (/ pi 3))1237 (test-equal "sin( 3/4pi)" (sin (* (/ pi 4) 3)) 0.7071067811865476)1238 (test-equal "asin(sin( 3/4pi))" (asin (sin (* (/ pi 4) 3))) (/ pi 4))1239 (test-equal "sin( pi)" (sin pi) 0.0)1240 (test-equal "asin(sin( pi))" (asin (sin pi)) 0.0)1241 (test-equal "sin( 3/2pi)" (sin (+ pi (/ pi 2))) -1.0)1242 (test-equal "asin(sin( 3/2pi))" (asin (sin (+ pi (/ pi 2)))) (- (/ pi 2)))1243 (test-equal "sin( 4/3pi)" (sin (+ pi (/ pi 3))) -0.8660254037844386)1244 (test-equal "asin(sin( 4/3pi))" (asin (sin (+ pi (/ pi 3)))) (- (/ pi 3)))1245 (test-equal "sin( 5/4pi)" (sin (+ pi (/ pi 4))) -0.7071067811865476)1246 (test-equal "asin(sin( 5/4pi))" (asin (sin (+ pi (/ pi 4)))) (- (/ pi 4)))1247 (test-equal "sin( 2pi)" (sin (* 2 pi)) 0.0)1248 (test-equal "asin(sin( 2pi))" (asin (sin (* 2 pi))) 0.0)1249 (test-equal "asin(pi)" (real-part (asin pi)) (/ pi 2))1250 (test-equal "asin(+inf)" (asin +inf.0)1251 (make-rectangular (/ pi 2) +inf.0))12521253 (test-equal "atan(-inf)" (atan -inf.0) (- (/ pi 2)))1254 (test-equal "atan(<small number>)" (atan -1e100) (- (/ pi 2)))1255 (test-equal "tan(-1/3pi)" (tan (- (/ pi 3))) -1.7320508075688773)1256 (test-equal "atan(tan(-1/3pi))" (atan (tan (- (/ pi 3)))) (- (/ pi 3)))1257 (test-equal "tan(-1/4pi)" (tan (- (/ pi 4))) -1.0)1258 (test-equal "atan(tan(-1/4pi))" (atan (tan (- (/ pi 4)))) (- (/ pi 4)))1259 ;; NOTE: tan(-(/ pi 2)) should be -inf(?), but isn't. Is that a bug?1260 (test-equal "tan(-pi)" (tan (- pi)) 0.0)1261 (test-equal "atan(tan(-pi))" (atan (tan (- pi))) 0.0)1262 (test-equal "tan(0)" (tan 0.0) 0.0)1263 (test-equal "atan(tan(0))" (atan (tan 0.0)) 0.0)1264 (test-equal "tan( 1/4pi)" (tan (/ pi 4)) 1.0)1265 (test-equal "atan(tan( 1/4pi))" (atan (tan (/ pi 4))) (/ pi 4))1266 (test-equal "tan( 1/3pi)" (tan (/ pi 3)) 1.7320508075688773)1267 (test-equal "atan(tan( 1/3pi))" (atan (tan (/ pi 3))) (/ pi 3))1268 (test-equal "tan( 2/3pi)" (tan (/ (* 2 pi) 3)) -1.7320508075688773)1269 (test-equal "atan(tan( 2/3pi))" (atan (tan (/ (* 2 pi) 3))) (- (/ pi 3)))1270 (test-equal "tan( 3/4pi)" (tan (* (/ pi 4) 3)) -1.0)1271 (test-equal "atan(tan( 3/4pi))" (atan (tan (* (/ pi 4) 3))) (- (/ pi 4)))1272 (test-equal "tan( pi)" (tan pi) 0.0)1273 (test-equal "atan(tan( pi))" (atan (tan pi)) 0.0)1274 (test-equal "tan( 4/3pi)" (tan (+ pi (/ pi 3))) 1.7320508075688773)1275 (test-equal "atan(tan( 4/3pi))" (atan (tan (+ pi (/ pi 3)))) (/ pi 3))1276 (test-equal "tan( 5/4pi)" (tan (+ pi (/ pi 4))) 1.0)1277 (test-equal "atan(tan( 5/4pi))" (atan (tan (+ pi (/ pi 4)))) (/ pi 4))1278 (test-equal "tan( 2pi)" (tan (* 2 pi)) 0.0)1279 (test-equal "atan(tan( 2pi))" (atan (tan (* 2 pi))) 0.0)1280 (test-equal "atan(pi)" (atan 1e100) (/ pi 2))1281 (test-equal "atan(+inf)" (atan +inf.0) (/ pi 2))12821283 (test-equal "atan2(3, tan(pi))" (atan 3 (tan pi)) (/ pi 2))1284 (test-equal "atan2(3, -tan(pi))" (atan 3 (- (tan pi))) (/ pi 2))1285 (test-equal "atan2(-3, tan(pi))" (atan -3 (tan pi)) (- (/ pi 2)))1286 (test-equal "atan2(-3, -tan(pi))" (atan -3 (- (tan pi))) (- (/ pi 2)))1287 ;; Equivalence described in R5RS1288 (test-equal "atan2(1, 2) = angle(2+i)"1289 (angle (make-rectangular 2 1)) (atan 1 2))1290 (test-equal "atan2(1, b1) = angle(2+i)"1291 (angle (make-rectangular b1 1)) (atan 1 b1))1292 (test-equal "atan2(b1, 1) = angle(2+i)"1293 (angle (make-rectangular 1 b1)) (atan b1 1))1294 (test-equal "atan2(-0.1, 3.2) = angle(3.2-0.1i)"1295 (angle (make-rectangular 3.2 -0.1)) (atan -0.1 3.2))1296 )12971298 ;; Cross-checked against Gauche and Scheme48's output1299 (test-group "compnums"1300 (test-equal "cos(0.0+1.0i)" (cos (make-rectangular 0.0 1.0))1301 1.5430806348152437)1302 (test-equal "acos(cos(0.0+1.0i))" (acos (cos (make-rectangular 0.0 1.0)))1303 0.0+1.0i)1304 (test-equal "cos(0.0-1.0i)" (cos (make-rectangular 0.0 -1.0))1305 1.5430806348152437)1306 (test-equal "acos(cos(0.0-1.0i))" (acos (cos (make-rectangular 0.0 -1.0)))1307 0.0+1.0i)1308 (test-equal "cos(0.0+3.0i)" (cos (make-rectangular 0.0 3.0))1309 10.067661995777765)1310 (test-equal "acos(cos(0.0+3.0i))" (acos (cos (make-rectangular 0.0 3.0)))1311 0.0+3.0i)1312 (test-equal "cos(0.0-3.0i)" (cos (make-rectangular 0.0 -3.0))1313 10.067661995777765)1314 (test-equal "acos(cos(0.0-3.0i))" (acos (cos (make-rectangular 0.0 -3.0)))1315 0.0+3.0i)1316 (test-equal "cos(0.5+0.5i)"1317 (cos (make-rectangular 0.5 0.5))1318 (make-rectangular 0.9895848833999199 -0.24982639750046154))1319 (test-equal "acos(cos(0.5+0.5i))"1320 (acos (cos (make-rectangular 0.5 0.5)))1321 (make-rectangular 0.5 0.5))1322 (test-equal "cos(0.5-0.5i)"1323 (cos (make-rectangular 0.5 -0.5))1324 (make-rectangular 0.9895848833999199 0.24982639750046154))1325 (test-equal "acos(cos(0.5-0.5i))"1326 (acos (cos (make-rectangular 0.5 -0.5)))1327 (make-rectangular 0.5 -0.5))1328 (test-equal "cos(-0.5-0.5i)"1329 (cos (make-rectangular -0.5 -0.5))1330 (make-rectangular 0.9895848833999199 -0.24982639750046154))1331 (test-equal "acos(cos(-0.5-0.5i))"1332 (acos (cos (make-rectangular -0.5 -0.5)))1333 (make-rectangular 0.5 0.5))1334 (test-equal "cos(-0.5+0.5i)"1335 (cos (make-rectangular -0.5 0.5))1336 (make-rectangular 0.9895848833999199 0.24982639750046154))1337 (test-equal "acos(cos(-0.5+0.5i))"1338 (acos (cos (make-rectangular -0.5 0.5)))1339 (make-rectangular 0.5 -0.5))1340 (test-equal "cos(-1.0+1.0i)"1341 (cos (make-rectangular -1.0 1.0))1342 (make-rectangular 0.8337300251311491 0.9888977057628651))1343 (test-equal "acos(cos(-1.0+1.0i))"1344 (acos (cos (make-rectangular -1.0 1.0)))1345 (make-rectangular 1.0 -1.0))1346 (test-equal "cos(-1.0-1.0i)"1347 (cos (make-rectangular -1.0 -1.0))1348 (make-rectangular 0.8337300251311491 -0.9888977057628651))1349 (test-equal "acos(cos(-1.0-1.0i))"1350 (acos (cos (make-rectangular -1.0 -1.0)))1351 (make-rectangular 1.0 1.0))1352 (test-equal "cos(1.0-1.0i)"1353 (cos (make-rectangular 1.0 -1.0))1354 (make-rectangular 0.8337300251311491 0.9888977057628651))1355 (test-equal "acos(cos(1.0-1.0i))"1356 (acos (cos (make-rectangular 1.0 -1.0)))1357 (make-rectangular 1.0 -1.0))1358 (test-equal "cos(1.0+1.0i)"1359 (cos (make-rectangular 1.0 1.0))1360 (make-rectangular 0.8337300251311491 -0.9888977057628651))1361 (test-equal "acos(cos(1.0+1.0i))"1362 (acos (cos (make-rectangular 1.0 1.0)))1363 (make-rectangular 1.0 1.0))1364 (test-equal "cos(2.0+3.0i)"1365 (cos (make-rectangular 2.0 3.0))1366 (make-rectangular -4.189625690968807 -9.109227893755337))1367 (test-equal "acos(cos(2.0+3.0i))"1368 (acos (cos (make-rectangular 2.0 3.0)))1369 (make-rectangular 2.0 3.0))1370 (test-equal "cos(-2.0+3.0i)"1371 (cos (make-rectangular -2.0 3.0))1372 (make-rectangular -4.189625690968807 9.109227893755337))1373 (test-equal "acos(cos(-2.0+3.0i))"1374 (acos (cos (make-rectangular -2.0 3.0)))1375 (make-rectangular 2.0 -3.0))1376 (test-equal "cos(-2.0-3.0i)"1377 (cos (make-rectangular -2.0 -3.0))1378 (make-rectangular -4.189625690968807 -9.109227893755337))1379 (test-equal "acos(cos(-2.0-3.0i))"1380 (acos (cos (make-rectangular -2.0 -3.0)))1381 (make-rectangular 2.0 3.0))1382 (test-equal "cos(2.0-3.0i)"1383 (cos (make-rectangular 2.0 -3.0))1384 (make-rectangular -4.189625690968807 9.109227893755337))1385 (test-equal "acos(cos(2.0-3.0i))"1386 (acos (cos (make-rectangular 2.0 -3.0)))1387 (make-rectangular 2.0 -3.0))1388 ;; Specialization check1389 (test-equal "cos(acos(2.0-3.0i))"1390 (cos (acos (make-rectangular 2.0 -3.0)))1391 (make-rectangular 2.0 -3.0))13921393 (test-equal "sin(0.0+1.0i)"1394 (sin (make-rectangular 0.0 1.0))1395 (make-rectangular 0.0 1.1752011936438014))1396 (test-equal "asin(sin(0.0+1.0i))"1397 (asin (sin (make-rectangular 0.0 1.0)))1398 (make-rectangular 0.0 1.0))1399 (test-equal "sin(0.0-1.0i)"1400 (sin (make-rectangular 0.0 -1.0))1401 (make-rectangular 0.0 -1.1752011936438014))1402 (test-equal "asin(sin(0.0-1.0i))"1403 (asin (sin (make-rectangular 0.0 -1.0)))1404 (make-rectangular 0.0 -1.0))1405 (test-equal "sin(0.0+3.0i)"1406 (sin (make-rectangular 0.0 3.0))1407 (make-rectangular 0.0 10.017874927409903))1408 (test-equal "asin(sin(0.0+3.0i))"1409 (asin (sin (make-rectangular 0.0 3.0)))1410 (make-rectangular 0.0 3.0))1411 (test-equal "sin(0.0-3.0i)"1412 (sin (make-rectangular 0.0 -3.0))1413 (make-rectangular 0.0 -10.017874927409903))1414 (test-equal "asin(sin(0.0-3.0i))"1415 (asin (sin (make-rectangular 0.0 -3.0)))1416 (make-rectangular 0.0 -3.0))1417 (test-equal "sin(0.5+0.5i)"1418 (sin (make-rectangular 0.5 0.5))1419 (make-rectangular 0.5406126857131534 0.4573041531842493))1420 (test-equal "asin(sin(0.5+0.5i))"1421 (asin (sin (make-rectangular 0.5 0.5)))1422 (make-rectangular 0.5 0.5))1423 (test-equal "sin(0.5-0.5i)"1424 (sin (make-rectangular 0.5 -0.5))1425 (make-rectangular 0.5406126857131534 -0.4573041531842493))1426 (test-equal "asin(sin(0.5-0.5i))"1427 (asin (sin (make-rectangular 0.5 -0.5)))1428 (make-rectangular 0.5 -0.5))1429 (test-equal "sin(-0.5-0.5i)"1430 (sin (make-rectangular -0.5 -0.5))1431 (make-rectangular -0.5406126857131534 -0.4573041531842493))1432 (test-equal "asin(sin(-0.5-0.5i))"1433 (asin (sin (make-rectangular -0.5 -0.5)))1434 (make-rectangular -0.5 -0.5))1435 (test-equal "sin(-0.5+0.5i)"1436 (sin (make-rectangular -0.5 0.5))1437 (make-rectangular -0.5406126857131534 +0.457304153184249))1438 (test-equal "asin(sin(-0.5+0.5i))"1439 (asin (sin (make-rectangular -0.5 0.5)))1440 (make-rectangular -0.5 +0.5))1441 (test-equal "sin(-1.0+1.0i)"1442 (sin (make-rectangular -1.0 1.0))1443 (make-rectangular -1.2984575814159773 0.6349639147847361))1444 (test-equal "asin(sin(-1.0+1.0i))"1445 (asin (sin (make-rectangular -1.0 1.0)))1446 (make-rectangular -1.0 1.0))1447 (test-equal "sin(-1.0-1.0i)"1448 (sin (make-rectangular -1.0 -1.0))1449 (make-rectangular -1.2984575814159773 -0.6349639147847361))1450 (test-equal "asin(sin(-1.0-1.0i))"1451 (asin (sin (make-rectangular -1.0 -1.0)))1452 (make-rectangular -1.0 -1.0))1453 (test-equal "sin(1.0-1.0i)"1454 (sin (make-rectangular 1.0 -1.0))1455 (make-rectangular 1.2984575814159773 -0.6349639147847361))1456 (test-equal "asin(sin(1.0-1.0i))"1457 (asin (sin (make-rectangular 1.0 -1.0)))1458 (make-rectangular 1.0 -1.0))1459 (test-equal "sin(2.0+3.0i)"1460 (sin (make-rectangular 2.0 3.0))1461 (make-rectangular 9.15449914691143 -4.168906959966565))1462 (test-equal "asin(sin(2.0+3.0i))"1463 (asin (sin (make-rectangular 2.0 3.0)))1464 (make-rectangular 1.1415926535898042 -3.0))1465 (test-equal "sin(-2.0+3.0i)"1466 (sin (make-rectangular -2.0 3.0))1467 (make-rectangular -9.15449914691143 -4.168906959966565))1468 (test-equal "asin(sin(-2.0+3.0i))"1469 (asin (sin (make-rectangular -2.0 3.0)))1470 (make-rectangular -1.1415926535898042 -3.0))1471 (test-equal "sin(-2.0-3.0i)"1472 (sin (make-rectangular -2.0 -3.0))1473 (make-rectangular -9.15449914691143 4.168906959966565))1474 (test-equal "asin(sin(-2.0-3.0i))"1475 (asin (sin (make-rectangular -2.0 -3.0)))1476 (make-rectangular -1.1415926535898042 3.0))1477 (test-equal "sin(2.0-3.0i)"1478 (sin (make-rectangular 2.0 -3.0))1479 (make-rectangular 9.15449914691143 4.168906959966565))1480 (test-equal "asin(sin(2.0-3.0i))"1481 (asin (sin (make-rectangular 2.0 -3.0)))1482 (make-rectangular 1.1415926535898042 3.0))1483 ;; Specialization check1484 (test-equal "sin(asin(1.1415926535898042+3.0i))"1485 (sin (asin (make-rectangular 2.0 3.0)))1486 (make-rectangular 2.0 3.0))14871488 (test-equal "tan(0.0+1.0i)"1489 (tan (make-rectangular 0.0 1.0))1490 (make-rectangular 0.0 0.7615941559557649))1491 (test-equal "atan(tan(0.0+1.0i))"1492 (atan (tan (make-rectangular 0.0 1.0)))1493 (make-rectangular 0.0 1.0))1494 (test-equal "tan(0.0-1.0i)"1495 (tan (make-rectangular 0.0 -1.0))1496 (make-rectangular 0.0 -0.7615941559557649))1497 (test-equal "atan(tan(0.0-1.0i))"1498 (atan (tan (make-rectangular 0.0 -1.0)))1499 (make-rectangular 0.0 -1.0))1500 (test-equal "tan(0.0+3.0i)"1501 (tan (make-rectangular 0.0 3.0))1502 (make-rectangular 0.0 0.9950547536867306))1503 (test-equal "atan(tan(0.0+3.0i))"1504 (atan (tan (make-rectangular 0.0 3.0)))1505 (make-rectangular 0.0 3.0))1506 (test-equal "tan(0.0-3.0i)"1507 (tan (make-rectangular 0.0 -3.0))1508 (make-rectangular 0.0 -0.9950547536867306))1509 (test-equal "atan(tan(0.0-3.0i))"1510 (atan (tan (make-rectangular 0.0 -3.0)))1511 (make-rectangular 0.0 -3.0))1512 (test-equal "tan(0.5+0.5i)"1513 (tan (make-rectangular 0.5 0.5))1514 (make-rectangular 0.4038964553160257 0.5640831412674985))1515 (test-equal "atan(tan(0.5+0.5i))"1516 (atan (tan (make-rectangular 0.5 0.5)))1517 (make-rectangular 0.5 0.5))1518 (test-equal "tan(0.5-0.5i)"1519 (tan (make-rectangular 0.5 -0.5))1520 (make-rectangular 0.4038964553160257 -0.5640831412674985))1521 (test-equal "atan(tan(0.5-0.5i))"1522 (atan (tan (make-rectangular 0.5 -0.5)))1523 (make-rectangular 0.5 -0.5))1524 (test-equal "tan(-0.5-0.5i)"1525 (tan (make-rectangular -0.5 -0.5))1526 (make-rectangular -0.4038964553160257 -0.5640831412674985))1527 (test-equal "atan(tan(-0.5-0.5i))"1528 (atan (tan (make-rectangular -0.5 -0.5)))1529 (make-rectangular -0.5 -0.5))1530 (test-equal "tan(-0.5+0.5i)"1531 (tan (make-rectangular -0.5 0.5))1532 (make-rectangular -0.4038964553160257 0.5640831412674985))1533 (test-equal "atan(tan(-0.5+0.5i))"1534 (atan (tan (make-rectangular -0.5 0.5)))1535 (make-rectangular -0.5 0.5))1536 (test-equal "tan(-1.0+1.0i)"1537 (tan (make-rectangular -1.0 1.0))1538 (make-rectangular -0.27175258531951174 1.0839233273386948))1539 (test-equal "atan(tan(-1.0+1.0i))"1540 (atan (tan (make-rectangular -1.0 1.0)))1541 (make-rectangular -1.0 1.0))1542 (test-equal "tan(-1.0-1.0i)"1543 (tan (make-rectangular -1.0 -1.0))1544 (make-rectangular -0.27175258531951174 -1.0839233273386948))1545 (test-equal "atan(tan(-1.0-1.0i))"1546 (atan (tan (make-rectangular -1.0 -1.0)))1547 (make-rectangular -1.0 -1.0))1548 (test-equal "tan(1.0-1.0i)"1549 (tan (make-rectangular 1.0 -1.0))1550 (make-rectangular 0.27175258531951174 -1.0839233273386948))1551 (test-equal "atan(tan(1.0-1.0i))"1552 (atan (tan (make-rectangular 1.0 -1.0)))1553 (make-rectangular 1.0 -1.0))1554 (test-equal "tan(2.0+3.0i)"1555 (tan (make-rectangular 2.0 3.0))1556 (make-rectangular -0.0037640256415040815 1.0032386273536098))1557 (test-equal "atan(tan(2.0+3.0i))"1558 (atan (tan (make-rectangular 2.0 3.0)))1559 (make-rectangular -1.1415926535898042 3.0))1560 (test-equal "tan(-2.0+3.0i)"1561 (tan (make-rectangular -2.0 3.0))1562 (make-rectangular 0.0037640256415040815 1.0032386273536098))1563 (test-equal "atan(tan(-2.0+3.0i))"1564 (atan (tan (make-rectangular -2.0 3.0)))1565 (make-rectangular 1.1415926535898042 3.0))1566 (test-equal "tan(-2.0-3.0i)"1567 (tan (make-rectangular -2.0 -3.0))1568 (make-rectangular 0.0037640256415040815 -1.0032386273536098))1569 (test-equal "atan(tan(-2.0-3.0i))"1570 (atan (tan (make-rectangular -2.0 -3.0)))1571 (make-rectangular 1.1415926535898042 -3.0))1572 (test-equal "tan(2.0-3.0i)"1573 (tan (make-rectangular 2.0 -3.0))1574 (make-rectangular -0.0037640256415040815 -1.0032386273536098))1575 (test-equal "atan(tan(2.0-3.0i))"1576 (atan (tan (make-rectangular 2.0 -3.0)))1577 (make-rectangular -1.1415926535898042 -3.0))1578 ;; Specialization check1579 (test-equal "tan(atan(2.0-3.0i))"1580 (tan (atan (make-rectangular 2.0 -3.0)))1581 (make-rectangular 2.0 -3.0))15821583 )15841585 ;; This is just a handful to determine that we're able to accept these.1586 ;; Maybe determine better values to test with?1587 (test-group "bignums"1588 ;; These are bogus but I don't want to1589 ;; "fix" them by copying the output and assume it's alright.1590 #;(test-equal "acos(<negative bignum>)" (acos (- b1)) -nan.0)1591 #;(test-equal "acos(<bignum>)" (acos b1) +nan.0)1592 #;(test-equal "asin(<negative bignum>)" (asin (- b1)) -nan.0)1593 #;(test-equal "asin(<bignum>)" (asin b1) +nan.0)1594 (test-equal "atan(<negative bignum>)" (atan (- b1)) (- (/ pi 2)))1595 (test-equal "atan(<bignum>)" (atan b1) (/ pi 2)))15961597 ;; This should probably be enough; we're only testing conversion to flonums1598 ;; and specialization. The actual functionality of cos is checked above.1599 (test-group "fixnums"1600 (test-equal "cos(0)" (cos 0) 1.0)1601 (test-equal "acos(0)" (acos 0) (/ pi 2))1602 (test-equal "cos(1)" (cos 1) (cos 1.0))1603 (test-equal "acos(1)" (acos 1) 0.0)1604 (test-equal "cos(-1)" (cos -1) (cos -1.0))1605 (test-equal "acos(-1)" (acos -1) pi)1606 (test-equal "acos(-2)" (acos -2) (make-rectangular pi -1.31695789692482))1607 (test-equal "acos(2)" (acos 2) 0.0+1.31695789692482i)1608 (test-equal "asin(1)" (asin 1) (/ pi 2))1609 (test-equal "asin(-1)" (asin -1) (/ pi -2))1610 (test-equal "asin(2)" (asin 2) (make-rectangular (/ pi 2) -1.31695789692482))1611 (test-equal "asin(-2)" (asin -2) (make-rectangular (/ pi -2) 1.31695789692482)))16121613 (test-group "ratnums"1614 (test-equal "cos(-1/3pi)" (cos (- (/ ratpi 3))) 0.5)1615 (test-equal "acos(cos(-1/3pi))" (acos (cos (- (/ ratpi 3)))) (/ pi 3))1616 (test-equal "cos(-1/4pi)" (cos (- (/ ratpi 4))) 0.7071067811865476)1617 (test-equal "acos(cos(-1/4pi))" (acos (cos (- (/ ratpi 4)))) (/ pi 4))1618 (test-equal "cos(-1/2pi)" (cos (- (/ ratpi 2))) 0.0)1619 (test-equal "acos(cos(-1/2pi))" (acos (cos (- (/ ratpi 2)))) (/ pi 2))1620 (test-equal "cos(-pi)" (cos (- ratpi)) -1.0)1621 (test-equal "acos(cos(-pi))" (acos (cos (- ratpi))) pi)1622 (test-equal "cos(0)" (cos 0.0) 1.0)1623 (test-equal "acos(cos(0))" (acos (cos 0.0)) 0.0)1624 (test-equal "cos( 1/4pi)" (cos (/ ratpi 4)) 0.7071067811865476)1625 (test-equal "acos(cos( 1/4pi))" (acos (cos (/ ratpi 4))) (/ pi 4))1626 (test-equal "cos( 1/3pi)" (cos (/ ratpi 3)) 0.5)1627 (test-equal "acos(cos( 1/3pi))" (acos (cos (/ ratpi 3))) (/ pi 3))1628 (test-equal "cos( 1/2pi)" (cos (/ ratpi 2)) 0.0)1629 (test-equal "acos(cos( 1/2pi))" (acos (cos (/ ratpi 2))) (/ pi 2))1630 (test-equal "cos( 2/3pi)" (cos (/ (* 2 ratpi) 3)) -0.5)1631 (test-equal "acos(cos( 2/3pi))" (acos (cos (/ (* 2 ratpi) 3))) (/ (* 2 pi) 3))1632 (test-equal "cos( 3/4pi)" (cos (* (/ ratpi 4) 3)) -0.7071067811865476)1633 (test-equal "acos(cos( 3/4pi))" (acos (cos (* (/ ratpi 4) 3))) (* (/ pi 4) 3))1634 (test-equal "cos( pi)" (cos ratpi) -1.0)1635 (test-equal "acos(cos( pi))" (acos (cos ratpi)) pi)1636 (test-equal "cos( 3/2pi)" (cos (+ ratpi (/ ratpi 2))) 0.0)1637 (test-equal "acos(cos( 3/2pi))" (acos (cos (+ ratpi (/ ratpi 2)))) (/ pi 2))1638 (test-equal "cos( 4/3pi)" (cos (+ ratpi (/ ratpi 3))) -0.5)1639 (test-equal "acos(cos( 4/3pi))" (acos (cos (+ ratpi (/ ratpi 3)))) (* 2 (/ pi 3)))1640 (test-equal "cos( 5/4pi)" (cos (+ ratpi (/ ratpi 4))) -0.7071067811865476)1641 (test-equal "acos(cos( 5/4pi))" (acos (cos (+ ratpi (/ ratpi 4)))) (* 3 (/ pi 4)))1642 (test-equal "cos( 2pi)" (cos (* 2 pi)) 1.0)1643 (test-equal "acos(cos( 2pi))" (acos (cos (* 2 ratpi))) 0)16441645 (test-equal "sin(-1/3pi)" (sin (- (/ ratpi 3))) -0.8660254037844386)1646 (test-equal "asin(sin(-1/3pi))" (asin (sin (- (/ ratpi 3)))) (- (/ pi 3)))1647 (test-equal "sin(-1/4pi)" (sin (- (/ ratpi 4))) -0.7071067811865476)1648 (test-equal "asin(sin(-1/4pi))" (asin (sin (- (/ ratpi 4)))) (- (/ pi 4)))1649 (test-equal "sin(-1/2pi)" (sin (- (/ ratpi 2))) -1.0)1650 (test-equal "asin(sin(-1/2pi))" (asin (sin (- (/ ratpi 2)))) (- (/ pi 2)))1651 (test-equal "sin(-pi)" (sin (- ratpi)) 0.0)1652 (test-equal "asin(sin(-pi))" (asin (sin (- ratpi))) 0.0)1653 (test-equal "sin(0)" (sin 0.0) 0.0)1654 (test-equal "asin(sin(0))" (asin (sin 0.0)) 0.0)1655 (test-equal "sin( 1/4pi)" (sin (/ ratpi 4)) 0.7071067811865476)1656 (test-equal "asin(sin( 1/4pi))" (asin (sin (/ ratpi 4))) (/ pi 4))1657 (test-equal "sin( 1/3pi)" (sin (/ ratpi 3)) 0.8660254037844386)1658 (test-equal "asin(sin( 1/3pi))" (asin (sin (/ ratpi 3))) (/ pi 3))1659 (test-equal "sin( 1/2pi)" (sin (/ ratpi 2)) 1.0)1660 (test-equal "asin(sin( 1/2pi))" (asin (sin (/ ratpi 2))) (/ pi 2))1661 (test-equal "sin( 2/3pi)" (sin (/ (* 2 ratpi) 3)) 0.8660254037844386)1662 (test-equal "asin(sin( 2/3pi))" (asin (sin (/ (* 2 ratpi) 3))) (/ pi 3))1663 (test-equal "sin( 3/4pi)" (sin (* (/ ratpi 4) 3)) 0.7071067811865476)1664 (test-equal "asin(sin( 3/4pi))" (asin (sin (* (/ ratpi 4) 3))) (/ pi 4))1665 (test-equal "sin( pi)" (sin ratpi) 0.0)1666 (test-equal "asin(sin( pi))" (asin (sin ratpi)) 0.0)1667 (test-equal "sin( 3/2pi)" (sin (+ ratpi (/ ratpi 2))) -1.0)1668 (test-equal "asin(sin( 3/2pi))" (asin (sin (+ ratpi (/ ratpi 2)))) (- (/ pi 2)))1669 (test-equal "sin( 4/3pi)" (sin (+ ratpi (/ ratpi 3))) -0.8660254037844386)1670 (test-equal "asin(sin( 4/3pi))" (asin (sin (+ ratpi (/ ratpi 3)))) (- (/ pi 3)))1671 (test-equal "sin( 5/4pi)" (sin (+ ratpi (/ ratpi 4))) -0.7071067811865476)1672 (test-equal "asin(sin( 5/4pi))" (asin (sin (+ ratpi (/ ratpi 4)))) (- (/ pi 4)))1673 (test-equal "sin( 2pi)" (sin (* 2 ratpi)) 0.0)1674 (test-equal "asin(sin( 2pi))" (asin (sin (* 2 ratpi))) 0.0)16751676 (test-equal "tan(-1/3pi)" (tan (- (/ ratpi 3))) -1.7320508075688773)1677 (test-equal "atan(tan(-1/3pi))" (atan (tan (- (/ ratpi 3)))) (- (/ pi 3)))1678 (test-equal "tan(-1/4pi)" (tan (- (/ ratpi 4))) -1.0)1679 (test-equal "atan(tan(-1/4pi))" (atan (tan (- (/ ratpi 4)))) (- (/ pi 4)))1680 ;; NOTE: tan(-(/ pi 2)) should be -inf(?), but isn't. Is that a bug?1681 (test-equal "tan(-pi)" (tan (- ratpi)) 0.0)1682 (test-equal "atan(tan(-pi))" (atan (tan (- ratpi))) 0.0)1683 (test-equal "tan(0)" (tan 0.0) 0.0)1684 (test-equal "atan(tan(0))" (atan (tan 0.0)) 0.0)1685 (test-equal "tan( 1/4pi)" (tan (/ ratpi 4)) 1.0)1686 (test-equal "atan(tan( 1/4pi))" (atan (tan (/ ratpi 4))) (/ pi 4))1687 (test-equal "tan( 1/3pi)" (tan (/ ratpi 3)) 1.7320508075688773)1688 (test-equal "atan(tan( 1/3pi))" (atan (tan (/ ratpi 3))) (/ pi 3))1689 (test-equal "tan( 2/3pi)" (tan (/ (* 2 ratpi) 3)) -1.7320508075688773)1690 (test-equal "atan(tan( 2/3pi))" (atan (tan (/ (* 2 ratpi) 3))) (- (/ pi 3)))1691 (test-equal "tan( 3/4pi)" (tan (* (/ ratpi 4) 3)) -1.0)1692 (test-equal "atan(tan( 3/4pi))" (atan (tan (* (/ ratpi 4) 3))) (- (/ pi 4)))1693 (test-equal "tan( pi)" (tan ratpi) 0.0)1694 (test-equal "atan(tan( pi))" (atan (tan ratpi)) 0.0)1695 (test-equal "tan( 4/3pi)" (tan (+ ratpi (/ ratpi 3))) 1.7320508075688773)1696 (test-equal "atan(tan( 4/3pi))" (atan (tan (+ ratpi (/ ratpi 3)))) (/ pi 3))1697 (test-equal "tan( 5/4pi)" (tan (+ ratpi (/ ratpi 4))) 1.0)1698 (test-equal "atan(tan( 5/4pi))" (atan (tan (+ ratpi (/ ratpi 4)))) (/ pi 4))1699 (test-equal "tan( 2pi)" (tan (* 2 ratpi)) 0.0)1700 (test-equal "atan(tan( 2i))" (atan (tan (* 2 ratpi))) 0.0)17011702 (test-equal "atan2(3, tan(pi))" (atan 3 (tan ratpi)) (/ pi 2))1703 (test-equal "atan2(3, -tan(pi))" (atan 3 (- (tan ratpi))) (/ pi 2))1704 (test-equal "atan2(-3, tan(pi))" (atan -3 (tan ratpi)) (- (/ pi 2)))1705 (test-equal "atan2(-3, -tan(pi))" (atan -3 (- (tan ratpi))) (- (/ pi 2))))))17061707(test-end)17081709;(unless (zero? (test-failure-count)) (exit 1))1710(test-exit)