;;
;; test numeric system implementation
;;
;; These tests are from Gauche Scheme (v0.9.1), which can be found at
;; http://practical-scheme.net/gauche/index.html
;; Some modifications were made to allow it to be used with the "test"
;; egg for Chicken
;;
;;   Copyright (c) 2000-2010  Shiro Kawai  <shiro@acm.org>
;;
;;  Redistribution and use in source and binary forms, with or without
;;  modification, are permitted provided that the following conditions
;;  are met:
;;
;;   1. Redistributions of source code must retain the above copyright
;;      notice, this list of conditions and the following disclaimer.
;;
;;   2. Redistributions in binary form must reproduce the above copyright
;;      notice, this list of conditions and the following disclaimer in the
;;      documentation and/or other materials provided with the distribution.
;;
;;   3. Neither the name of the authors nor the names of its contributors
;;      may be used to endorse or promote products derived from this
;;      software without specific prior written permission.
;;
;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;

(use test)
(use numbers)

(define (exp2 pow)
  (do ((i 0 (+ i 1))
       (m 1 (+ m m)))
      ((>= i pow) m)))

(define (fermat n)                      ;Fermat's number
  (+ (expt 2 (expt 2 n)) 1))

;; Gauche compat
(define (greatest-fixnum) most-positive-fixnum)
(define (least-fixnum) most-negative-fixnum)
(define (fixnum-width) fixnum-precision)

(define ash arithmetic-shift)
(define logior bitwise-ior)
(define logand bitwise-and)
(define lognot bitwise-not)
(define (logtest a b) (= (bitwise-and a b) b))

(define-syntax let1
  (syntax-rules ()
    ((_ var val forms ...)
     (let ((var val)) forms ...))))

(define (integer->digit i r)
  (and (< i r)
       (if (< i 10)
           (integer->char (+ (char->integer #\0) i))
           (integer->char (+ (char->integer #\a) (- i 10))))))

(define (read-from-string s) (with-input-from-string s read))

(define (truncate->exact x) (inexact->exact (truncate x)))
(define (round->exact x) (inexact->exact (round x)))
(define (floor->exact x) (inexact->exact (floor x)))
(define (ceiling->exact x) (inexact->exact (ceiling x)))

;; This is probably a bit silly
(define (+. . args) (apply + (map exact->inexact args)))
(define (-. . args) (apply - (map exact->inexact args)))
(define (*. . args) (apply * (map exact->inexact args)))
(define (/. . args) (apply / (map exact->inexact args)))

(test-begin "Gauche numbers test")

;;==================================================================
;; Reader/writer
;;

;;------------------------------------------------------------------
(test-begin "integer addition & reader")

(define (i-tester x)
  (list x (+ x -1 x) (+ x x) (- x) (- (+ x -1 x)) (- 0 x x) (- 0 x x 1)))

(test "around 2^28"
      '(268435456 536870911 536870912
         -268435456 -536870911 -536870912 -536870913)
      (i-tester (exp2 28)))

(test "around 2^31"
      '(2147483648 4294967295 4294967296
         -2147483648 -4294967295 -4294967296 -4294967297)
       (i-tester (exp2 31)))

(test "around 2^60"
       '(1152921504606846976 2305843009213693951 2305843009213693952
         -1152921504606846976 -2305843009213693951 -2305843009213693952
         -2305843009213693953)
       (i-tester (exp2 60)))

(test "around 2^63"
       '(9223372036854775808 18446744073709551615 18446744073709551616
         -9223372036854775808 -18446744073709551615 -18446744073709551616
         -18446744073709551617)
       (i-tester (exp2 63)))

(test "around 2^127"
       '(170141183460469231731687303715884105728
         340282366920938463463374607431768211455
         340282366920938463463374607431768211456
         -170141183460469231731687303715884105728
         -340282366920938463463374607431768211455
         -340282366920938463463374607431768211456
         -340282366920938463463374607431768211457)
       (i-tester (exp2 127)))

;; test for reader's overflow detection code
(test "peculiarity around 2^32"
      4772267290 (* 477226729 10))

(test "radix" '(43605 342391 718048024785
                 123456789 123456789987654321
                 1193046 3735928559 3735928559)
      (list #b1010101001010101
             #o1234567
             #o12345677654321
             #d123456789
             #d123456789987654321
             #x123456
             #xdeadbeef
             #xDeadBeef))

(test "exactness" #t (exact? #e10))
(test "exactness" #t (exact? #e10.0))
(test "exactness" #t (exact? #e10e10))
(test "exactness" #t (exact? #e12.34))
(test "inexactness" #f (exact? #i10))
(test "inexactness" #f (exact? #i10.0))
(test "inexactness" #f (exact? #i12.34))

(test "exactness & radix" '(#t 3735928559 #t 3735928559)
      (list (exact? #e#xdeadbeef)
             #e#xdeadbeef
             (exact? #x#edeadbeef)
             #x#edeadbeef))
(test "inexactness & radix" '(#f 3735928559.0 #f 3735928559.0)
      (list (exact? #i#xdeadbeef)
             #i#xdeadbeef
             (exact? #x#ideadbeef)
             #x#ideadbeef))

(test "invalid exactness/radix spec" #f
       (or (string->number "#e")
           (string->number "#i")
           (string->number "#e#i3")
           (string->number "#i#e5")
           (string->number "#x#o13")
           (string->number "#e#b#i00101")))

(define (radix-tester radix)
  (list
   (let loop ((digits 0)
              (input "1")
              (value 1))
     (cond ((> digits 64) #t)
           ((eqv? (string->number input radix) value)
            (loop (+ digits 1) (string-append input "0") (* value radix)))
           (else #f)))
   (let loop ((digits 0)
              (input (string (integer->digit (- radix 1) radix)))
              (value (- radix 1)))
     (cond ((> digits 64) #t)
           ((eqv? (string->number input radix) value)
            (loop (+ digits 1)
                  (string-append input (string (integer->digit (- radix 1) radix)))
                  (+ (* value radix) (- radix 1))))
           (else #f)))))

(test "base-2 reader" '(#t #t) (radix-tester 2))
(test "base-3 reader" '(#t #t) (radix-tester 3))
(test "base-4 reader" '(#t #t) (radix-tester 4))
(test "base-5 reader" '(#t #t) (radix-tester 5))
(test "base-6 reader" '(#t #t) (radix-tester 6))
(test "base-7 reader" '(#t #t) (radix-tester 7))
(test "base-8 reader" '(#t #t) (radix-tester 8))
(test "base-9 reader" '(#t #t) (radix-tester 9))
(test "base-10 reader" '(#t #t) (radix-tester 10))
(test "base-11 reader" '(#t #t) (radix-tester 11))
(test "base-12 reader" '(#t #t) (radix-tester 12))
(test "base-13 reader" '(#t #t) (radix-tester 13))
(test "base-14 reader" '(#t #t) (radix-tester 14))
(test "base-15 reader" '(#t #t) (radix-tester 15))
(test "base-16 reader" '(#t #t) (radix-tester 16))
(test "base-17 reader" '(#t #t) (radix-tester 17))
(test "base-18 reader" '(#t #t) (radix-tester 18))
(test "base-19 reader" '(#t #t) (radix-tester 19))
(test "base-20 reader" '(#t #t) (radix-tester 20))
(test "base-21 reader" '(#t #t) (radix-tester 21))
(test "base-22 reader" '(#t #t) (radix-tester 22))
(test "base-23 reader" '(#t #t) (radix-tester 23))
(test "base-24 reader" '(#t #t) (radix-tester 24))
(test "base-25 reader" '(#t #t) (radix-tester 25))
(test "base-26 reader" '(#t #t) (radix-tester 26))
(test "base-27 reader" '(#t #t) (radix-tester 27))
(test "base-28 reader" '(#t #t) (radix-tester 28))
(test "base-29 reader" '(#t #t) (radix-tester 29))
(test "base-30 reader" '(#t #t) (radix-tester 30))
(test "base-31 reader" '(#t #t) (radix-tester 31))
(test "base-32 reader" '(#t #t) (radix-tester 32))
(test "base-33 reader" '(#t #t) (radix-tester 33))
(test "base-34 reader" '(#t #t) (radix-tester 34))
(test "base-35 reader" '(#t #t) (radix-tester 35))
(test "base-36 reader" '(#t #t) (radix-tester 36))

(test-end)

;;------------------------------------------------------------------
(test-begin "rational reader")

(define (rational-test v)
  (if (number? v) (list v (exact? v)) v))

(test "rational reader" '(1234 #t) (rational-test '1234/1))
(test "rational reader" '(-1234 #t) (rational-test '-1234/1))
(test "rational reader" '(1234 #t) (rational-test '+1234/1))
;; The following is invalid R5RS syntax, so it's commented out (it fails, too)
#;(test "rational reader" '|1234/-1| (rational-test '1234/-1))
(test "rational reader" '(1234 #t) (rational-test '2468/2))
(test "rational reader" '(1/2 #t) (rational-test '1/2))
(test "rational reader" '(-1/2 #t) (rational-test '-1/2))
(test "rational reader" '(1/2 #t) (rational-test '+1/2))
(test "rational reader" '(1/2 #t) (rational-test '751/1502))

(test "rational reader" '(1 #t)
       (rational-test (string->number "3/03")))
(test "rational reader" #f #;'(+inf.0 #f) ; <- I think that's wrong in Gauche
       (rational-test (string->number "3/0")))
(test "rational reader" #f #;'(-inf.0 #f) ; same as above
       (rational-test (string->number "-3/0")))
(test "rational reader" #f
       (rational-test (string->number "3/3/4")))
(test "rational reader" #f
       (rational-test (string->number "1/2.")))
(test "rational reader" #f
       (rational-test (string->number "1.3/2")))

(test-error "rational reader" (rational-test (read-from-string "#e3/0")))
(test-error "rational reader" (rational-test (read-from-string "#e-3/0")))

(test "rational reader w/#e" '(1234 #t)
       (rational-test '#e1234/1))
(test "rational reader w/#e" '(-1234 #t)
       (rational-test '#e-1234/1))
(test "rational reader w/#e" '(32/7 #t)
       (rational-test '#e32/7))
(test "rational reader w/#e" '(-32/7 #t)
       (rational-test '#e-32/7))
(test "rational reader w/#i" '(1234.0 #f)
       (rational-test '#i1234/1))
(test "rational reader w/#i" '(-1234.0 #f)
       (rational-test '#i-1234/1))
(test "rational reader w/#i" '(-0.125 #f)
       (rational-test '#i-4/32))

(test "rational reader w/radix" '(15 #t)
       (rational-test '#e#xff/11))
(test "rational reader w/radix" '(56 #t)
       (rational-test '#o770/11))
(test "rational reader w/radix" '(15.0 #f)
       (rational-test '#x#iff/11))

(test "rational reader edge case" #t (symbol? (read-from-string "/1")))
(test "rational reader edge case" #t (symbol? (read-from-string "-/1")))
(test "rational reader edge case" #t (symbol? (read-from-string "+/1")))

(test-end)

;;------------------------------------------------------------------
(test-begin "flonum reader")

(define (flonum-test v)
  (if (number? v) (list v (inexact? v)) v))

(test "flonum reader" '(3.14 #t)  (flonum-test 3.14))
(test "flonum reader" '(0.14 #t)  (flonum-test 0.14))
(test "flonum reader" '(0.14 #t)  (flonum-test .14))
(test "flonum reader" '(3.0  #t)  (flonum-test 3.))
(test "flonum reader" '(-3.14 #t)  (flonum-test -3.14))
(test "flonum reader" '(-0.14 #t)  (flonum-test -0.14))
(test "flonum reader" '(-0.14 #t)  (flonum-test -.14))
(test "flonum reader" '(-3.0  #t)  (flonum-test -3.))
(test "flonum reader" '(3.14 #t)  (flonum-test +3.14))
(test "flonum reader" '(0.14 #t)  (flonum-test +0.14))
(test "flonum reader" '(0.14 #t)  (flonum-test +.14))
(test "flonum reader" '(3.0  #t)  (flonum-test +3.))
(test "flonum reader" '(0.0  #t)  (flonum-test .0))
(test "flonum reader" '(0.0  #t)  (flonum-test 0.))
(test "flonum reader" #f (string->number "."))
(test "flonum reader" #f (string->number "-."))
(test "flonum reader" #f (string->number "+."))

(test "flonum reader (exp)" '(314.0 #t) (flonum-test 3.14e2))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314e3))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test 314e0))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test 314e-0))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test 3140000e-4))
(test "flonum reader (exp)" '(-314.0 #t) (flonum-test -3.14e2))
(test "flonum reader (exp)" '(-314.0 #t) (flonum-test -.314e3))
(test "flonum reader (exp)" '(-314.0 #t) (flonum-test -314e0))
(test "flonum reader (exp)" '(-314.0 #t) (flonum-test -314.e-0))
(test "flonum reader (exp)" '(-314.0 #t) (flonum-test -3140000e-4))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test +3.14e2))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test +.314e3))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test +314.e0))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test +314e-0))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test +3140000.000e-4))

(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314E3))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314s3))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314S3))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314l3))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314L3))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314f3))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314F3))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314d3))
(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314D3))

(test "flonum reader (minimum denormalized number 5.0e-324)" #t
       (let1 x (expt 2.0 -1074)
         (= x (string->number (number->string x)))))
(test "flonum reader (minimum denormalized number -5.0e-324)" #t
       (let1 x (- (expt 2.0 -1074))
         (= x (string->number (number->string x)))))
       

(test "padding" '(10.0 #t) (flonum-test '1#))
(test "padding" '(10.0 #t) (flonum-test '1#.))
(test "padding" '(10.0 #t) (flonum-test '1#.#))
(test "padding" '(100.0 #t) (flonum-test '10#.#))
(test "padding" '(100.0 #t) (flonum-test '1##.#))
(test "padding" '(100.0 #t) (flonum-test '100.0#))
(test "padding" '(1.0 #t) (flonum-test '1.#))

(test "padding" '|1#1| (flonum-test '1#1))
(test "padding" '|1##1| (flonum-test '1##1))
(test "padding" '|1#.1| (flonum-test '1#.1))
(test "padding" '|1.#1| (flonum-test '1.#1))

(test "padding" '|.#| (flonum-test '.#))
(test "padding" '(0.0 #t) (flonum-test '0.#))
(test "padding" '(0.0 #t) (flonum-test '.0#))
(test "padding" '(0.0 #t) (flonum-test '0#))
(test "padding" '(0.0 #t) (flonum-test '0#.#))
(test "padding" '|0#.0| (flonum-test '0#.0))

(test "padding" '(1000.0 #t) (flonum-test '1#e2))
(test "padding" '(1000.0 #t) (flonum-test '1##e1))
(test "padding" '(1000.0 #t) (flonum-test '1#.##e2))
(test "padding" '(0.0 #t) (flonum-test '0.#e2))
(test "padding" '(0.0 #t) (flonum-test '.0#e2))
(test "padding" '|.##e2| (flonum-test '.##e2))

(test "padding (exactness)" '(100 #f) (flonum-test '#e1##))
(test "padding (exactness)" '(120 #f) (flonum-test '#e12#))
(test "padding (exactness)" '(120 #f) (flonum-test '#e12#.#))
(test "padding (exactness)" '(100.0 #t) (flonum-test '#i1##))
(test "padding (exactness)" '(120.0 #t) (flonum-test '#i12#))
(test "padding (exactness)" '(120.0 #t) (flonum-test '#i12#.#))

(test "exponent out-of-range 1" '(+inf.0 #t) (flonum-test '1e309))
(test "exponent out-of-range 2" '(+inf.0 #t) (flonum-test '1e10000))
;; TODO: Figure out what goes wrong here
;(test "exponent out-of-range 3" '(+inf.0 #t) (flonum-test '1e1000000000000000000000000000000000000000000000000000000000000000))
(test "exponent out-of-range 4" '(-inf.0 #t) (flonum-test '-1e309))
(test "exponent out-of-range 5" '(-inf.0 #t) (flonum-test '-1e10000))
;(test "exponent out-of-range 6" '(-inf.0 #t) (flonum-test '-1e1000000000000000000000000000000000000000000000000000000000000000))
(test "exponent out-of-range 7" '(0.0 #t) (flonum-test '1e-324))
(test "exponent out-of-range 8" '(0.0 #t) (flonum-test '1e-1000))
;(test "exponent out-of-range 9" '(0.0 #t) (flonum-test '1e-1000000000000000000000000000000000000000000000000000000000000000000))

(test "no integral part" 0.5 (read-from-string ".5"))
(test "no integral part" -0.5 (read-from-string "-.5"))
(test "no integral part" 0.5 (read-from-string "+.5"))
(test-end)

;;------------------------------------------------------------------
(test-begin "exact fractional number")

(test "exact fractonal number" 12345
       (string->number "#e1.2345e4"))
(test "exact fractonal number" 123450000000000
       (string->number "#e1.2345e14"))
(test "exact fractonal number" 12345/100
       (string->number "#e1.2345e2"))
(test "exact fractonal number" 12345/1000000
       (string->number "#e1.2345e-2"))
(test "exact fractonal number" -12345
       (string->number "#e-1.2345e4"))
(test "exact fractonal number" -123450000000000
       (string->number "#e-1.2345e14"))
(test "exact fractonal number" -12345/100
       (string->number "#e-1.2345e2"))
(test "exact fractonal number" -12345/1000000
       (string->number "#e-1.2345e-2"))

(test "exact fractonal number" (expt 10 296)
       (string->number "#e0.0001e300"))
(test "exact fractonal number" (- (expt 10 296))
       (string->number "#e-0.0001e300"))

(test "exact fractonal number" (expt 10 330)
      (read-from-string "#e1e330"))
(test "exact fractonal number" (expt 10 -330)
      (read-from-string "#e1e-330"))

(test-end)

;;------------------------------------------------------------------
(test-begin "complex reader")

(define (decompose-complex z)
  (cond ((real? z) z)
        ((complex? z)
         (list (real-part z) (imag-part z)))
        (else z)))

;; Fixed for exactness (Gauche's complex numbers are always inexact)
(test "complex reader" '(1 1) (decompose-complex '1+i))
(test "complex reader" '(1 1) (decompose-complex '1+1i))
(test "complex reader" '(1 -1) (decompose-complex '1-i))
(test "complex reader" '(1 -1) (decompose-complex '1-1i))
(test "complex reader" '(1.0 1.0) (decompose-complex '1.0+1i))
(test "complex reader" '(1.0 1.0) (decompose-complex '1.0+1.0i))
(test "complex reader" '(1e-5 1.0) (decompose-complex '1e-5+1i))
(test "complex reader" '(1e+5 1.0) (decompose-complex '1e+5+1i))
(test "complex reader" '(1.0 1e-5) (decompose-complex '1+1e-5i))
(test "complex reader" '(1.0 1e+5) (decompose-complex '1+1e+5i))
(test "complex reader" '(0.1 1e+4) (decompose-complex '0.1+0.1e+5i))
(test "complex reader" '(0 1) (decompose-complex '+i))
(test "complex reader" '(0 -1) (decompose-complex '-i))
(test "complex reader" '(0 1) (decompose-complex '+1i))
(test "complex reader" '(0 -1) (decompose-complex '-1i))
(test "complex reader" '(0.0 1.0) (decompose-complex '+1.i))
(test "complex reader" '(0.0 -1.0) (decompose-complex '-1.i))
(test "complex reader" '(0.0 1.0) (decompose-complex '+1.0i))
(test "complex reader" '(0.0 -1.0) (decompose-complex '-1.0i))
(test "complex reader" 1.0 (decompose-complex '1+0.0i))
(test "complex reader" 1.0 (decompose-complex '1+.0i))
(test "complex reader" 1.0 (decompose-complex '1+0.i))
(test "complex reader" 1.0 (decompose-complex '1+0.0e-43i))
(test "complex reader" 100.0 (decompose-complex '1e2+0.0e-43i))

(test "complex reader" 'i (decompose-complex 'i))
(test "complex reader" #f (decompose-complex (string->number ".i")))
(test "complex reader" #f (decompose-complex (string->number "+.i")))
(test "complex reader" #f (decompose-complex (string->number "-.i")))
(test "complex reader" '33i (decompose-complex '33i))
(test "complex reader" 'i+1 (decompose-complex 'i+1))
(test "complex reader" '|++i| (decompose-complex '++i))
(test "complex reader" '|--i| (decompose-complex '--i))

(test "complex reader" '(1/2 1/2) (decompose-complex 1/2+1/2i))
(test "complex reader" '(0 1/2) (decompose-complex 0+1/2i))
(test "complex reader" '(0 -1/2) (decompose-complex -1/2i))
(test "complex reader" 1/2 (decompose-complex 1/2-0/2i))
;; The following is also invalid R5RS syntax, so it's commented out
#;(test "complex reader" '(0.5 -inf.0) (decompose-complex (string->number "1/2-1/0i")))

(test "complex reader (polar)" 1.0@1.0 (make-polar 1.0 1.0))
(test "complex reader (polar)" 1.0@-1.0 (make-polar 1.0 -1.0))
(test "complex reader (polar)" 1.0@+1.0 (make-polar 1.0 1.0))
(test "complex reader (polar)" -7@-3.0 (make-polar -7.0 -3.0))
(test "complex reader (polar)" 7/2@-3.0 (make-polar 3.5 -3.0))
(test "complex reader (polar)" #f (string->number "7/2@-3.14i"))

(test-end)

;;------------------------------------------------------------------
(test-begin "integer writer syntax")

(define (i-tester2 x)
  (map number->string (i-tester x)))

(test "around 2^28"
      '("268435456" "536870911" "536870912"
        "-268435456" "-536870911" "-536870912" "-536870913")
      (i-tester2 (exp2 28)))
      
(test "around 2^31"
      '("2147483648" "4294967295" "4294967296"
        "-2147483648" "-4294967295" "-4294967296" "-4294967297")
      (i-tester2 (exp2 31)))

(test "around 2^60"
      '("1152921504606846976" "2305843009213693951" "2305843009213693952"
        "-1152921504606846976" "-2305843009213693951" "-2305843009213693952"
        "-2305843009213693953")
      (i-tester2 (exp2 60)))

(test "around 2^63"
      '("9223372036854775808" "18446744073709551615" "18446744073709551616"
        "-9223372036854775808" "-18446744073709551615" "-18446744073709551616"
        "-18446744073709551617")
      (i-tester2 (exp2 63)))

(test "around 2^127"
      '("170141183460469231731687303715884105728"
        "340282366920938463463374607431768211455"
        "340282366920938463463374607431768211456"
        "-170141183460469231731687303715884105728"
        "-340282366920938463463374607431768211455"
        "-340282366920938463463374607431768211456"
        "-340282366920938463463374607431768211457")
      (i-tester2 (exp2 127)))

(test-end)

;;==================================================================
;; Conversions
;;

;; We first test expt, for we need to use it to test exact<->inexact
;; conversion stuff.
(test-begin "expt")

(test "exact expt" 1 (expt 5 0))
(test "exact expt" 9765625 (expt 5 10))
(test "exact expt" 1220703125 (expt 5 13))
(test "exact expt" 94039548065783000637498922977779654225493244541767001720700136502273380756378173828125 (expt 5 123))
(test "exact expt" 1/94039548065783000637498922977779654225493244541767001720700136502273380756378173828125 (expt 5 -123))
(test "exact expt" 1 (expt -5 0))
(test "exact expt" 9765625 (expt -5 10))
(test "exact expt" -1220703125 (expt -5 13))
(test "exact expt" -94039548065783000637498922977779654225493244541767001720700136502273380756378173828125 (expt -5 123))
(test "exact expt" -1/94039548065783000637498922977779654225493244541767001720700136502273380756378173828125 (expt -5 -123))
(test "exact expt" 1 (expt 1 720000))
(test "exact expt" 1 (expt -1 720000))
(test "exact expt" -1 (expt -1 720001))

(test "exact expt (ratinoal)" 8589934592/5559060566555523
       (expt 2/3 33))
(test "exact expt (rational)" -8589934592/5559060566555523
       (expt -2/3 33))
(test "exact expt (ratinoal)" 5559060566555523/8589934592
       (expt 2/3 -33))

(test-end)

(parameterize ((current-test-epsilon 10e7))
  (test "expt (coercion to inexact)" 1.4142135623730951
        (expt 2 1/2))) ;; NB: pa$ will be tested later

(test-begin "exact<->inexact")

(for-each
 (lambda (e&i)
   (let ((e (car e&i))
         (i (cdr e&i)))
     (test (format "exact->inexact ~s" i) i (exact->inexact e))
     (test (format "exact->inexact ~s" (- i)) (- i) (exact->inexact (- e)))
     (test (format "inexact->exact ~s" e) e (inexact->exact i))
     (test (format "inexact->exact ~s" (- e)) (- e) (inexact->exact (- i)))
     ))
 `((0  . 0.0)
   (1  . 1.0)
   (-1 . -1.0)
   (,(expt 2 52) . ,(expt 2.0 52))
   (,(expt 2 53) . ,(expt 2.0 53))
   (,(expt 2 54) . ,(expt 2.0 54))
   ))

;; Rounding bignum to flonum, edge cases.
;; Test patterns:
;;
;;   <------53bits------->
;;a) 100000000...000000000100000....0000       round down (r0)
;;b) 100000000...000000000100000....0001       round up (r1)
;;c) 100000000...000000001100000....0000       round up (r2)
;;d) 100000000...000000001011111....1111       round down (r1)
;;e) 111111111...111111111100000....0000       round up, carry over (* r0 2)
;;f) 101111111...111111111100000....0000       round up, no carry over (r3)
;;            <--32bits-->
;;g) 100..0000111.....1111100000....0000       round up; boundary on ILP32 (r4)

(let loop ((n 0)
           (a (+ (expt 2 53) 1))
           (c (+ (expt 2 53) 3))
           (e (- (expt 2 54) 1))
           (f (+ (expt 2 53) (expt 2 52) -1))
           (g (+ (expt 2 53) (expt 2 33) -1))
           (r0 (expt 2.0 53))
           (r1 (+ (expt 2.0 53) 2.0))
           (r2 (+ (expt 2.0 53) 4.0))
           (r3 (+ (expt 2.0 53) (expt 2.0 52)))
           (r4 (+ (expt 2.0 53) (expt 2.0 33))))
  (when (< n 32)
    (test (format "exact->inexact, pattern a: round down (~a)" n)
           r0 (exact->inexact a))
    (test (format "exact->inexact, pattern b: round up   (~a)" n)
           r1 (exact->inexact (+ a 1)))
    (test (format "exact->inexact, pattern c: round up   (~a)" n)
           r2 (exact->inexact c))
    (test (format "exact->inexact, pattern d: round down (~a)" n)
           r1 (exact->inexact (- c 1)))
    (test (format "exact->inexact, pattern e: round up   (~a)" n)
           (* r0 2.0) (exact->inexact e))
    (test (format "exact->inexact, pattern f: round up   (~a)" n)
           r3 (exact->inexact f))
    (test (format "exact->inexact, pattern g: round up   (~a)" n)
           r4 (exact->inexact g))
    (loop (+ n 1) (ash a 1) (ash c 1) (ash e 1) (ash f 1) (ash g 1)
          (* r0 2.0) (* r1 2.0) (* r2 2.0) (* r3 2.0) (* r4 2.0))))


(parameterize ((current-test-epsilon 10e12))
  (test "expt (ratnum with large denom and numer) with inexact conversion 1"
        (expt 8/9 342.0)
        (exact->inexact (expt 8/9 342)))

  (test "expt (ratnum with large denom and numer) with inexact conversion 2"
        (expt -8/9 343.0)
        (exact->inexact (expt -8/9 343))))

;; The following few tests covers RATNUM paths in Scm_GetDouble
(test "expt (ratnum with large denom and numer) with inexact conversion 3"
       1.0e-308 (exact->inexact (/ (expt 10 20) (expt 10 328))))
;; In the original Gauche test this checked for a return value of 0.0, but
;; that's quite Gauche-specific.  We return 1.0e-309.
;; It's probably wrong to test this kind of behaviour in the first place...
(test "expt (ratnum with large denom and numer) with inexact conversion 4"
       1.0e-309 (exact->inexact (/ (expt 10 20) (expt 10 329))))
(test "expt (ratnum with large denom and numer) with inexact conversion 5"
       1.0e308 (exact->inexact (/ (expt 10 328) (expt 10 20))))
(test "expt (ratnum with large denom and numer) with inexact conversion 6"
       +inf.0 (exact->inexact (/ (expt 10 329) (expt 10 20))))
(test "expt (ratnum with large denom and numer) with inexact conversion 7"
       -inf.0 (exact->inexact (/ (expt -10 329) (expt 10 20))))

(test-end)

;;==================================================================
;; Predicates
;;

(test-begin "predicates")

(test "integer?" #t (integer? 0))
(test "integer?" #t (integer? 85736847562938475634534245))
(test "integer?" #f (integer? 85736.534245))
(test "integer?" #f (integer? 3.14))
(test "integer?" #f (integer? 3+4i))
(test "integer?" #t (integer? 3+0i))
(test "integer?" #f (integer? #f))

(test "rational?" #t (rational? 0))
(test "rational?" #t (rational? 85736847562938475634534245))
(test "rational?" #t (rational? 1/2))
(test "rational?" #t (rational? 85736.534245))
(test "rational?" #t (rational? 3.14))
(test "rational?" #f (rational? 3+4i))
(test "rational?" #t (rational? 3+0i))
(test "rational?" #f (rational? #f))
(test "rational?" #f (rational? +inf.0))
(test "rational?" #f (rational? -inf.0))
(test "rational?" #f (rational? +nan.0))

(test "real?" #t (real? 0))
(test "real?" #t (real? 85736847562938475634534245))
(test "real?" #t (real? 857368.4756293847))
(test "real?" #t (real? 3+0i))
(test "real?" #f (real? 3+4i))
(test "real?" #f (real? +4.3i))
(test "real?" #f (real? '()))
(test "real?" #t (real? +inf.0))
(test "real?" #t (real? -inf.0))
(test "real?" #t (real? +nan.0))

(test "complex?" #t (complex? 0))
(test "complex?" #t (complex? 85736847562938475634534245))
(test "complex?" #t (complex? 857368.4756293847))
(test "complex?" #t (complex? 3+0i))
(test "complex?" #t (complex? 3+4i))
(test "complex?" #t (complex? +4.3i))
(test "complex?" #f (complex? '()))

(test "number?" #t (number? 0))
(test "number?" #t (number? 85736847562938475634534245))
(test "number?" #t (number? 857368.4756293847))
(test "number?" #t (number? 3+0i))
(test "number?" #t (number? 3+4i))
(test "number?" #t (number? +4.3i))
(test "number?" #f (number? '()))

(test "exact?" #t (exact? 1))
(test "exact?" #t (exact? 4304953480349304983049304953804))
(test "exact?" #t (exact? 430495348034930/4983049304953804))
(test "exact?" #f (exact? 1.0))
(test "exact?" #f (exact? 4304953480349304983.049304953804))
(test "exact?" #f (exact? 1.0+0i))
(test "exact?" #f (exact? 1.0+5i))
(test "inexact?" #f (inexact? 1))
(test "inexact?" #f (inexact? 4304953480349304983049304953804))
(test "inexact?" #f (inexact? 430495348034930/4983049304953804))
(test "inexact?" #t (inexact? 1.0))
(test "inexact?" #t (inexact? 4304953480349304983.049304953804))
(test "inexact?" #t (inexact? 1.0+0i))
(test "inexact?" #t (inexact? 1.0+5i))

(test "odd?" #t (odd? 1))
(test "odd?" #f (odd? 2))
(test "even?" #f (even? 1))
(test "even?" #t (even? 2))
(test "odd?" #t (odd? 1.0))
(test "odd?" #f (odd? 2.0))
(test "even?" #f (even? 1.0))
(test "even?" #t (even? 2.0))
(test "odd?" #t (odd? 10000000000000000000000000000000000001))
(test "odd?" #f (odd? 10000000000000000000000000000000000002))
(test "even?" #f (even? 10000000000000000000000000000000000001))
(test "even?" #t (even? 10000000000000000000000000000000000002))

(test "zero?" #t (zero? 0))
(test "zero?" #t (zero? 0.0))
(test "zero?" #t (zero? (- 10 10.0)))
(test "zero?" #t (zero? 0+0i))
(test "zero?" #f (zero? 1.0))
(test "zero?" #f (zero? +5i))
(test "positive?" #t (positive? 1))
(test "positive?" #f (positive? -1))
(test "positive?" #t (positive? 1/7))
(test "positive?" #f (positive? -1/7))
(test "positive?" #t (positive? 3.1416))
(test "positive?" #f (positive? -3.1416))
(test "positive?" #t (positive? 134539485343498539458394))
(test "positive?" #f (positive? -134539485343498539458394))
(test "negative?" #f (negative? 1))
(test "negative?" #t (negative? -1))
(test "negative?" #f (negative? 1/7))
(test "negative?" #t (negative? -1/7))
(test "negative?" #f (negative? 3.1416))
(test "negative?" #t (negative? -3.1416))
(test "negative?" #f (negative? 134539485343498539458394))
(test "negative?" #t (negative? -134539485343498539458394))

(let-syntax ((tester (syntax-rules ()
                       ((_ name proc result)
                        (begin (test-error name (proc #t))
                               (test name result (list (proc 1)
                                                       (proc +inf.0)
                                                       (proc -inf.0)
                                                       (proc +nan.0))))))))
  (tester "finite?"   finite?   `(#t #f #f #f))
  (tester "infinite?" infinite? `(#f #t #t #f))
  (tester "nan?"      nan?      `(#f #f #f #t))
  )


(test "eqv?" #t (eqv? 20 20))
(test "eqv?" #t (eqv? 20.0 20.00000))
(test "eqv?" #f (eqv? 4/5 0.8))
(test "eqv?" #t (eqv? (exact->inexact 4/5) 0.8))
(test "eqv?" #f (eqv? 4/5 (inexact->exact 0.8)))
(test "eqv?" #t (eqv? 20 (inexact->exact 20.0)))
(test "eqv?" #f (eqv? 20 20.0))

;; numeric comparison involving nan.  we should test both 
;; inlined case and applied case
(define-syntax test-nan-cmp
  (ir-macro-transformer
   (lambda (e r c)
     (let ((op (cadr e)))
       `(begin
          (test (format "NaN ~a (inlined)" ',op) '(#f #f #f)
                (list (,op +nan.0 +nan.0) (,op +nan.0 0) (,op 0 +nan.0)))
          (test (format "NaN ~a (applied)" ',op) '(#f #f #f)
                (list (apply ,op '(+nan.0 +nan.0))
                      (apply ,op '(+nan.0 0))
                      (apply ,op '(0 +nan.0)))))))))
(test-nan-cmp =)
(test-nan-cmp <)
(test-nan-cmp <=)
(test-nan-cmp >)
(test-nan-cmp >=)

;; the following tests combine instructions for comparison.
(let ((zz #f))
  (set! zz 3.14)  ;; prevent the compiler from optimizing constants

  (test "NUMEQF" '(#t #t #f #f)
         (list (= 3.14 zz) (= zz 3.14) (= 3.15 zz) (= zz 3.15)))
  (test "NLTF" '(#f #f #f #t #t #f)
         (list (< 3.14 zz) (< zz 3.14)
               (< 3.15 zz) (< zz 3.15)
               (< 3.13 zz) (< zz 3.13)))
  (test "NLEF" '(#t #t #f #t #t #f)
         (list (<= 3.14 zz) (<= zz 3.14)
               (<= 3.15 zz) (<= zz 3.15)
               (<= 3.13 zz) (<= zz 3.13)))
  (test "NGTF" '(#f #f #t #f #f #t)
         (list (> 3.14 zz) (> zz 3.14)
               (> 3.15 zz) (> zz 3.15)
               (> 3.13 zz) (> zz 3.13)))
  (test "NGEF" '(#t #t #t #f #f #t)
         (list (>= 3.14 zz) (>= zz 3.14)
               (>= 3.15 zz) (>= zz 3.15)
               (>= 3.13 zz) (>= zz 3.13)))
  )

;; Go through number comparison routines.
;; assumes a >= b, a > 0, b > 0
;; we use apply to prevent inlining.
(define (numcmp-test msg eq a b) 
  (let ((pp (list a b))
        (pm (list a (- b)))
        (mp (list (- a) b))
        (mm (list (- a) (- b))))
    (define (test4 op opname rev results)
      (for-each (lambda (result comb args)
                  (let ((m (conc msg " " (if rev 'rev "") opname "(" comb ")")))
                   (test m result (apply op (if rev (reverse args) args)))))
                results '(++ +- -+ --) (list pp pm mp mm)))
    (test4 =  '=  #f (list eq #f #f eq))
    (test4 =  '=  #t (list eq #f #f eq))
    (test4 >= '>= #f (list #t #t #f eq))
    (test4 >= '>= #t (list eq #f #t #t))
    (test4 >  '>  #f (list (not eq) #t #f #f))
    (test4 >  '>  #t (list #f #f #t (not eq)))
    (test4 <= '<= #f (list eq #f #t #t))
    (test4 <= '<= #t (list #t #t #f eq))
    (test4 <  '<  #f (list #f #f #t (not eq)))
    (test4 <  '<  #t (list (not eq) #t #f #f))
    ))

(numcmp-test "fixnum vs fixnum eq" #t 156 156)
(numcmp-test "fixnum vs fixnum ne" #f 878252 73224)
(numcmp-test "bignum vs fixnum ne" #f (expt 3 50) 9982425)
(numcmp-test "bignum vs bignum eq" #t (expt 3 50) (expt 3 50))
(numcmp-test "bignum vs bignum ne" #f (expt 3 50) (expt 3 49))
(numcmp-test "flonum vs fixnum eq" #t 314.0 314)
(numcmp-test "flonum vs fixnum ne" #f 3140.0 314)
(numcmp-test "flonum vs bignum eq" #t (expt 2.0 64) (expt 2 64))
(numcmp-test "flonum vs bignum ne" #f (expt 2.0 64) (expt 2 63))
(numcmp-test "ratnum vs fixnum ne" #f 13/2 6)
(numcmp-test "ratnum vs ratnum eq" #t 3/5 3/5)
(numcmp-test "ratnum vs ratnum 1 ne" #f 3/5 4/7)
(numcmp-test "ratnum vs ratnum 2 ne" #f 4/5 3/7)
(numcmp-test "ratnum vs ratnum 3 ne" #f 4/7 2/5)
(numcmp-test "ratnum vs ratnum 4 ne" #f 4/7 3/7)
(numcmp-test "ratnum vs flonum eq" #t 3/8 0.375)
(numcmp-test "ratnum vs flonum ne" #f 8/9 0.6)
(numcmp-test "ratnum vs bignum ne" #f (/ (+ (expt 2 64) 1) 2) (expt 2 63))

;; This is from the bug report from Bill Schottsteadt.  Before 0.8.10
;; this yielded #t because of the precision loss in fixnum vs ratnum
;; comparison.

(test "fixnum/ratnum comparison" #f
       (= -98781233389595723930250385525631360344437602649022271391716773162526352115087074898920261954897888235939429993829738630297052776667061779065100945771127020439712527398509771853491319737304616607041615012797134365574007368603232768089410097730646360760856052946465578073788924743642391638455649511108051053789425902013657106523269224045822294981391380222050223141347787674321888089837786284947870569165079491411110074602544203383038299901291952931113248943344436935596614205784436844912243069019367149526328612664067719765890897558075277707055756274228634652905751880612235340874976952880431555921814590049070979276358637989837532124647692152520447680373275200239544449293834424643702763974403094033892112967196087310232853165951285609426599617479356206218697586025251765476179158153123631158173662488102357611674821528467825910806391548770908013608889792001203039243914696463472490444573930050190716726220002151679336252008777326482398042427845860796285369622627679324605214987983884122808994422164327311297556122943400093231935477754959547620500784989043704825777186301417894825200797719289692636286337716705491307686644214213732116277102140558505945554566856673724837541141206267647285222293953181717113434757149921850120377706206012113994795124049471433490016083401216757825264766474891405185591236321448744678896448941259668731597494947127423662646933419809756274038044752395708014998820826196523041220918922611359697502638594907608648168849193813197790291360087857093790119162389573209640804111261616771827989939551840471235079945175327536638365874717775169210186608268924244639016270610098894971732892267642318266405837012482726627199088381027028630711279130575230815976484191675172279903609489448225149181063260231957171204855841611039996959582465138269247794842445177715476581512709861409446684911276158067098438009067149531119008707418601627426255891/2063950098473886055933596136103014753954685977787179797499441692283103642150668140884348149132839387663291870239435604463778573480782766958396423322880804442523056530013282118705429274303746421980903580754656364533869319744640130831962767797772323836293079599182477171562218297208495122660799328579852852969560730744211066545295945803939271680397511478811389399527913043145952054883289558914237172406636283114284363301999238526952309439259354223729114988806937903509692118585280437646676248013406270664905997291670857985754768850507766359973207600149782819306010561088246502918148146264806947375101624011387317921439210509902170092173796154464078297852707797984007992277904626058467143192149921546030028316990855470478894515952884526783686210401408859364838148201339959570732480920969000913791571631154267939054105878236201498477027265774680071188764947522112650857013491135901945605796776829525789886482760578142306057177990048751864852763036720112071475134369179525117161001517868525821398753039187062869247457336940152614866298628205010037695017885878296140891234142925514925051385440766473260338168038302226808098439763889250948602137806546736025439919604390464712793474019469457135856879584745805794574609707742445431851999335443724488636749987837445626810087003490329257105472274738811579817454656532496370562155449815456374456838912258383282154811001588175608617475540639254689723629881619252699580383612847920348111900440075645703960104081690968807839189109040568288972353424306876947127635585164905071821419089229871978994388197349499565628906992171901547121903117815637249359328193980583892566359962066242217169190169986105579733710057404319381685578470983838597020624234209884597110721892707818651210378187525863009879314177842634871978427592746452643603586344401223449546482306838947819060455178762434166799996220143825677025686435609179225302671777326568324855229172912876656233006785717920665743720753617646617017219230313226844735567400507490772935145894670445831971526014183234960075574401616682479457962912905141754252265169682318523572680657053374002911007741991220001444440319448034755483178790032581428679303588017268970 0))


;;==================================================================
;; Fixnum stuff
;;

(test "fixnum? fixnum" #t (fixnum? 0))
(test "fixnum? ratnum" #f (fixnum? 1/2))
(test "fixnum? bignum" #f (fixnum? (expt 2 256)))
(test "fixnum? flonum" #f (fixnum? 3.14))
(test "fixnum? compnum" #f (fixnum? 1+3i))

(test "fixnum? greatest"    #t (fixnum? (greatest-fixnum)))
(test "fixnum? greatest+1"  #f (fixnum? (+ (greatest-fixnum) 1)))
(test "fixnum? least"       #t (fixnum? (least-fixnum)))
(test "fixnum? least-1"     #f (fixnum? (- (least-fixnum) 1)))

(test "greatest fixnum & width" (greatest-fixnum)
       (- (ash 1 (fixnum-width)) 1))
(test "least fixnum & width" (least-fixnum)
       (- (ash 1 (fixnum-width))))

(test-end)

;;==================================================================
;; Arithmetics
;;

;;------------------------------------------------------------------
(test-begin "integer addition")

(define x #xffffffff00000000ffffffff00000000)
(define xx (- x))
(define y #x00000002000000000000000200000000)
(define yy (- y))
(define z #x00000000000000010000000000000001)
(test "bignum + bignum" #x100000001000000010000000100000000
      (+ x y))
(test "bignum + -bignum" #xfffffffd00000000fffffffd00000000
      (+ x yy))
(test "bignum - bignum" #xfffffffefffffffffffffffeffffffff
      (- x z))
(test "bignum - bignum" x
      (- (+ x y) y))
(test "-bignum + bignum" #x-fffffffd00000000fffffffd00000000
      (+ xx y))
(test "-bignum + -bignum" #x-100000001000000010000000100000000
      (+ xx yy))
(test "-bignum - bignum" #x-100000001000000010000000100000000
      (- xx y))
(test "-bignum - -bignum" #x-fffffffd00000000fffffffd00000000
      (- xx yy))

;; This test a possible shortcut in Scm_Add etc.  We use apply
;; to avoid operators from being inlined.
(test "0 + bignum" (list x x)
       (list (apply + (list 0 x)) (apply + (list x 0))))
(test "0 - bignum" (list (- x) x)
       (list (apply - (list 0 x)) (apply - (list x 0))))
(test "0 * bignum" (list 0 0)
       (list (apply * (list 0 x)) (apply * (list x 0))))
(test "1 * bignum" (list x x)
       (list (apply * (list 1 x)) (apply * (list x 1))))
(test "bignum / 1" x
       (apply / (list x 1)))

(test-end)

;;------------------------------------------------------------------
(test-begin "small immediate integer constants")

;; pushing small literal integer on the stack may be done
;; by combined instruction PUSHI.  These test if it works.

(define (foo a b c d e) (list a b c d e))

;; 2^19-1
(test "PUSHI" '(0 524287 524288 -524287 -524288)
              (foo 0 524287 524288 -524287 -524288))
;; 2^51-1
(test "PUSHI" '(0 2251799813685247 2251799813685248
                  -2251799813685247 -2251799813685248 )
              (foo 0 2251799813685247 2251799813685248
             -2251799813685247 -2251799813685248))

(test-end)

;;------------------------------------------------------------------
(test-begin "small immediate integer additions")

;; small literal integer x (-2^19 <= x < 2^19 on 32bit architecture)
;; in binary addition/subtraction is compiled in special instructuions,
;; NUMADDI and NUMSUBI.

(define x 2)
(test "NUMADDI" 5 (+ 3 x))
(test "NUMADDI" 5 (+ x 3))
(test "NUMADDI" 1 (+ -1 x))
(test "NUMADDI" 1 (+ x -1))
(test "NUMSUBI" 1 (- 3 x))
(test "NUMSUBI" -1 (- x 3))
(test "NUMSUBI" -5 (- -3 x))
(test "NUMSUBI" 5 (- x -3))
(define x 2.0)
(test "NUMADDI" 5.0 (+ 3 x))
(test "NUMADDI" 5.0 (+ x 3))
(test "NUMADDI" 1.0 (+ -1 x))
(test "NUMADDI" 1.0 (+ x -1))
(test "NUMSUBI" 1.0 (- 3 x))
(test "NUMSUBI" -1.0 (- x 3))
(test "NUMSUBI" -5.0 (- -3 x))
(test "NUMSUBI" 5.0 (- x -3))
(define x #x100000000)
(test "NUMADDI" #x100000003 (+ 3 x))
(test "NUMADDI" #x100000003 (+ x 3))
(test "NUMADDI" #xffffffff (+ -1 x))
(test "NUMADDI" #xffffffff (+ x -1))
(test "NUMSUBI" #x-fffffffd (- 3 x))
(test "NUMSUBI" #xfffffffd (- x 3))
(test "NUMSUBI" #x-100000003 (- -3 x))
(test "NUMSUBI" #x100000003 (- x -3))
(define x 33/7)
(test "NUMADDI" 54/7 (+ 3 x))
(test "NUMADDI" 54/7 (+ x 3))
(test "NUMADDI" 26/7 (+ -1 x))
(test "NUMADDI" 26/7 (+ x -1))
(test "NUMADDI" -12/7 (- 3 x))
(test "NUMADDI" 12/7 (- x 3))
(test "NUMADDI" -54/7 (- -3 x))
(test "NUMADDI" 54/7 (- x -3))

(test "NUMADDI" 30 (+ 10 (if #t 20 25)))
(test "NUMADDI" 30 (+ (if #t 20 25) 10))
(test "NUMADDI" 35 (+ 10 (if #f 20 25)))
(test "NUMADDI" 35 (+ (if #f 20 25) 10))
(test "NUMADDI" 30 (let ((x #t)) (+ 10 (if x 20 25))))
(test "NUMADDI" 30 (let ((x #t)) (+ (if x 20 25) 10)))
(test "NUMADDI" 35 (let ((x #f)) (+ 10 (if x 20 25))))
(test "NUMADDI" 35 (let ((x #f)) (+ (if x 20 25) 10)))
(test "NUMADDI" 21 (+ 10 (do ((x 0 (+ x 1))) ((> x 10) x))))
(test "NUMADDI" 21 (+ (do ((x 0 (+ x 1))) ((> x 10) x)) 10))
(test "NUMSUBI" -10 (- 10 (if #t 20 25)))
(test "NUMSUBI" 10 (- (if #t 20 25) 10))
(test "NUMSUBI" -15 (- 10 (if #f 20 25)))
(test "NUMSUBI" 15 (- (if #f 20 25) 10))
(test "NUMSUBI" -10 (let ((x #t)) (- 10 (if x 20 25))))
(test "NUMSUBI" 10 (let ((x #t)) (- (if x 20 25) 10)))
(test "NUMSUBI" -15 (let ((x #f)) (- 10 (if x 20 25))))
(test "NUMSUBI" 15 (let ((x #f)) (- (if x 20 25) 10)))
(test "NUMSUBI" -1 (- 10 (do ((x 0 (+ x 1))) ((> x 10) x))))
(test "NUMSUBI" 1 (- (do ((x 0 (+ x 1))) ((> x 10) x)) 10))

(test-end)

;;------------------------------------------------------------------
(test-begin "immediate flonum integer arith")

;; tests special instructions for immediate flonum integer arithmetic


(define x 2.0)
(test "NUMADDF" 5.0 (+ 3 x))
(test "NUMADDF" 5.0 (+ x 3))
(test "NUMADDF" 1.0 (+ -1 x))
(test "NUMADDF" 1.0 (+ x -1))
(test "NUMADDF" 2.0+1.0i (+ +i x))
(test "NUMADDF" 2.0+1.0i (+ x +i))

(test "NUMSUBF" 1.0 (- 3 x))
(test "NUMSUBF" -1.0 (- x 3))
(test "NUMSUBF" -5.0 (- -3 x))
(test "NUMSUBF" 5.0 (- x -3))
(test "NUMSUBF" -2.0+1.0i (- +i x))
(test "NUMSUBF" 2.0-1.0i (- x +i))

(test "NUMMULF" 4.0 (* x 2))
(test "NUMMULF" 4.0 (* 2 x))
(test "NUMMULF" 3.0 (* x 1.5))
(test "NUMMULF" 3.0 (* 1.5 x))
(test "NUMMULF" 0+2.0i (* x +i))
(test "NUMMULF" 0+2.0i (* +i x))

(test "NUMDIVF" 0.5 (/ x 4))
(test "NUMDIVF" 2.0 (/ 4 x))
(test "NUMDIVF" 0.5 (/ x 4.0))
(test "NUMDIVF" 2.0 (/ 4.0 x))
(test "NUMDIVF" 0.0-0.5i (/ x +4i))
(test "NUMDIVF" 0.0+2.0i (/ +4i x))

(test-end)

;;------------------------------------------------------------------
(test-begin "rational number addition")

(test "ratnum +" 482/247 (+ 11/13 21/19))
(test "ratnum -" -64/247 (- 11/13 21/19))

;; tests possible shortcut in Scm_Add etc.
(test "ratnum + 0" (list 11/13 11/13)
       (list (apply + '(0 11/13)) (apply + '(11/13 0))))
(test "ratnum - 0" (list -11/13 11/13)
       (list (apply - '(0 11/13)) (apply - '(11/13 0))))
(test "ratnum * 0" (list 0 0)
       (list (apply * '(0 11/13)) (apply * '(11/13 0))))
(test "ratnum * 1" (list 11/13 11/13)
       (list (apply * '(1 11/13)) (apply * '(11/13 1))))
(test "ratnum / 1" 11/13
       (apply / '(11/13 1)))

(test-end)

;;------------------------------------------------------------------
(test-begin "promotions in addition")

(define-syntax +-tester
  (syntax-rules ()
    ((_ (+ args ...))
     (let ((inline (+ args ...))
           (other  (apply + `(,args ...))))
       (and (= inline other)
            (list inline (exact? inline)))))))

(test "+" '(0 #t) (+-tester (+)))
(test "+" '(1 #t) (+-tester (+ 1)))
(test "+" '(3 #t) (+-tester (+ 1 2)))
(test "+" '(6 #t) (+-tester (+ 1 2 3)))
(test "+" '(1 #t) (+-tester (+ 1/6 1/3 1/2)))
(test "+" '(1.0 #f) (+-tester (+ 1.0)))
(test "+" '(3.0 #f) (+-tester (+ 1.0 2)))
(test "+" '(3.0 #f) (+-tester (+ 1 2.0)))
(test "+" '(6.0 #f) (+-tester (+ 1 2 3.0)))
(test "+" '(1.0 #f) (+-tester (+ 1/6 1/3 0.5)))
(test "+" '(1+i #t) (+-tester (+ 1 +i)))
(test "+" '(3+i #t) (+-tester (+ 1 2 +i)))
(test "+" '(3+i #t) (+-tester (+ +i 1 2)))
(test "+" '(3.0+i #f) (+-tester (+ 1.0 2 +i)))
(test "+" '(3.0+i #f) (+-tester (+ +i 1.0 2)))
(test "+" '(4294967298.0 #f) (+-tester (+ 4294967297 1.0)))
(test "+" '(4294967299.0 #f) (+-tester (+ 4294967297 1 1.0)))
(test "+" '(4294967298.0-i #f) (+-tester (+ 4294967297 1.0 -i)))
(test "+" '(4294967298.0-i #f) (+-tester (+ -i 4294967297 1.0)))
(test "+" '(4294967298.0-i #f) (+-tester (+ 1.0 4294967297 -i)))

(test-end)

;;------------------------------------------------------------------
(test-begin "integer multiplication")

(define (m-result x) (list x (- x) (- x) x x (- x) (- x) x))
(define (m-tester x y)
  (list (* x y) (* (- x) y) (* x (- y)) (* (- x) (- y))
        (apply * (list x y)) (apply * (list (- x) y))
        (apply * (list x (- y))) (apply * (list (- x) (- y)))))

(test "fix*fix->big[1]" (m-result 727836879)
      (m-tester 41943 17353))
(test "fix*fix->big[1]" (m-result 3663846879)
      (m-tester 41943 87353))
(test "fix*fix->big[2]" (m-result 4294967296)
      (m-tester 65536 65536))
(test "fix*fix->big[2]" (m-result 366384949959)
      (m-tester 4194303 87353))
(test "fix*big[1]->big[1]" (m-result 3378812463)
      (m-tester 3 1126270821))
(test "fix*big[1]->big[2]" (m-result 368276265762816)
      (m-tester 85746 4294967296))
(test "big[1]*fix->big[1]" (m-result 3378812463)
      (m-tester 1126270821 3))
(test "big[1]*fix->big[2]" (m-result 368276265762816)
      (m-tester 4294967296 85746))
(test "big[2]*fix->big[2]" (m-result 12312849128741)
      (m-tester 535341266467 23))
(test "big[1]*big[1]->big[2]" (m-result 1345585795375391817)
      (m-tester 1194726677 1126270821))

;; Large number multiplication test using Fermat's number
;; The decomposition of Fermat's number is taken from
;;   http://www.dd.iij4u.or.jp/~okuyamak/Information/Fermat.html
(test "fermat(7)" (fermat 7)
      (* 59649589127497217 5704689200685129054721))
(test "fermat(8)" (fermat 8)
              (* 1238926361552897
           93461639715357977769163558199606896584051237541638188580280321))
(test "fermat(9)" (fermat 9)
              (* 2424833
           7455602825647884208337395736200454918783366342657
           741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737))
(test "fermat(10)" (fermat 10)
              (* 45592577
           6487031809
           4659775785220018543264560743076778192897
           130439874405488189727484768796509903946608530841611892186895295776832416251471863574140227977573104895898783928842923844831149032913798729088601617946094119449010595906710130531906171018354491609619193912488538116080712299672322806217820753127014424577
           ))
(test "fermat(11)" (fermat 11)
              (* 319489
           974849
           167988556341760475137
           3560841906445833920513
           173462447179147555430258970864309778377421844723664084649347019061363579192879108857591038330408837177983810868451546421940712978306134189864280826014542758708589243873685563973118948869399158545506611147420216132557017260564139394366945793220968665108959685482705388072645828554151936401912464931182546092879815733057795573358504982279280090942872567591518912118622751714319229788100979251036035496917279912663527358783236647193154777091427745377038294584918917590325110939381322486044298573971650711059244462177542540706913047034664643603491382441723306598834177
           ))

(test-end)

;;------------------------------------------------------------------
(test-begin "multiplication short cuts")

(parameterize ((current-test-comparator eqv?))
;; these test shortcut in Scm_Mul
;; note the difference of 0 and 0.0
  (let1 big (read-from-string "100000000000000000000")
        (test "bignum * 0"  0 (apply * `(,big 0)))
        (test "0 * bignum"  0 (apply * `(0 ,big)))
        (test "bignum * 1"  big (apply * `(,big 1)))
        (test "1 * bignum"  big (apply * `(1 ,big)))
  
        (test "bignum * 0.0"  0.0 (apply * `(,big 0.0)))
        (test "0.0 * bignum"  0.0 (apply * `(0.0 ,big)))
        (test "bignum * 1.0"  1.0e20 (apply * `(,big 1.0)))
        (test "1.0 * bignum"  1.0e20 (apply * `(1.0 ,big)))
        )

(test "ratnum * 0"  0 (apply * '(1/2 0)))
(test "0 * ratnum"  0 (apply * '(0 1/2)))
(test "ratnum * 1"  1/2 (apply * '(1/2 1)))
(test "1 * ratnum"  1/2 (apply * '(1 1/2)))

(test "ratnum * 0.0"  0.0 (apply * '(1/2 0.0)))
(test "0.0 * ratnum"  0.0 (apply * '(0.0 1/2)))
(test "ratnum * 1.0"  0.5 (apply * '(1/2 1.0)))
(test "1.0 * ratnum"  0.5 (apply * '(1.0 1/2)))

;; Fixed for exactness (Gauche represents zero always exactly?)
(test "flonum * 0"  0.0 (apply * '(3.0 0)))
(test "0 * flonum"  0.0 (apply * '(0 3.0)))
(test "flonum * 1"  3.0 (apply * '(3.0 1)))
(test "1 * flonum"  3.0 (apply * '(1 3.0)))

(test "flonum * 0.0"  0.0 (apply * '(3.0 0.0)))
(test "0.0 * flonum"  0.0 (apply * '(0.0 3.0)))
(test "flonum * 1.0"  3.0 (apply * '(3.0 1.0)))
(test "1.0 * flonum"  3.0 (apply * '(1.0 3.0)))

(test "compnum * 0" 0 (* 0 +i))
(test "0 * compnum" 0 (* +i 0))
(test "compnum * 1" +i (* 1 +i))
(test "1 * compnum" +i (* +i 1))

(test "compnum * 0.0" 0.0 (* 0.0 +i))
(test "0.0 * compnum" 0.0 (* +i 0.0))
(test "compnum * 1.0" +1.0i (* 1.0 +i))
(test "1.0 * compnum" +1.0i (* +i 1.0)))

(test-end)

;;------------------------------------------------------------------
(test-begin "division")

(test "exact division" 3/20 (/ 3 4 5))
(test "exact division" 1/2  (/ 9223372036854775808 18446744073709551616))
(test "exact division" 4692297364841/7
       (/ 28153784189046 42))
(test "exact division" 7/4692297364841
       (/ 42 28153784189046))
(test "exact division" -7/4692297364841
       (/ 42 -28153784189046))
(test "exact division" 7/4692297364841
       (/ -42 -28153784189046))
(test "exact reciprocal" 1/3 (/ 3))
(test "exact reciprocal" -1/3 (/ -3))
(test "exact reciprocal" 5/6 (/ 6/5))
(test "exact reciprocal" -5/6 (/ -6/5))
(test "exact reciprocal" 7/4692297364841 (/ 4692297364841/7))

(define (almost=? x y)
  (define (flonum=? x y)
    (let ((ax (abs x)) (ay (abs y)))
      (< (abs (- x y)) (* (max ax ay) 0.0000000000001))))
  (and (flonum=? (car x) (car y))
       (flonum=? (cadr x) (cadr y))
       (flonum=? (caddr x) (caddr y))
       (flonum=? (cadddr x) (cadddr y))
       (eq? (list-ref x 4) (list-ref y 4))))

(define (d-result x exact?) (list x (- x) (- x) x exact?))
(define (d-tester x y)
  (list (/ x y) (/ (- x) y) (/ x (- y)) (/ (- x) (- y))
        (exact? (/ x y))))

;; inexact division
(test "exact/inexact -> inexact" (d-result 3.25 #f)
      (d-tester 13 4.0))
(test "exact/inexact -> inexact" (d-result 1.625 #f)
      (d-tester 13/2 4.0))
(test "inexact/exact -> inexact" (d-result 3.25 #f)
      (d-tester 13.0 4))
(test "inexact/exact -> inexact" (d-result 9.75 #f)
      (d-tester 13.0 4/3))
(test "inexact/inexact -> inexact" (d-result 3.25 #f)
      (d-tester 13.0 4.0))

;; complex division
(test "complex division" 0.0
       (let ((a 3)
             (b 4+3i)
             (c 7.3))
         (- (/ a b c)
            (/ (/ a b) c))))

(test-end)

;;------------------------------------------------------------------
(test-begin "quotient")

(define (q-result x exact?) (list x (- x) (- x) x exact?))
(define (q-tester x y)
  (list (quotient x y) (quotient (- x) y)
        (quotient x (- y)) (quotient (- x) (- y))
        (exact? (quotient x y))))


;; these uses BignumDivSI -> bignum_sdiv
(test "big[1]/fix->fix" (q-result 17353 #t) 
      (q-tester 727836879 41943))
(test "big[1]/fix->fix" (q-result 136582 #t)
      (q-tester 3735928559 27353))
(test "big[2]/fix->big[1]" (q-result 535341266467 #t)
      (q-tester 12312849128741 23))
(test "big[2]/fix->big[2]" (q-result 12312849128741 #t)
      (q-tester 12312849128741 1))

;; these uses BignumDivSI -> bignum_gdiv
(test "big[1]/fix->fix" (q-result 41943 #t)
      (q-tester 3663846879 87353))
(test "big[2]/fix->fix" (q-result 19088743 #t)
      (q-tester 705986470884353 36984440))
(test "big[2]/fix->fix" (q-result 92894912 #t)
      (q-tester 12312849128741 132546))
(test "big[2]/fix->big[1]" (q-result 2582762030 #t)
      (q-tester 425897458766735 164900))

;; these uses BignumDivRem
(test "big[1]/big[1]->fix" (q-result 2 #t)
      (q-tester 4020957098 1952679221))
(test "big[1]/big[1] -> fix" (q-result 0 #t)
      (q-tester 1952679221 4020957098))
;; this tests loop in estimation phase
(test "big[3]/big[2] -> big[1]" (q-result #xffff0001 #t)
      (q-tester #x10000000000000000 #x10000ffff))
;; this test goes through a rare case handling code ("add back") in
;; the algorithm.
(test "big[3]/big[2] -> fix" (q-result #xeffe #t)
      (q-tester #x7800000000000000 #x80008889ffff))

;; inexact quotient
(test "exact/inexact -> inexact" (q-result 3.0 #f)
      (q-tester 13 4.0))
(test "inexact/exact -> inexact" (q-result 3.0 #f)
      (q-tester 13.0 4))
(test "inexact/inexact -> inexact" (q-result 3.0 #f)
      (q-tester 13.0 4.0))
(test "exact/inexact -> inexact" (q-result 17353.0 #f)
      (q-tester 727836879 41943.0))
(test "inexact/exact -> inexact" (q-result 17353.0 #f)
      (q-tester 727836879.0 41943))
(test "inexact/inexact -> inexact" (q-result 17353.0 #f)
      (q-tester 727836879.0 41943.0))

;; Test by fermat numbers
(test "fermat(7)" 59649589127497217
      (quotient (fermat 7) 5704689200685129054721))
(test "fermat(8)" 1238926361552897
              (quotient (fermat 8) 93461639715357977769163558199606896584051237541638188580280321))
(test "fermat(9)" 2424833
              (quotient (quotient (fermat 9) 7455602825647884208337395736200454918783366342657)
                  741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737))
(test "fermat(10)" 4659775785220018543264560743076778192897
              (quotient (quotient (quotient (fermat 10)
                                      130439874405488189727484768796509903946608530841611892186895295776832416251471863574140227977573104895898783928842923844831149032913798729088601617946094119449010595906710130531906171018354491609619193912488538116080712299672322806217820753127014424577)
                            6487031809)
                  45592577))
(test "fermat(11)" 3560841906445833920513
              (quotient (quotient (quotient (quotient (fermat 11)
                                                167988556341760475137)
                                      173462447179147555430258970864309778377421844723664084649347019061363579192879108857591038330408837177983810868451546421940712978306134189864280826014542758708589243873685563973118948869399158545506611147420216132557017260564139394366945793220968665108959685482705388072645828554151936401912464931182546092879815733057795573358504982279280090942872567591518912118622751714319229788100979251036035496917279912663527358783236647193154777091427745377038294584918917590325110939381322486044298573971650711059244462177542540706913047034664643603491382441723306598834177
                                      )
                            974849)
                  319489))

(test-end)

;;------------------------------------------------------------------
(test-begin "remainder")

(define (r-result x exact?) (list x (- x) x (- x) exact?))
(define (r-tester x y)
  (list (remainder x y) (remainder (- x) y)
        (remainder x (- y)) (remainder (- x) (- y))
        (exact? (remainder x y))))

;; small int
(test "fix rem fix -> fix" (r-result 1 #t)
      (r-tester 13 4))
(test "fix rem fix -> fix" (r-result 1234 #t)
      (r-tester 1234 87935))
(test "fix rem big[1] -> fix" (r-result 12345 #t)
      (r-tester 12345 3735928559))

;; these uses BignumDivSI -> bignum_sdiv
(test "big[1] rem fix -> fix" (r-result 0 #t)
      (r-tester 727836879 41943))
(test "big[1] rem fix -> fix" (r-result 1113 #t)
      (r-tester 3735928559 27353))
(test "big[2] rem fix -> fix" (r-result 15 #t)
      (r-tester 12312849128756 23))
(test "big[2] rem fix -> fix" (r-result 0 #t)
      (r-tester 12312849128756 1))

;; these uses BignumDivSI -> bignum_gdiv
(test "big[1] rem fix -> fix" (r-result 0 #t)
      (r-tester 3663846879 87353))
(test "big[2] rem fix -> fix" (r-result 725433 #t)
      (r-tester 705986470884353 36984440))
(test "big[2] rem fix -> fix" (r-result 122789 #t)
      (r-tester 12312849128741 132546))
(test "big[2] rem fix -> fix" (r-result 19735 #t)
      (r-tester 425897458766735 164900))

;; these uses BignumDivRem
(test "big[1] rem big[1] -> fix" (r-result 115598656 #t)
      (r-tester 4020957098 1952679221))
(test "big[1] rem big[1] -> fix" (r-result 1952679221 #t)
      (r-tester 1952679221 4020957098))
;; this tests loop in estimation phase
(test "big[3] rem big[2] -> big[1]" (r-result #xfffe0001 #t)
      (r-tester #x10000000000000000 #x10000ffff))
;; this tests "add back" code
(test "big[3] rem big[2] -> big[2]" (r-result #x7fffb114effe #t)
      (r-tester #x7800000000000000 #x80008889ffff))

;; inexact remainder
(test "exact rem inexact -> inexact" (r-result 1.0 #f)
      (r-tester 13 4.0))
(test "inexact rem exact -> inexact" (r-result 1.0 #f)
      (r-tester 13.0 4))
(test "inexact rem inexact -> inexact" (r-result 1.0 #f)
      (r-tester 13.0 4.0))
(test "exact rem inexact -> inexact" (r-result 1113.0 #f)
      (r-tester 3735928559 27353.0))
(test "inexact rem exact -> inexact" (r-result 1113.0 #f)
      (r-tester 3735928559.0 27353))
(test "inexact rem inexact -> inexact" (r-result 1113.0 #f)
      (r-tester 3735928559.0 27353.0))

(test-end)

;;------------------------------------------------------------------
(test-begin "modulo")

(define (m-result a b exact?) (list a b (- b) (- a) exact?))
(define (m-tester x y)
  (list (modulo x y) (modulo (- x) y)
        (modulo x (- y)) (modulo (- x) (- y))
        (exact? (modulo x y))))

;; small int
(test "fix mod fix -> fix" (m-result 1 3 #t)
      (m-tester 13 4))
(test "fix mod fix -> fix" (m-result 1234 86701 #t)
      (m-tester 1234 87935))
(test "fix mod big[1] -> fix/big" (m-result 12345 3735916214 #t)
      (m-tester 12345 3735928559))

;; these uses BignumDivSI -> bignum_sdiv
(test "big[1] mod fix -> fix" (m-result 0 0 #t)
      (m-tester 727836879 41943))
(test "big[1] mod fix -> fix" (m-result 1113 26240 #t)
      (m-tester 3735928559 27353))
(test "big[2] mod fix -> fix" (m-result 15 8 #t)
      (m-tester 12312849128756 23))
(test "big[2] mod fix -> fix" (m-result 0 0 #t)
      (m-tester 12312849128756 1))

;; these uses BignumDivSI -> bignum_gdiv
(test "big[1] mod fix -> fix" (m-result 0 0 #t)
      (m-tester 3663846879 87353))
(test "big[2] mod fix -> fix" (m-result 725433 36259007 #t)
      (m-tester 705986470884353 36984440))
(test "big[2] mod fix -> fix" (m-result 122789 9757 #t)
      (m-tester 12312849128741 132546))
(test "big[2] mod fix -> fix" (m-result 19735 145165 #t)
      (m-tester 425897458766735 164900))

;; these uses BignumDivRem
(test "big[1] mod big[1] -> fix" (m-result 115598656 1837080565 #t)
      (m-tester 4020957098 1952679221))
(test "big[1] mod big[1] -> fix" (m-result 1952679221 2068277877 #t)
      (m-tester 1952679221 4020957098))
;; this tests loop in estimation phase
(test "big[3] mod big[2] -> big[1]" (m-result #xfffe0001 #x2fffe #t)
      (m-tester #x10000000000000000 #x10000ffff))
;; this tests "add back" code
(test "big[3] mod big[2] -> big[2]" (m-result #x7fffb114effe #xd7751001 #t)
      (m-tester #x7800000000000000 #x80008889ffff))

;; inexact modulo
(test "exact mod inexact -> inexact" (m-result 1.0 3.0 #f)
      (m-tester 13 4.0))
(test "inexact mod exact -> inexact" (m-result 1.0 3.0 #f)
      (m-tester 13.0 4))
(test "inexact mod inexact -> inexact" (m-result 1.0 3.0 #f)
      (m-tester 13.0 4.0))
(test "exact mod inexact -> inexact" (m-result 1113.0 26240.0 #f)
      (m-tester 3735928559 27353.0))
(test "inexact mod exact -> inexact" (m-result 1113.0 26240.0 #f)
      (m-tester 3735928559.0 27353))
(test "inexact mod inexact -> inexact" (m-result 1113.0 26240.0 #f)
      (m-tester 3735928559.0 27353.0))

;; test by mersenne prime? - code by 'hipster'

(define (mersenne-prime? p)
  (let ((m (- (expt 2 p) 1)))
    (do ((i 3 (+ i 1))
         (s 4 (modulo (- (* s s) 2) m)))
        ((= i (+ p 1)) (= s 0)))))

(test "mersenne prime"
       '(#t #t #t #t #t #t #t #t #t #t #t #t #t #t)
       (map mersenne-prime? '(3 5 7 13 17 19 31 61 89 107 127 521 607 1279)))

(test-end)

;;------------------------------------------------------------------
;; R6RS
#|
(test-begin "div and mod")

(let ()
  (define (do-quadrants proc)
    (lambda (x y =)
      (proc x y =)
      (proc (- x) y =)
      (proc x (- y) =)
      (proc (- x) (- y) =)))

  (define (test-div x y =)
    (test (format "~a div ~a" x y) '(#t #t)
           (receive (d m) (div-and-mod x y)
             (let1 z (+ (* d y) m)
               (list (or (= x z) z)
                     (or (and (<= 0 m) (< m (abs y))) m))))))

  (define (test-div0 x y =)
    (test (format "~a div0 ~a" x y) '(#t #t)
           (receive (d m) (div0-and-mod0 x y)
             (let1 z (+ (* d y) m)
               (list (or (= x z) z)
                     (or (and (<= (- (abs y)) (* m 2))
                              (< (* m 2) (abs y)))
                         m))))))

  ((do-quadrants test-div) 123 10 =)
  (parameterize ((current-test-epsilon 1e-10))
    ((do-quadrants test-div) 123.0 10.0 =))
  ((do-quadrants test-div) (read-from-string "123/7") (read-from-string "10/7") =)
  ((do-quadrants test-div) (read-from-string "123/7") 5 =)
  ((do-quadrants test-div) 123 (read-from-string "5/7") =)
  ((do-quadrants test-div) 130.75 10.5 =)

  ((do-quadrants test-div0) 123 10 =)
  ((do-quadrants test-div0) 129 10 =)
  (parameterize ((current-test-epsilon 1e-10))
   ((do-quadrants test-div0) 123.0 10.0 =)
   ((do-quadrants test-div0) 129.0 10.0 =))
  ((do-quadrants test-div0) (read-from-string "123/7") (read-from-string "10/7") =)
  ((do-quadrants test-div0) (read-from-string "129/7") (read-from-string "10/7") =)
  ((do-quadrants test-div0) (read-from-string "121/7") 5 =)
  ((do-quadrants test-div0) (read-from-string "124/7") 5 =)
  ((do-quadrants test-div0) 121 (read-from-string "5/7") =)
  ((do-quadrants test-div0) 124 (read-from-string "5/7") =)
  ((do-quadrants test-div0) 130.75 10.5 =)
  ((do-quadrants test-div0) 129.75 10.5 =)
  )

(test-end)
|#
;;------------------------------------------------------------------
(test-begin "rounding")

(define (round-tester value exactness cei flo tru rou)
  (test (string-append "rounding " (number->string value))
         (list exactness cei flo tru rou)
         (let ((c (ceiling value))
               (f (floor value))
               (t (truncate value))
               (r (round value)))
           (list (and (exact? c) (exact? f) (exact? t) (exact? r))
                 c f t r))))

(round-tester 0  #t 0 0 0 0)
(round-tester 3  #t 3 3 3 3)
(round-tester -3 #t -3 -3 -3 -3)
(round-tester (expt 2 99) #t (expt 2 99) (expt 2 99) (expt 2 99) (expt 2 99))
(round-tester (- (expt 2 99)) #t
              (- (expt 2 99)) (- (expt 2 99)) (- (expt 2 99)) (- (expt 2 99)))

(round-tester 9/4  #t 3 2 2 2)
(round-tester -9/4 #t -2 -3 -2 -2)
(round-tester 34985495387484938453495/17 #t
              2057970316910878732559
              2057970316910878732558
              2057970316910878732558
              2057970316910878732559)
(round-tester -34985495387484938453495/17 #t
              -2057970316910878732558
              -2057970316910878732559
              -2057970316910878732558
              -2057970316910878732559)

(round-tester 35565/2 #t 17783 17782 17782 17782)
(round-tester -35565/2 #t -17782 -17783 -17782 -17782)
(round-tester 35567/2 #t 17784 17783 17783 17784)
(round-tester -35567/2 #t -17783 -17784 -17783 -17784)

(test "round->exact" 3 (round->exact 3.4))
(test "round->exact" 4 (round->exact 3.5))
(test "floor->exact" 3 (floor->exact 3.4))
(test "floor->exact" -4 (floor->exact -3.5))
(test "ceiling->exact" 4 (ceiling->exact 3.4))
(test "ceiling->exact" -3 (ceiling->exact -3.5))
(test "truncate->exact" 3 (truncate->exact 3.4))
(test "truncate->exact" -3 (truncate->exact -3.5))

(test-end)

;;------------------------------------------------------------------

#|
;; Nonstandard and Gauche-specific
(test-begin "clamping")

(parameterize ((current-test-comparator eqv?))
 (test "clamp (1)"   1   (clamp 1))
 (test "clamp (1 #f)" 1  (clamp 1 #f))
 (test "clamp (1 #f #f)" 1  (clamp 1 #f #f))
 (test "clamp (1.0)"   1.0   (clamp 1.0))
 (test "clamp (1.0 #f)" 1.0  (clamp 1.0 #f))
 (test "clamp (1.0 #f #f)" 1.0  (clamp 1.0 #f #f))

 (test "clamp (1 0)" 1   (clamp 1 0))
 (test "clamp (1 0 #f)" 1 (clamp 1 0 #f))
 (test "clamp (1 0 2)" 1 (clamp 1 0 2))
 (test "clamp (1 5/4)" 5/4 (clamp 1 5/4))
 (test "clamp (1 5/4 #f)" 5/4 (clamp 1 5/4 #f))
 (test "clamp (1 #f 5/4)" 1 (clamp 1 #f 5/4))
 (test "clamp (1 0 3/4)" 3/4 (clamp 1 0 3/4))
 (test "clamp (1 #f 3/4)" 3/4 (clamp 1 #f 3/4))

 (test "clamp (1.0 0)" 1.0   (clamp 1.0 0))
 (test "clamp (1.0 0 #f)" 1.0 (clamp 1.0 0 #f))
 (test "clamp (1.0 0 2)" 1.0 (clamp 1.0 0 2))
 (test "clamp (1.0 5/4)" 1.25 (clamp 1.0 5/4))
 (test "clamp (1.0 5/4 #f)" 1.25 (clamp 1.0 5/4 #f))
 (test "clamp (1.0 #f 5/4)" 1.0 (clamp 1.0 #f 5/4))
 (test "clamp (1.0 0 3/4)" 0.75 (clamp 1.0 0 3/4))
 (test "clamp (1.0 #f 3/4)" 0.75 (clamp 1.0 #f 3/4))

 (test "clamp (1 0.0)" 1.0   (clamp 1 0.0))
 (test "clamp (1 0.0 #f)" 1.0 (clamp 1 0.0 #f))
 (test "clamp (1 0.0 2)" 1.0 (clamp 1 0.0 2))
 (test "clamp (1 0 2.0)" 1.0 (clamp 1 0 2.0))
 (test "clamp (1 1.25)" 1.25 (clamp 1 1.25))
 (test "clamp (1 #f 1.25)" 1.0 (clamp 1 #f 1.25))
 (test "clamp (1 1.25 #f)" 1.25 (clamp 1 1.25 #f))
 (test "clamp (1 0.0 3/4)" 0.75 (clamp 1 0.0 3/4))
 (test "clamp (1 0 0.75)" 0.75 (clamp 1 0 0.75))

 (test "clamp (1 -inf.0 +inf.0)" 1.0 (clamp 1 -inf.0 +inf.0)))

(test-end)
|#

;;------------------------------------------------------------------
(test-begin "logical operations")

(test "ash (fixnum)" #x408000           ;fixnum
      (ash #x81 15))
(test "ash (fixnum)" #x81
      (ash #x408000 -15))
(test "ash (fixnum)" #x01
      (ash #x408000 -22))
(test "ash (fixnum)" 0
      (ash #x408000 -23))
(test "ash (fixnum)" 0
      (ash #x408000 -24))
(test "ash (fixnum)" 0
      (ash #x408000 -100))
(test "ash (fixnum)" #x81
      (ash #x81 0))
(test "ash (neg. fixnum)" #x-408000  ;negative fixnum
      (ash #x-81 15))
(test "ash (neg. fixnum)" #x-81      ;nagative fixnum
      (ash #x-408000 -15))
(test "ash (fixnum)" -2
      (ash #x-408000 -22))
(test "ash (fixnum)" -1
      (ash #x-408000 -23))
(test "ash (fixnum)" -1
      (ash #x-408000 -24))
(test "ash (fixnum)" -1
      (ash #x-408000 -100))
(test "ash (fixnum)" #x-408000
      (ash #x-408000 0))


(test "ash (fixnum->bignum)" #x81000000
      (ash #x81 24))
(test "ash (fixnum->bignum)" #x4080000000
      (ash #x81 31))
(test "ash (fixnum->bignum)" #x8100000000
      (ash #x81 32))
(test "ash (fixnum->bignum)" #x8100000000000000
      (ash #x81 56))
(test "ash (fixnum->bignum)" #x408000000000000000
      (ash #x81 63))
(test "ash (fixnum->bignum)" #x810000000000000000
      (ash #x81 64))
(test "ash (neg.fixnum->bignum)" #x-81000000
      (ash #x-81 24))
(test "ash (neg.fixnum->bignum)" #x-4080000000
      (ash #x-81 31))
(test "ash (neg.fixnum->bignum)" #x-8100000000
      (ash #x-81 32))
(test "ash (neg.fixnum->bignum)" #x-8100000000000000
      (ash #x-81 56))
(test "ash (neg.fixnum->bignum)" #x-408000000000000000
      (ash #x-81 63))
(test "ash (neg.fixnum->bignum)" #x-810000000000000000
      (ash #x-81 64))

(test "ash (bignum->fixnum)" #x81
      (ash  #x81000000 -24))
(test "ash (bignum->fixnum)" #x40
      (ash  #x81000000 -25))
(test "ash (bignum->fixnum)" 1
      (ash  #x81000000 -31))
(test "ash (bignum->fixnum)" 0
      (ash  #x81000000 -32))
(test "ash (bignum->fixnum)" 0
      (ash  #x81000000 -100))
(test "ash (bignum->fixnum)" #x81
      (ash #x4080000000 -31))
(test "ash (bignum->fixnum)" #x81
      (ash #x8100000000 -32))
(test "ash (bignum->fixnum)" #x40
      (ash #x8100000000 -33))
(test "ash (bignum->fixnum)" 1
      (ash #x8100000000 -39))
(test "ash (bignum->fixnum)" 0
      (ash #x8100000000 -40))
(test "ash (bignum->fixnum)" 0
      (ash #x8100000000 -100))
(test "ash (bignum->fixnum)" #x81
      (ash #x8100000000000000 -56))
(test "ash (bignum->fixnum)" #x81
      (ash #x408000000000000000 -63))
(test "ash (bignum->fixnum)" #x40
      (ash #x408000000000000000 -64))
(test "ash (bignum->fixnum)" #x20
      (ash #x408000000000000000 -65))
(test "ash (bignum->fixnum)" 1
      (ash #x408000000000000000 -70))
(test "ash (bignum->fixnum)" 0
      (ash #x408000000000000000 -71))
(test "ash (bignum->fixnum)" 0
      (ash #x408000000000000000 -100))

(test "ash (neg.bignum->fixnum)" #x-81
      (ash #x-81000000 -24))
(test "ash (neg.bignum->fixnum)" #x-41
      (ash #x-81000000 -25))
(test "ash (neg.bignum->fixnum)" #x-21
      (ash #x-81000000 -26))
(test "ash (neg.bignum->fixnum)" -2
      (ash #x-81000000 -31))
(test "ash (neg.bignum->fixnum)" -1
      (ash #x-81000000 -32))
(test "ash (neg.bignum->fixnum)" -1
      (ash #x-81000000 -33))
(test "ash (neg.bignum->fixnum)" -1
      (ash #x-81000000 -100))
(test "ash (neg.bignum->fixnum)" #x-81
      (ash #x-4080000000 -31))
(test "ash (neg.bignum->fixnum)" #x-41
      (ash #x-4080000000 -32))
(test "ash (neg.bignum->fixnum)" #x-21
      (ash #x-4080000000 -33))
(test "ash (neg.bignum->fixnum)" -2
      (ash #x-4080000000 -38))
(test "ash (neg.bignum->fixnum)" -1
      (ash #x-4080000000 -39))
(test "ash (neg.bignum->fixnum)" -1
      (ash #x-4080000000 -100))
(test "ash (neg.bignum->fixnum)" #x-81
      (ash #x-408000000000000000 -63))
(test "ash (neg.bignum->fixnum)" #x-41
      (ash #x-408000000000000000 -64))
(test "ash (neg.bignum->fixnum)" #x-21
      (ash #x-408000000000000000 -65))
(test "ash (neg.bignum->fixnum)" -2
      (ash #x-408000000000000000 -70))
(test "ash (neg.bignum->fixnum)" -1
      (ash #x-408000000000000000 -71))
(test "ash (neg.bignum->fixnum)" -1
      (ash #x-408000000000000000 -72))

(test "ash (bignum->bignum)" #x12345678123456780
      (ash #x1234567812345678 4))
(test "ash (bignum->bignum)" #x1234567812345678000000000000000
      (ash #x1234567812345678 60))
(test "ash (bignum->bignum)" #x12345678123456780000000000000000
      (ash #x1234567812345678 64))
(test "ash (bignum->bignum)" #x123456781234567
      (ash #x1234567812345678 -4))
(test "ash (bignum->bignum)" #x12345678
      (ash #x1234567812345678 -32))
(test "ash (neg.bignum->bignum)" #x-123456781234568
      (ash #x-1234567812345678 -4))
(test "ash (bignum->bignum)" #x-12345679
      (ash #x-1234567812345678 -32))

(test "lognot (fixnum)" -1 (lognot 0))
(test "lognot (fixnum)" 0 (lognot -1))
(test "lognot (fixnum)" -65536 (lognot 65535))
(test "lognot (fixnum)" 65535 (lognot -65536))
(test "lognot (bignum)" #x-1000000000000000001
      (lognot #x1000000000000000000))
(test "lognot (bignum)" #x1000000000000000000
      (lognot #x-1000000000000000001))

(test "logand (+fix & 0)" 0
      (logand #x123456 0))
(test "logand (+big & 0)" 0
      (logand #x1234567812345678 0))
(test "logand (+fix & -1)" #x123456
      (logand #x123456 -1))
(test "logand (+big & -1)" #x1234567812345678
      (logand #x1234567812345678 -1))
(test "logand (+fix & +fix)" #x2244
      (logand #xaa55 #x6666))
(test "logand (+fix & +big)" #x2244
      (logand #xaa55 #x6666666666))
(test "logand (+big & +fix)" #x4422
      (logand #xaa55aa55aa #x6666))
(test "logand (+big & +big)" #x2244224422
      (logand #xaa55aa55aa #x6666666666))
(test "logand (+big & +big)" #x103454301aaccaa
      (logand #x123456789abcdef #xfedcba987654321fedcba987654321fedcba))
(test "logand (+big & +big)" #x400000
      (logand #xaa55ea55aa #x55aa55aa55))
(test "logand (+fix & -fix)" #x8810
      (logand #xaa55 #x-6666))
(test "logand (+fix & -big)" #x8810
      (logand #xaa55 #x-6666666666))
(test "logand (+big & -fix)" #xaa55aa118a
      (logand #xaa55aa55aa #x-6666))
(test "logand (+big & -big)" #x881188118a
      (logand #xaa55aa55aa #x-6666666666))
(test "logand (+big & -big)" #x20002488010146
      (logand #x123456789abcdef #x-fedcba987654321fedcba987654321fedcba))
(test "logand (-fix & +fix)" #x4422
      (logand #x-aa55 #x6666))
(test "logand (-fix & +big)" #x6666664422
      (logand #x-aa55 #x6666666666))
(test "logand (-big & +fix)" #x2246
      (logand #x-aa55aa55aa #x6666))
(test "logand (-big & +big)" #x4422442246
      (logand #x-aa55aa55aa #x6666666666))
(test "logand (-big & +big)" #xfedcba987654321fedcba884200020541010
      (logand #x-123456789abcdef #xfedcba987654321fedcba987654321fedcba))
(test "logand (-fix & -fix)" #x-ee76
      (logand #x-aa55 #x-6666))
(test "logand (-fix & -big)" #x-666666ee76
      (logand #x-aa55 #x-6666666666))
(test "logand (-big & -fix)" #x-aa55aa77ee
      (logand #x-aa55aa55aa #x-6666))
(test "logand (-big & -big)" #x-ee77ee77ee
      (logand #x-aa55aa55aa #x-6666666666))
(test "logand (-big & -big)" #x-fedcba987654321fedcba9a76567a9ffde00
      (logand #x-123456789abcdef #x-fedcba987654321fedcba987654321fedcba))

(test "logior (+fix | 0)" #x123456
      (logior #x123456 0))
(test "logior (+big | 0)" #x1234567812345678
      (logior #x1234567812345678 0))
(test "logior (+fix | -1)" -1
      (logior #x123456 -1))
(test "logior (+big | -1)" -1
      (logior #x1234567812345678 -1))
(test "logior (+fix | +fix)" #xee77
      (logior #xaa55 #x6666))
(test "logior (+fix | +big)" #x666666ee77
      (logior #xaa55 #x6666666666))
(test "logior (+big | +fix)" #xaa55aa77ee
      (logior #xaa55aa55aa #x6666))
(test "logior (+big | +big)" #xee77ee77ee
      (logior #xaa55aa55aa #x6666666666))
(test "logior (+big | +big)" #xfedcba987654321fedcba9a76567a9ffddff
      (logior #x123456789abcdef #xfedcba987654321fedcba987654321fedcba))
(test "logior (+fix | -fix)" #x-4421
      (logior #xaa55 #x-6666))
(test "logior (+fix | -big)" #x-6666664421
      (logior #xaa55 #x-6666666666))
(test "logior (+big | -fix)" #x-2246
      (logior #xaa55aa55aa #x-6666))
(test "logior (+big | -big)" #x-4422442246
      (logior #xaa55aa55aa #x-6666666666))
(test "logior (+big | -big)" #x-fedcba987654321fedcba884200020541011
      (logior #x123456789abcdef #x-fedcba987654321fedcba987654321fedcba))
(test "logior (-fix | +fix)" #x-8811
      (logior #x-aa55 #x6666))
(test "logior (-fix | +big)" #x-8811
      (logior #x-aa55 #x6666666666))
(test "logior (-big | +fix)" #x-aa55aa118a
      (logior #x-aa55aa55aa #x6666))
(test "logior (-big | +big)" #x-881188118a
      (logior #x-aa55aa55aa #x6666666666))
(test "logior (-big | +big)" #x-20002488010145
      (logior #x-123456789abcdef #xfedcba987654321fedcba987654321fedcba))
(test "logior (-fix | -fix)" #x-2245
      (logior #x-aa55 #x-6666))
(test "logior (-fix | -big)" #x-2245
      (logior #x-aa55 #x-6666666666))
(test "logior (-big | -fix)" #x-4422
      (logior #x-aa55aa55aa #x-6666))
(test "logior (-big | -big)" #x-2244224422
      (logior #x-aa55aa55aa #x-6666666666))
(test "logior (-big | -big)" #x-103454301aacca9
      (logior #x-123456789abcdef #x-fedcba987654321fedcba987654321fedcba))

(test "logtest" #t
      (logtest #xfeedbabe #x10000000))
(test "logtest" #f
      (logtest #xfeedbabe #x01100101))

#|

;; TODO: We don't have these procedures (yet?). Should there be compat
;; versions at the top?
(let loop ((a 1)   ; 1, 10, 100, ...
           (b 1)   ; 1, 11, 111, ...
           (c 2)   ; 10, 101, 1001, ...
           (n 1))  ; counter
  (when (< n 69)
    (test (format "logcount (positive, 100...) ~a" n) 1 (logcount a))
    (test (format "logcount (positive, 111...) ~a" n) n (logcount b))
    (test (format "logcount (negative, 100...) ~a" n) (- n 1) (logcount (- a)))
    (test (format "logcount (negative, 100..1) ~a" n) 1 (logcount (- c)))
    (loop (+ b 1) (+ b b 1) (+ b b 3) (+ n 1))))

(test "logbit?" '(#f #t #t #f #t #f #f)
              (map (lambda (i) (logbit? i #b10110)) '(0 1 2 3 4 5 6)))
(test "logbit?" '(#f #t #f #t #f #t #t)
              (map (lambda (i) (logbit? i #b-10110)) '(0 1 2 3 4 5 6)))

(test "copy-bit" #b11010110
      (copy-bit 4 #b11000110 #t))
(test "copy-bit" #b11000110
      (copy-bit 4 #b11000110 #f))
(test "copy-bit" #b10000110
      (copy-bit 6 #b11000110 #f))

(test "bit-field" #b1010
      (bit-field #b1101101010 0 4))
(test "bit-field" #b10110
      (bit-field #b1101101010 4 9))

(test "copy-bit-field" #b1101100000
      (copy-bit-field #b1101101010 0 4 0))
(test "copy-bit-field" #b1101101111
      (copy-bit-field #b1101101010 0 4 -1))
(test "copy-bit-field" #b1111111111101010
      (copy-bit-field #b1101101010 5 16 -1))
|#

(test "integer-length" 8
      (integer-length #b10101010))
(test "integer-length" 4
      (integer-length #b1111))

(test-end)

;;------------------------------------------------------------------
(test-begin "inexact arithmetics")

(test "+. (0)" 0.0 (+.))
(test "+. (1)" 1.0 (+. 1))
(test "+. (1big)" 1.0e20 (+. 100000000000000000000))
(test "+. (1rat)" 1.5 (+. 3/2))
(test "+. (1cmp)" 1.0+i (+. 1+i))
(test "+. (2)" 1.0 (+. 0 1))
(test "+. (2big)" 1.0e20 (+. 1 100000000000000000000))
(test "+. (2rat)" 1.5 (+. 1 1/2))
(test "+. (many)" 15.0 (+. 1 2 3 4 5))

(test "-. (1)" -1.0 (-. 1))
(test "-. (1big)" -1.0e20 (-. 100000000000000000000))
(test "-. (1rat)" -1.5 (-. 3/2))
(test "-. (1cmp)" -1.0-i (-. 1+i))
(test "-. (2)" -1.0 (-. 0 1))
(test "-. (2big)" -1.0e20 (-. 1 100000000000000000000))
(test "-. (2rat)" 0.5 (-. 1 1/2))
(test "-. (many)" -13.0 (-. 1 2 3 4 5))

(test "*. (0)" 1.0 (*.))
(test "*. (1)" 1.0 (*. 1))
(test "*. (1big)" 1.0e20 (*. 100000000000000000000))
(test "*. (1rat)" 1.5 (*. 3/2))
(test "*. (1cmp)" 1.0+i (*. 1+i))
(test "*. (2)"  0.0 (*. 0 1))
(test "*. (2big)" 1.0e20 (*. 1 100000000000000000000))
(test "*. (2rat)" 0.5 (*. 1 1/2))
(test "*. (many)" 120.0 (*. 1 2 3 4 5))

(test "/. (1)" 1.0 (/. 1))
(test "/. (1big)" 1.0e-20 (/. 100000000000000000000))
(test "/. (1rat)" 0.6666666666666666 (/. 3/2))
(test "/. (1cmp)" 0.5-0.5i (/. 1+i))
(test "/. (2)"  0.0 (/. 0 1))
(test "/. (2big)" 1.0e-20 (/. 1 100000000000000000000))
(test "/. (2rat)" 2.0 (/. 1 1/2))
(test "/. (many)" 0.1 (/. 1 2 5))

(test-end)

;;------------------------------------------------------------------
(test-begin "sqrt")

#|
;; R6RS
(define (integer-sqrt-tester k)
  (test (format "exact-integer-sqrt ~a" k) '(#t #t)
         (receive (s r) (exact-integer-sqrt k)
           (list (= k (+ (* s s) r))
                 (< k (* (+ s 1) (+ s 1)))))))

(integer-sqrt-tester 0)
(integer-sqrt-tester 1)
(integer-sqrt-tester 2)
(integer-sqrt-tester 3)
(integer-sqrt-tester 4)
(integer-sqrt-tester 10)
(integer-sqrt-tester (expt 2 32))
(integer-sqrt-tester (- (expt 2 53) 1))
(integer-sqrt-tester (expt 2 53))
(integer-sqrt-tester (+ (expt 2 53) 1))
(integer-sqrt-tester 9999999999999999999999999999999999999999999999999999)
(integer-sqrt-tester (+ (expt 10 400) 3141592653589)) ; double range overflow

(test-error "exact-integer-sqrt -1" (exact-integer-sqrt -1))
(test-error "exact-integer-sqrt 1.0" (exact-integer-sqrt 1.0))
(test-error "exact-integer-sqrt 1/4" (exact-integer-sqrt (read-from-string "1/4")))

(parameterize ((current-test-comparator eqv?))
 (test "sqrt, exact" 0 (sqrt 0))
 (test "sqrt, exact" 4 (sqrt 16))
 (test "sqrt, inexact" 4.0 (sqrt 16.0))
 (test "sqrt, inexact" (read-from-string "+4.0i") (sqrt -16.0))
 (test "sqrt, exact" (read-from-string "1/4") (sqrt (read-from-string "1/16")))
 (test "sqrt, inexact" 0.25 (sqrt (exact->inexact (read-from-string "1/16")))))

|#
(test-end)

;;------------------------------------------------------------------
(test-begin "ffx optimization")

;; This code is provided by naoya_t to reproduce the FFX bug
;; existed until r6714.   The bug was that the ARGP words of
;; in-stack continuations were not scanned when flonum register
;; bank was cleared.  This code exhibits the case by putting
;; the result of (sqrt 2) as an unfinished argument, then calling
;; inverse-erf which caused flushing flonum regs (see "NG" line).

;; (use math.const)
(define-constant pi     3.141592653589793)


(let ()
  (define *epsilon* 1e-12)
  
  ;;
  ;; normal quantile function (probit function)
  ;;
  (define (probit p)
    (define (probit>0 p)
      (* (inverse-erf (- (* p 2) 1)) (sqrt 2))) ;; OK
    (if (< p 0)
      (- 1 (probit>0 (- p)))
      (probit>0 p) ))
  
  (define (probit p)
    (define (probit>0 p)
      (* (sqrt 2) (inverse-erf (- (* p 2) 1)))) ;; NG
    (if (< p 0)
      (- 1 (probit>0 (- p)))
      (probit>0 p) ))
  
  ;;
  ;; inverse error function (erf-1)
  ;;
  (define (inverse-erf z)
    (define (calc-next-ck k c)
      (let loop ((m 0) (sum 0) (ca c) (cz (reverse c)))
        (if (= m k) sum
            (loop (+ m 1)
                  (+ sum (/. (* (car ca) (car cz)) (+ m 1) (+ m m 1)))
                  (cdr ca) (cdr cz)))))
    (define (calc-cks k)
      (let loop ((i 0) (cks '(1)))
        (if (= i k) cks
            (loop (+ i 1) (cons (calc-next-ck (+ i 1) cks) cks)))))
    (define (calc-ck k) (car (calc-cks k)))
    
    (define (inverse-erf>0 z)
      (let1 r (* pi z z 1/4) ; (pi*z^2)/4
        (let loop ((k 0) (cks '(1)) (sum 0) (a 1))
          (let1 delta (* a (/ (car cks) (+ k k 1)))
            (if (< delta (* sum *epsilon*))
              (* 1/2 z (sqrt pi) sum)
              (loop (+ k 1)
                    (cons (calc-next-ck (+ k 1) cks) cks)
                    (+ sum delta)
                    (* a r)))))))
    
    (cond [(< z 0) (- (inverse-erf>0 (- z)))]
          [(= z 0) 0]
          [else (inverse-erf>0 z)]) )

  (define ~= (lambda (x y) (< (abs (- x y)) 1e-7)))
  ;;
  ;; TEST
  ;;
  (parameterize ((current-test-comparator ~=))
    (test "probit(0.025)" -1.959964 (probit 0.025))
    (test "probit(0.975)" 1.959964 (probit 0.975)))
  )

(test-end)

(test-end)