;;;; numbers-test.scm


(require-extension testeez numbers)

(define max-fix #x3fffffff)
(define min-fix -1073741824)

(print max-fix)
(print min-fix)

(define (show x) 
  (print (and x (number->string x)))
  x)

;(set-gc-report! #t)

(define-syntax check
  (syntax-rules ()
    ((_ body ...)
     (handle-exceptions ex (begin (print-error-message ex) #f)
       body ...
       #t) )))

(define max2 (show (+ max-fix max-fix)))

(define b1 (+ 22 max2)) ; 2147483668

(define c1 (make-rectangular 33 44))
(define c2 (make-rectangular -1.2 44))

(define b2 (- min-fix 22))
(define r1 (/ 33 44))
(define r2 (/ 1000 44))

(testeez
 "basic constructors"

 (test-eval "some bignum (twice maxint)" (show max2))
 (test-eval "some other bignum (2147483668)" (show b1))
 (test-eval "negative bignum" (show b2))
 (test-eval "exact complex" (show c1))
 (test-eval "inexact complex" (show c2))
 (test-eval "rational" (show r1))

)

(testeez
 "addition"

 (test/equal "+: no arguments" (+) 0) 
 (test/equal "+: single argument" (+ 33) 33)
 (test/equal "+: adding fixnums" (+ 33 44) 77)
 (test/equal "+: adding fixnums (2nd negative)" (+ 33 -44) -11)
 (test/equal "+: adding fix/flo" (+ 33 44.5) 77.5)
 (test-eval "+: adding fix/big" (show (+ 22 max2)))
 (test-eval "+: adding fix/rat" (show (+ 22 r1)))
 (test/equal "+: adding fix/complex" (+ 99 c1) (make-rectangular 132 44))
 (test/equal "+: adding complex/fix (inexact)" (+ c2 99) (make-rectangular 97.8 44))
 (test/equal "+: flo/flo" (+ 3.4 5.6) 9.0)
 (test/equal "+: flo/big" (+ 3.4 b1) 2147483671.4)
 (test-eval "+: flo/rat" (show (+ 33.4 r1)))
 (test/equal "+: flo/comp" (+ 3.4 c1) (make-rectangular 36.4 44))
 (test-eval "+: big/rat" (show (+ b1 r1)))
 (test/equal "+: comp+comp" (+ c1 c1) (make-rectangular 66 88))
 (test/equal "+: comp+comp (inexact)" (+ c1 c2) (make-rectangular 31.8 88))
 (test/equal "+: multiarg" (+ 33 44 55) 132)

)



(testeez
 "subtraction"

 (test/equal "-: negate fix" (- 33) -33)
 (test/equal "-: negate flo" (- 33.2) -33.2)
 (test-eval "-: negate rat" (show (- r1)))
 (test-eval "-: negate big (should be -2147483668)" (show (- b1)))
 (test/equal "-: negate comp" (- c1) (make-rectangular -33 44))
 (test/equal "-: fixnums" (- 33 44) -11)
 (test/equal "-: fixnums (2nd negative)" (- 33 -44) 77)
 (test-eval "-: fixnums (overflow)" (show (- min-fix min-fix)))
 (test/equal "-: fix/flo" (- 33 44.5) -11.5)
 (test/equal "-: flo/fix" (- 44.5 33) 11.5)
 (test-eval "-: fix/big" (show (- 22 b2)))
 (test-eval "-: big/fix" (show (- b2 22)))
 (test-eval "-: fix/rat" (show (- 22 r1)))
 (test-eval "-: rat/fix" (show (- r1 22)))
 (test/equal "-: fix/complex" (- 99 c1) (make-rectangular 66 -44))
 (test/equal "-: complex/fix" (- c1 99) (make-rectangular -66 44))
 (test/equal "-: complex/fix (inexact)" (- c2 99) (make-rectangular -100.2 44))
 (test/equal "-: fix/complex (inexact)" (- 99 c2) (make-rectangular 100.2 -44))
 (test/equal "-: flo/flo" (- 5.6 3.4) 2.2)
 (test-eval "-: flo/big" (show (- 3.4 b1)))
 (test-eval "-: big/flo" (show (- b1 3.4)))
 (test-eval "-: flo/rat" (show (- 3.4 r1)))
 (test-eval "-: rat/flo" (show (- r1 3.4)))
 (test-eval "-: big/rat" (show (- b1 r1)))
 (test-eval "-: rat/big" (show (- r1 b1)))
 (test/equal "-: flo/comp" (- 3.4 c1) (make-rectangular -29.6 -44))
 (test/equal "-: comp/flo" (- c1 3.4) (make-rectangular 29.6 44))
 (test/equal "-: comp-comp" (- c1 c1) 0)
 (test/equal "-: comp-comp (inexact)" (- c1 c2) 34.2)
 (test/equal "-: multiarg" (- 33 44 55) -66)

)



(testeez
 "multiplication"

 (test/equal "*: no arguments" (*) 1) 
 (test/equal "*: single argument" (* 33) 33)
 (test/equal "*: multiplying fixnums" (* 33 44) 1452)
 (test/equal "*: multiplying fixnums (2nd negative)" (* 33 -44) -1452)
 (test/equal "*: multiplying fix/flo" (* 33 44.5) 1468.5)
 (test-eval "*: multiplying fix/big (-> 47244640212)" (show (* 22 max2)))
 (test-eval "*: multiplying fix/rat" (show (* 33 r1)))
 (test/equal "*: multiplying fix/complex" (* 99 c1) (make-rectangular 3267 4356))
 (test/equal "*: multiplying complex/fix (inexact)" (* c2 99) (make-rectangular -118.8 4356.0))
 (test/equal "*: flo/flo" (* 3.4 5.6) 19.04)
 (test/equal "*: flo/big" (* 3.4 b1) 7301444471.2)
 (test-eval "*: flo/rat" (show (* 3.4 r1)))
 (test-eval "*: big/rat" (show (* b1 r1)))
 (test/equal "*: flo/comp" (* 3.4 c1) (make-rectangular 112.2 149.6))
 (test/equal "*: comp*comp" (* c1 c1) (make-rectangular -847 2904))
 (test/equal "*: comp*comp (inexact)" (* c1 c2) (make-rectangular -1975.6 1399.2))
 (test/equal "*: multiarg" (* 33 44 55) 79860)

 )



(testeez
 "division"

 (test-eval "/: rec. fix" (show (/ 33)))
 (test-eval "/: rec. flo" (show (/ 33.2)))
 (test-eval "/: rec. rat" (show (/ r1)))
 (test-eval "/: rec. big" (show (/ b1)))
 (test-eval "/: rec. comp" (/ c1))
 (test-eval "/: fixnums" (show (/ 33 44)))
 (test-eval "/: fixnums (2nd negative)" (show (/ 33 -44)))
 (test-eval "/: fixnums" (show (/ min-fix min-fix)))
 (test/equal "/: fix/flo" (/ 33 44.5) (fp/ 33.0 44.5))
 (test/equal "/: flo/fix" (/ 44.5 33) (fp/ 44.5 33.0))
 (test-eval "/: fix/big" (show (/ 22 b2)))
 (test-eval "/: big/fix" (show (/ b2 22)))
 (test-eval "/: fix/rat" (show (/ 22 r1)))
 (test-eval "/: rat/fix" (show (/ r1 22)))
 (test-eval "/: fix/complex" (show (/ 99 c1)))
 (test-eval "/: complex/fix" (show (/ c1 99)))
 (test-eval "/: complex/fix (inexact)" (show (- c2 99)))
 (test-eval "/: fix/complex (inexact)" (show (- 99 c2)))
 (test/equal "/: flo/flo" (/ 5.6 3.4) (fp/ 5.6 3.4))
 (test-eval "/: flo/big" (show (/ 3.4 b1)))
 (test-eval "/: big/flo" (show (/ b1 3.4)))
 (test-eval "/: flo/rat" (show (/ 3.4 r1)))
 (test-eval "/: rat/flo" (show (/ r1 3.4)))
 (test-eval "/: big/rat" (show (/ b1 r1)))
 (test-eval "/: rat/big" (show (/ r1 b1)))
 (test-eval "/: rat/rat" (show (/ r1 r1)))
 (test-eval "/: flo/comp" (show (/ 3.4 c1)))
 (test-eval "/: comp/flo" (show (/ c1 3.4)))
 (test-eval "/: comp/comp" (show (/ c1 c1)))
 (test-eval "/: comp/comp (inexact)" (show (/ c1 c2)))
 (test-eval "/: multiarg" (show (/ 66 2 44)))
 (test/equal "/: div by 0" (check (/ 33 0)) #f)
 (test/equal "/: div by 0 (inexact)" (check (/ 33 0.0)) #f)
 (test-eval "/: big result" (show (/ b1 2)))

)



(testeez 
 "equality"

 (test/equal "=: fix/fix" (= 33 33) #t)
 (test/equal "=: fix/flo" (= 33 33.0) #t)
 (test/equal "=: !fix/fix" (= 33 34) #f)
 (test/equal "=: !fix/flo" (= 33 33.1) #f)
 (test/equal "=: flo/fix" (= 33.0 33) #t)
 (test/equal "=: flo/flo" (= 33.1 33.1) #t)
 (test/equal "=: !flo/flo" (= 33.1 -33.1) #f)
 (test/equal "=: big/flo" (= b1 (+ 0.0 b1)) #t)
 (test/equal "=: big/big" (= b1 b1) #t)
 (test/equal "=: !big/big" (= b2 b1) #f)
 (test/equal "=: rat/flo" (= r1 (+ r1 0.0)) #t)
 (test/equal "=: rat/rat" (= r1 r1) #t)
 (test/equal "=: !rat/rat" (= r1 r2) #f)
 (test/equal "=: comp/comp" (= c1 c1) #t)
 (test/equal "=: !comp/comp" (= c1 c2) #f)

)



(testeez
 "greater"

 (test/equal ">: fix/fix" (> 44 33) #t)
 (test/equal ">: !fix/fix" (> 33 44) #f)
 (test/equal ">: fix/flo" (> 44 33.0) #t)
 (test/equal ">: !fix/flo" (> 33 44.0) #f)
 (test/equal ">: fix/big" (> 44 b2) #t)
 (test/equal ">: !fix/big" (> 33 b1) #f)
 (test/equal ">: fix/rat" (> 44 r1) #t)
 (test/equal ">: !fix/rat" (> 0 r1) #f)

 (test/equal ">: flo/fix" (> 44.0 33) #t)
 (test/equal ">: !flo/fix" (> 33.0 44) #f)
 (test/equal ">: flo/flo" (> 44.0 33.0) #t)
 (test/equal ">: !flo/flo" (> 33.0 44.0) #f)
 (test/equal ">: flo/big" (> 44.0 b2) #t)
 (test/equal ">: !flo/big" (> 33.0 b1) #f)
 (test/equal ">: flo/rat" (> 44.0 r1) #t)
 (test/equal ">: !flo/rat" (> 0.0 r1) #f)

 (test/equal ">: big/fix" (> b1 33) #t)
 (test/equal ">: !big/fix" (> b2 44) #f)
 (test/equal ">: big/flo" (> b1 33.0) #t)
 (test/equal ">: !big/flo" (> b2 44.0) #f)
 (test/equal ">: big/big" (> b1 b2) #t)
 (test/equal ">: !big/big" (> b2 b1) #f)
 (test/equal ">: big/rat" (> b1 r1) #t)
 (test/equal ">: !big/rat" (> b2 r1) #f)

 (test/equal ">: rat/fix" (> r1 2) #f)
 (test/equal ">: !rat/fix" (> r1 44) #f)
 (test/equal ">: rat/flo" (> r2 2.0) #t)
 (test/equal ">: !rat/flo" (> b2 44.0) #f)
 (test/equal ">: !rat/big" (> r1 b1) #f)
 (test/equal ">: rat/rat" (> r2 r1) #t)
 (test/equal ">: !rat/rat" (> r1 r2) #f)

)



(testeez
 "less"

 (test/equal "<: !fix/fix" (< 44 33) #f)
 (test/equal "<: fix/fix" (< 33 44) #t)
 (test/equal "<: !fix/flo" (< 44 33.0) #f)
 (test/equal "<: fix/flo" (< 33 44.0) #t)
 (test/equal "<: !fix/big" (< 44 b2) #f)
 (test/equal "<: fix/big" (< 33 b1) #t)
 (test/equal "<: !fix/rat" (< 44 r1) #f)
 (test/equal "<: fix/rat" (< 0 r1) #t)

 (test/equal "<: !flo/fix" (< 44.0 33) #f)
 (test/equal "<: flo/fix" (< 33.0 44) #t)
 (test/equal "<: !flo/flo" (< 44.0 33.0) #f)
 (test/equal "<: flo/flo" (< 33.0 44.0) #t)
 (test/equal "<: !flo/big" (< 44.0 b2) #f)
 (test/equal "<: flo/big" (< 33.0 b1) #t)
 (test/equal "<: !flo/rat" (< 44.0 r1) #f)
 (test/equal "<: flo/rat" (< 0.0 r1) #t)

 (test/equal "<: !big/fix" (< b1 33) #f)
 (test/equal "<: big/fix" (< b2 44) #t)
 (test/equal "<: !big/flo" (< b1 33.0) #f)
 (test/equal "<: big/flo" (< b2 44.0) #t)
 (test/equal "<: !big/big" (< b1 b2) #f)
 (test/equal "<: big/big" (< b2 b1) #t)
 (test/equal "<: !big/rat" (< b1 r1) #f)
 (test/equal "<: big/rat" (< b2 r1) #t)

 (test/equal "<: !rat/fix" (< r2 2) #f)
 (test/equal "<: rat/fix" (< r1 44) #t)
 (test/equal "<: !rat/flo" (< r2 2.0) #f)
 (test/equal "<: rat/flo" (< b2 44.0) #t)
 (test/equal "<: rat/big" (< r1 b1) #t)
 (test/equal "<: !rat/rat" (< r2 r1) #f)
 (test/equal "<: rat/rat" (< r1 r2) #t)

)

(testeez
 "complex"

 (test/equal "real-part" (real-part c1) 33)
 (test/equal "imag-part" (imag-part c1) 44)
 (test/equal "real-part" 33 33)
 (test/equal "imag-part" (imag-part 33) 0)
 (test-eval "make-polar" (show (make-polar 33 44)))
 (test-eval "magnitude" (show (magnitude c1)))
 (test-eval "angle" (show (angle c1)))

)

(testeez
 "rational"

 (test/equal "numerator" (numerator r1) 3)
 (test-eval "numerator" (show (numerator b1)))
 (test/equal "numerator" (numerator 33) 33)
 (test/equal "denominator" (denominator r1) 4)
 (test/equal "denominator" (denominator b1) 1)
 (test/equal "denominator" (denominator 33) 1)

)

(testeez
 "misc"

 (test-eval "inexact->exact" (show (inexact->exact 0.3)))
 (test/equal "expt" (expt 2 4) 16)
 (test-eval "expt" (show (expt 2 100)))
 (test-eval "expt" (show (expt 33 (/ 1 3))))
 (test-eval "expt" (show (expt 2 2.0)))
 (test-eval "expt" (show (expt 2 -1)))

 (test-define "bigfac" fac (letrec ((fac (lambda (n)
					    (if (zero? n)
						1
						(* n (fac (- n 1))) ) ) ) )
			     fac) )

 (test-eval "bigfac" (show (fac 100)))
 (test/equal "signum" (signum b1) 1)
 (test/equal "signum" (signum -2) -1)

)



(testeez
 "R5RS"

 (test/equal "+" (+ 3 4) 7)
 (test/equal "+" (+ 3) 3)
 (test/equal "+" (+) 0)
 (test/equal "*" (* 4) 4)
 (test/equal "*" (*) 1)

 (test/equal "-" (- 3 4) -1)
 (test/equal "-" (- 3 4 5) -6)
 (test/equal "-" (- 3) -3)
 (test-eval "/ (3/20)" (show (/ 3 4 5)))
 (test-eval "/ (1/3)" (show (/ 3)))

 (test/equal "numerator" (numerator (/ 6 4)) 3)
 (test/equal "denominator" (denominator (/ 6 4)) 2)

 (test/equal "complex?" (complex? c1) #t)
 (test/equal "complex?" (complex? 3) #t)
 (test/equal "real?" (real? 3) #t)
 (test/equal "real?" (real? (make-rectangular -2.5 0.0)) #t)
 (test/equal "real?" (real? 1e0) #t)
 (test/equal "rational?" (rational? (/ 6 10)) #t)
 (test-eval "check rational" (show (/ 6 3)))
 (test/equal "rational?" (rational? (/ 6 3)) #t)
 (test/equal "integer?" (integer? (make-rectangular 3 0)) #t)
 (test/equal "integer?" (integer? 3.0) #t)
 (test/equal "integer?" (integer? (/ 8 4)) #t)

 (test/equal "max" (max 3 4) 4)
 (test/equal "max" (max 3.9 4) 4.0)

 (test/equal "modulo" (modulo 13 4) 1)
 (test/equal "remainder" (remainder 13 4) 1)
 (test/equal "modulo" (modulo -13 4) 3)
 (test/equal "remainder" (remainder -13 4) -1)
 (test/equal "modulo" (modulo 13 -4) -3)
 (test/equal "remainder" (remainder 13 -4) 1)
 (test/equal "modulo" (modulo -13 -4) -1)
 (test/equal "remainder" (remainder -13 -4) -1)
 (test/equal "remainder" (remainder -13 -4.0) -1.0)

 (test/equal "floor" (floor -4.3) -5.0)
 (test/equal "ceiling" (ceiling -4.3) -4.0)
 (test/equal "truncate" (truncate -4.3) -4.0)
 (test/equal "round" (round -4.3) -4.0)
 (test/equal "floor" (floor 3.5) 3.0)
 (test/equal "ceiling" (ceiling 3.5) 4.0)
 (test/equal "truncate" (truncate 3.5) 3.0)
 (test/equal "round" (round 3.5) 4.0)
 (test/equal "round" (round (/ 7 2)) 4)
 (test/equal "round" (round 7) 7)

 (test-eval "rationalize (1/3)" (show (rationalize (inexact->exact .3) (/ 1 10))))
 (test-eval "rationalize (#i1/3)" (show (rationalize .3 (/ 1 10))))

)

(testeez
 "bitwise ops"

 (test/equal "and" (bitwise-and #xff #x1) 1)
 (test/equal "ior" (bitwise-ior #x0f #x1) #xf)
 (test/equal "xor" (bitwise-xor #x0f #x1) 14)
 (test-eval "not" (show (bitwise-not #x0f)))
 (test/equal "shift left" (arithmetic-shift #xf 2) #x3c)
 (test/equal "shift right" (arithmetic-shift #xf 2) 60)

 ;; by Jeremy Sydik
 (test-define "leftrot32" leftrot32 
	      (lambda (value amount)
		(let ((shifted (arithmetic-shift value amount)))
		  (let ((anded (bitwise-and (string->number "#xFFFFFFFF") shifted)))
		    (bitwise-ior anded
				 (arithmetic-shift shifted -32)))) ) )
 (test/equal "leftrot32" (leftrot32 1 28) 268435456)
 (test/equal "leftrot32" (leftrot32 1 29) 536870912)
 (test/equal "leftrot32" (leftrot32 1 30) (string->number "1073741824"))

)

(testeez
 "string conversion"

 (test-eval "fix" (number->string 123))
 (test-eval "fix/base" (number->string 123 16))
 (test-eval "flo" (number->string 99.2))
 (test-eval "big" (number->string b1))
 (test-eval "big/base" (number->string b1 2))
 (test-eval "rat" (number->string r1))
 (test-eval "comp" (number->string c1))

 (test/equal "fix" (string->number "123") 123)
 (test/equal "fix/base" (string->number "ff" 16) 255)
 (test/equal "fix/base-o" (string->number "16" 8) 14)
 (test/equal "flo" (string->number "#") 0.0)
 (test/equal "flo" (string->number "123.23") 123.23)
 (test/equal "flo2" (string->number "1##.23") 100.23)
 (test/equal "flo2" (string->number "1e2") 100.0)
 (test/equal "flo2" (string->number "#.#") 0.0)
 (test-eval "big" (show (string->number "123873487384737447")))
 (test-eval "big/neg" (show (string->number "-123873487384737447")))
 (test-eval "big/pos" (show (string->number "+123873487384737447")))
 (test-eval "rat" (show (string->number "123/456")))
 (test-eval "rat/neg" (show (string->number "-123/456")))
 (test-eval "rat/pos" (show (string->number "+123/456")))
 (test-eval "rat2" (show (string->number "#o123/456")))
 (test/equal "rat/inexact" (show (string->number "#i123/456")) (/ 123.0 456))
 (test-eval "comp" (show (string->number "+12i")))
 (test-eval "comp" (show (string->number "12+34i")))
 (test-eval "comp" (show (string->number "-i")))
 (test-eval "comp" (show (string->number "99@55")))
 (test-eval "comp2" (show (string->number "#x99+55i")))

)

(testeez
 "non-standard type procedures"

 (test/eq "bignum" #t (bignum? b1))

 (test/eq "ratnum" #t (ratnum? r1))

 (test/eq "cplxnum: compintintnum" #t (cplxnum? c1))
 (test/eq "cplxnum: compintflointnum" #t (cplxnum? 1.0+1i))
 (test/eq "cplxnum: compflointnum" #t (cplxnum? c2))
 (test/eq "cplxnum: compfloflonum" #t (cplxnum? 3.4-4.3i))
 (test/eq "not cplxnum: fixnum" #f (cplxnum? 1))

 (test/eq "rectnum: compintintnum" #t (rectnum? c1))
 (test/eq "rectnum: compintflointnum" #t (rectnum? 1.0+1i))
 (test/eq "not rectnum: compflointum" #f (rectnum? c2))

 (test/eq "compnum: compfloflonum" #t (compnum? 3.4-4.3i))
 (test/eq "not compnum: compflointnum" #f (compnum? 1.0+1i))
 (test/eq "not compnum: compintintnum" #f (compnum? c1))

 (test/eq "cintnum: intflonum" #t (cintnum? 1.0))
 (test/eq "cintnum: fixnum" #t (cintnum? 3))
 (test/eq "cintnum: bignum" #t (cintnum? b1))
 (test/eq "cintnum: compintintnum" #t (cintnum? c1))

 (test/eq "cflonum: intflonum" #t (cflonum? 1.0))
 (test/eq "cflonum: flonum" #t (cflonum? 3.4))
 (test/eq "cflonum: compfloflonum" #t (cflonum? 3.4-4.3i))
 (test/eq "cflonum: compfloflonum" #f (cflonum? c2))

)