;;;; numbers-test.scm

;; XXX: The bignum tests assume a 32-bit platform (will use fixnums on 64-bit)

(require-extension test)
(use numbers)

(test-begin "numbers")

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

(define max-fix #x3fffffff)
(define min-fix -1073741824)
;; The minimal bignum in the sense that any smaller makes it a fixnum
(define min-big 1073741824)

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

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

;(set-gc-report! #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))

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

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

(test-group "subtraction"

 (test "-: negate fix" -33 (- 33))
 (test "-: negate most negative fix" min-big (- min-fix))
 (test "-: negate flo" -33.2 (- 33.2))
 (test-assert "-: negate rat" (show (- r1)))
 (test-assert "-: negate big (should be -2147483668)" (show (- b1)))
 (test "-: negate comp" (make-rectangular -33 44) (- c1))
 (test "-: fixnums" -11 (- 33 44))
 (test "-: fixnums (2nd negative)" 77 (- 33 -44))
 (test-assert "-: fixnums (overflow)" (show (- min-fix min-fix)))
 (test "-: fix/flo" -11.5 (- 33 44.5))
 (test "-: flo/fix" 11.5 (- 44.5 33))
 (test-assert "-: fix/big" (show (- 22 b2)))
 (test-assert "-: big/fix" (show (- b2 22)))
 (test "-: big/fix (normalizing to fix)" max-fix (- min-big 1))
 (test-assert "-: fix/rat" (show (- 22 r1)))
 (test-assert "-: rat/fix" (show (- r1 22)))
 (test "-: fix/complex" (make-rectangular 66 -44) (- 99 c1))
 (test "-: complex/fix" (make-rectangular -66 44) (- c1 99))
 (test "-: complex/fix (inexact)" (make-rectangular -100.2 44) (- c2 99))
 (test "-: fix/complex (inexact)" (make-rectangular 100.2 -44) (- 99 c2))
 
 (parameterize ((current-test-epsilon 1e-10))
   (test "-: flo/flo" 2.2 (- 5.6 3.4)))
 
 (test-assert "-: flo/big" (show (- 3.4 b1)))
 (test-assert "-: big/flo" (show (- b1 3.4)))
 (test-assert "-: flo/rat" (show (- 3.4 r1)))
 (test-assert "-: rat/flo" (show (- r1 3.4)))
 (test-assert "-: big/rat" (show (- b1 r1)))
 (test-assert "-: rat/big" (show (- r1 b1)))
 (test "-: flo/comp" (make-rectangular -29.6 -44) (- 3.4 c1))
 (test "-: comp/flo" (make-rectangular 29.6 44) (- c1 3.4))
 (test "-: comp-comp" 0 (- c1 c1))
 (test "-: comp-comp (inexact)" 34.2 (- c1 c2))
 (test "-: multiarg" -66 (- 33 44 55))
)


(test-group "multiplication"

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

(test-group "division"

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

(test-group "quotient"
  (test "quotient: fix/fix" 2 (quotient 22 11))
  (test "quotient: fix/big" 0 (quotient 22 b1))
  (test "quotient: fix/big (most negative)" -1 (quotient min-fix (- min-fix)))
  (test "quotient: big/fix (most negative)" -1 (quotient (- min-fix) min-fix))
  (test "quotient: flo/flo" 2.0 (quotient 22.0 11.0))
  (test "quotient: fix/flo" 2.0 (quotient 22 11.0))
  (test "quotient: flo/fix" 2.0 (quotient 22.0 11))
  (test "quotient: flo/big" 0.0 (quotient 22.0 b1))
  ;; When "upgrading" from regular Chicken to numbers, existing semantics
  ;; should be maintained.  That's why we allow non-integer flonums.
  (test "quotient: flo/flo (fractional)" 2.0 (quotient 23.0 11.5))
  (test "quotient: fix/flo (fractional)" 2.0 (quotient 23 11.5))
  (test "quotient: big/flo (fractional)" 2.0 (quotient b1 (/ b1 2.0)))
  (test "quotient: flo/fix (fractional)" 2.0 (quotient 13.5 6))
)

(test-group "remainder"
  (test "remainder: fix/fix" 0 (remainder 22 11))
  (test "remainder: fix/big" 22 (remainder 22 b1))
  (test "remainder: fix/big (most negative)" 0 (remainder min-fix (- min-fix)))
  (test "remainder: big/fix (most negative)" 0 (remainder (- min-fix) min-fix))
  
  (test "remainder: flo/flo" 0.0 (remainder 22.0 11.0))
  (test "remainder: fix/flo" 0.0 (remainder 22 11.0))
  (test "remainder: flo/fix" 0.0 (remainder 22.0 11))
  (test "remainder: flo/big" 22.0 (remainder 22.0 b1))
  
  ;; When "upgrading" from regular Chicken to numbers, existing semantics
  ;; should be maintained.  That's why we allow non-integer flonums.
  (test "remainder: flo/flo (fractional)" 0.0 (remainder 22.5 2.25))
  (test "remainder: fix/flo (fractional)" 6.0 (remainder 6 12.5))
  (test "remainder: flo/fix (fractional)" 1.5 (remainder 13.5 6))
  (test "remainder: flo/big (fractional)" 0.5 (remainder (+ b1 0.5) b1))
)

(test-group "quotient&remainder"
  (test "quotient&remainder: fix/fix"
              '(2 0) (receive l (quotient&remainder 22 11) l))
  (test "quotient&remainder: fix/big"
              '(0 22) (receive l (quotient&remainder 22 b1) l))
  (test "quotient&remainder: fix/big (most negative)"
              '(-1 0) (receive l (quotient&remainder min-fix (- min-fix)) l))
  (test "quotient&remainder: big/fix (most negative)"
              '(-1 0) (receive l (quotient&remainder (- min-fix) min-fix) l))
  (test "quotient&remainder: flo/flo"
        '(5.0 2.0) (receive l (quotient&remainder 22.0 4.0) l))
  (test "quotient&remainder: flo/fix"
        '(5.0 2.0) (receive l (quotient&remainder 22.0 4) l))
  (test "quotient&remainder: fix/flo"
        '(5.0 2.0) (receive l (quotient&remainder 22 4.0) l))
  (test "quotient&remainder: flo/big"
        '(1.0 0.5) (receive l (quotient&remainder (+ b1 0.5) b1) l))
  (test "quotient&remainder: big/flo"
        `(0.0 ,(exact->inexact b1))
        (receive l (quotient&remainder b1 (+ b1 0.5)) l))
)

(test-group "gcd"
  (test "gcd: fix (64-bit)/big" 1 (gcd 907947775416515 11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
)


(test-group "equality"

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

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


(test-group "greater"

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

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

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

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


(test-group "less"

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

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

 (test "<: !big/fix" #f (< b1 33))
 (test "<: big/fix" #t (< b2 44))
 (test "<: !big/flo" #f (< b1 33.0))
 (test "<: big/flo" #t (< b2 44.0))
 (test "<: big/flo (max flo)"
       #f (< 1237940039285380274899124224 1237940039285380274899124224.0))
 (test "<: big/flo (max flo, smaller bignum)"
       #t (< 1237940039285380274899124223 1237940039285380274899124224.0))
 (test "<: !big/big" #f (< b1 b2))
 (test "<: big/big" #t (< b2 b1))
 (test "<: !big/rat" #f (< b1 r1))
 (test "<: big/rat" #t (< b2 r1))

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

(test-group "complex"

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

(test-group "rational"

 (test "numerator" 3 (numerator r1))
 (test-assert "numerator" (show (numerator b1)))
 (test "numerator" 33 (numerator 33))
 (test "denominator" 4 (denominator r1))
 (test "denominator" 1 (denominator b1))
 (test "denominator" 1 (denominator 33))
)

(test-group "misc"

 (test "inexact->exact" 2589569785738035/1125899906842624 (inexact->exact 2.3))
 (test "expt" 16 (expt 2 4))
 (test-assert "expt" (show (expt 2 100)))
 (test-assert "expt" (show (expt 33 (/ 1 3))))
 (test-assert "expt" (show (expt 2 2.0)))
 (test-assert "expt" (show (expt 2 -1)))
 (test "expt between double and 64-bit integer value" 994014980014994001 (expt 999 6))

 (letrec ((fac (lambda (n)
                 (if (zero? n)
                     1
                     (* n (fac (- n 1))) ) ) ) )
   (test-assert "bigfac" (show (fac 100)))
   (test "signum" 1 (signum b1))
   (test "signum" -1 (signum -2)) )
)


(test-group "R5RS"

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

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

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

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

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

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

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

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

(test-group "bitwise ops"

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

 ;; by Jeremy Sydik
 (let ((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 "leftrot32 28" 268435456 (leftrot32 1 28))
   (test "leftrot32 29" 536870912 (leftrot32 1 29))
   (test "leftrot32 30" (string->number "1073741824") (leftrot32 1 30)))
)

(test-group "string conversion"

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

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

(test-group "non-standard type procedures"

 (test "fixnum" #t (fixnum? max-fix))

 (test "bignum" #t (bignum? b1))
 (test "bignum" #t (bignum? min-big))

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

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

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

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

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

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

(test-end)

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