(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 1073741824 (expt 2 30))
  (test 2147483648 (expt 2 31))
  (test 4294967296 (expt 2 32))
  (test 4611686018427387904 (expt 2 62))
  (test 9223372036854775808 (expt 2 63))
  (test 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)