(require-extension numbers test)

(current-test-epsilon 0) ;; We want exact comparisons by default

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; run tests

(test-begin "numbers (Alex Shinn's tests)")

(test-group "basic cases, fixnum base"
  (test 1 (expt 0 0))
  (test 1 (expt 2 0))
  (test 2 (expt 2 1))
  (test 4 (expt 2 2))
  (test 9 (expt 3 2))
  (test 9.0 (expt 3 2.0))
  (parameterize ((current-test-epsilon 0.001))
    (test 10.0451 (expt 3 2.1))
    (test 1.1161 (expt 3 0.1))
    (test 1/3 (expt 3 -1))
    (test 1/9 (expt 3 -2))
    (test 0.09955 (expt 3 -2.1))))

(test-group "basic cases, flonum base"
  (test 1.0 (expt 0.0 0))
  (test 1.0 (expt 3.14 0))
  (test 3.14 (expt 3.14 1))
  (test 9.8596 (expt 3.14 2))
  (test 9.8596 (expt 3.14 2.0))
  (parameterize ((current-test-epsilon 0.001))
    (test 11.0548 (expt 3.14 2.1))
    (test 1.1212 (expt 3.14 0.1))
    (test 0.31847 (expt 3.14 -1))
    (test 0.10142 (expt 3.14 -2))
    (test 0.090458 (expt 3.14 -2.1))))

(test-group "overflows into bignums"
  (test (string->number "1073741824") (expt 2 30))
  (test (string->number "2147483648") (expt 2 31))
  (test (string->number "4294967296") (expt 2 32))
  (test (string->number "4611686018427387904") (expt 2 62))
  (test (string->number "9223372036854775808") (expt 2 63))
  (test (string->number "18446744073709551616") (expt 2 64)))

(define (one-followed-by-n-zeros n)
  (string->number (string-append "1" (make-string n #\0))))

(test-group "bug reported on the chicken list"
  (test (one-followed-by-n-zeros 100) (expt 10 100)))

(test-group "bignum base"
  (test 1 (expt (one-followed-by-n-zeros 100) 0))
  (parameterize ((current-test-epsilon 0.001))
    (test (one-followed-by-n-zeros 100) (expt (one-followed-by-n-zeros 100) 1))
    (test (one-followed-by-n-zeros 200) (expt (one-followed-by-n-zeros 100) 2))
    (test 10000000000.0 (expt (one-followed-by-n-zeros 100) 0.1))))

(define (real-approx= expected result)
  (cond ((zero? result) (< (abs expected) (current-test-epsilon)))
        ((zero? expected) (< (abs result) (current-test-epsilon)))
        (else (< (min (abs (- 1 (/ expected result)))
                      (abs (- 1 (/ result expected))))
                 (current-test-epsilon)))))

;; test-equal? doesn't work on compnums
(define (test-equal/comp? a b)
  (and (real-approx= (real-part a) (real-part b))
       (real-approx= (imag-part a) (imag-part b))))

(test-group "e^(pi*i) = -1"
  (parameterize ((current-test-epsilon 0.001)
                 (current-test-comparator test-equal/comp?))
    (test -1.0 (expt (exp 1) (* (acos -1) (sqrt -1))))))

(test-group "rational rounding"
  (test 1 (round (/ 9 10)))
  (test 1 (round (/ 6 10)))
  (test 0 (round (/ 5 10)))
  (test 0 (round (/ 1 10)))
  (test 0 (round (/ 0 10)))
  (test 0 (round (/ -1 10)))
  (test 0 (round (/ -5 10)))
  (test -1 (round (/ -6 10)))
  (test -1 (round (/ -9 10)))
  (test 1 (round (/ (expt 10 10000) (+ (expt 10 10000) 1))))
  (test (expt 10 9900) (round (/ (+ 1 (expt 10 10000)) (expt 10 100)))))

(test-end)

(unless (zero? (test-failure-count)) (exit 1))