;;; Tests for lib/wrappers-r5rs.scm.
;;; Depends on a testing API compatible with CHICKEN's test egg.
;;;
;;; These are just wrappers around standard procedures, so each has
;;; only a few tests to check that the correct procedure is wrapped,
;;; and to show example usage.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; GENERAL

(test-group "c-eqv?"
  (test #t (ck () (c-eqv? 'a 'a)))
  (test #f (ck () (c-eqv? 'a 'b)))
  (test #f (ck () (c-eqv? '"a" '"a")))
  (test #f (ck () (c-eqv? '"a" '"b"))))

(test-group "c-eq?"
  (test #t (ck () (c-eq? 'a 'a)))
  (test #f (ck () (c-eq? 'a 'b)))
  (test #f (ck () (c-eq? '"a" '"a")))
  (test #f (ck () (c-eq? '"a" '"b"))))

(test-group "c-equal?"
  (test #t (ck () (c-equal? 'a 'a)))
  (test #f (ck () (c-equal? 'a 'b)))
  (test #t (ck () (c-equal? '"a" '"a")))
  (test #f (ck () (c-equal? '"a" '"b"))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; NUMBERS

(test-group "c-number?"
  (test #t (ck () (c-number? '#e1)))
  (test #t (ck () (c-number? '#e1.0)))
  (test #t (ck () (c-number? '#i1)))
  (test #t (ck () (c-number? '#i1.0)))
  (test #f (ck () (c-number? '"1"))))

(test-group "c-integer?"
  (test #t (ck () (c-integer? '1)))
  (test #t (ck () (c-integer? '1.0)))
  (test #t (ck () (c-integer? '#e1)))
  (test #t (ck () (c-integer? '#i1)))
  (test #f (ck () (c-integer? '1.2)))
  (test #f (ck () (c-integer? '"1"))))


(test-group "c-="
  (test #t (ck () (c-=)))
  (test #t (ck () (c-= '1)))
  (test #t (ck () (c-= '1 '1.0)))
  (test #f (ck () (c-= '1 '2 '3)))
  (test #f (ck () (c-= '3 '2 '1))))

(test-group "c-<"
  (test #t (ck () (c-<)))
  (test #t (ck () (c-< '1)))
  (test #f (ck () (c-< '1 '1.0)))
  (test #t (ck () (c-< '1 '2 '3)))
  (test #f (ck () (c-< '3 '2 '1))))

(test-group "c->"
  (test #t (ck () (c->)))
  (test #t (ck () (c-> '1)))
  (test #f (ck () (c-> '1 '1.0)))
  (test #f (ck () (c-> '1 '2 '3)))
  (test #t (ck () (c-> '3 '2 '1))))

(test-group "c-<="
  (test #t (ck () (c-<=)))
  (test #t (ck () (c-<= '1)))
  (test #t (ck () (c-<= '1 '1.0)))
  (test #t (ck () (c-<= '1 '2 '3)))
  (test #f (ck () (c-<= '3 '2 '1))))

(test-group "c->="
  (test #t (ck () (c->=)))
  (test #t (ck () (c->= '1)))
  (test #t (ck () (c->= '1 '1.0)))
  (test #f (ck () (c->= '1 '2 '3)))
  (test #t (ck () (c->= '3 '2 '1))))


(test-group "c-max"
  (test 2 (ck () (c-max '2)))
  (test 8 (ck () (c-max '2 '7 '1 '8 '2))))

(test-group "c-min"
  (test 2 (ck () (c-min '2)))
  (test 1 (ck () (c-min '2 '7 '1 '8 '2))))


(test-group "c-+"
  (test 0 (ck () (c-+)))
  (test 3 (ck () (c-+ '3)))
  (test 8 (ck () (c-+ '3 '1 '4))))

(test-group "c-*"
  (test 1 (ck () (c-*)))
  (test 3 (ck () (c-* '3)))
  (test 12 (ck () (c-* '3 '1 '4))))

(test-group "c--"
  (test -3 (ck () (c-- '3)))
  (test -2 (ck () (c-- '3 '1 '4))))

(test-group "c-/"
  (test #t (= (/ 1 3) (ck () (c-/ '3))))
  (test #t (= (/ 3 8) (ck () (c-/ '3 '2 '4)))))


(test-group "c-remainder"
  (test 2 (ck () (c-remainder '8 '3)))
  (test 3 (ck () (c-remainder '8 '-5)))
  (test -3 (ck () (c-remainder '-8 '5))))

(test-group "c-floor"
  (test 3.0 (ck () (c-floor '3.14)))
  (test 3.0 (ck () (c-floor '3.5)))
  (test 2.0 (ck () (c-floor '2.5))))

(test-group "c-round"
  (test 3.0 (ck () (c-round '3.14)))
  (test 4.0 (ck () (c-round '3.5)))
  (test 2.0 (ck () (c-round '2.5))))


(test-group "c-exact->inexact"
  (test #t (inexact? (ck () (c-exact->inexact '#e1)))))

(test-group "c-inexact->exact"
  (test #t (exact? (ck () (c-inexact->exact '#i1)))))


(test-group "c-number->string"
  (test "3" (ck () (c-number->string '3)))
  (test "111" (ck () (c-number->string '7 '2)))
  (test "3.14" (ck () (c-number->string '3.14))))

(test-group "c-string->number"
  (test 3 (ck () (c-string->number '"3")))
  (test 7 (ck () (c-string->number '"111" '2)))
  (test 3.14 (ck () (c-string->number '"3.14"))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; PAIRS AND LISTS

(test-group "c-length"
  (test 0 (ck () (c-length '())))
  (test 3 (ck () (c-length '(2 7 1)))))

(test-group "c-list-ref"
  (test 7 (ck () (c-list-ref '(2 7 1) '1))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; SYMBOLS

(test-group "c-symbol?"
  (test #t (ck () (c-symbol? 'a)))
  (test #f (ck () (c-symbol? '"a"))))

(test-group "c-symbol->string"
  (test "test" (ck () (c-symbol->string 'test))))

(test-group "c-string->symbol"
  (test 'test (ck () (c-quote (c-string->symbol '"test")))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CHARS AND STRINGS

(test-group "c-char?"
  (test #t (ck () (c-char? '#\a)))
  (test #f (ck () (c-char? '"a"))))

(test-group "c-char=?"
  (test #t (ck () (c-char=? '#\a '#\a)))
  (test #f (ck () (c-char=? '#\a '#\b))))

(test-group "c-string?"
  (test #t (ck () (c-string? '"a")))
  (test #f (ck () (c-string? 'a))))

(test-group "c-string"
  (test "" (ck () (c-string)))
  (test "test" (ck () (c-string '#\t '#\e '#\s '#\t))))

(test-group "c-string-length"
  (test 0 (ck () (c-string-length '"")))
  (test 4 (ck () (c-string-length '"test"))))

(test-group "c-string-ref"
  (test #\e (ck () (c-string-ref '"test" '1))))


(test-group "c-string=?"
  (test #t (ck () (c-string=? '"test" '"test")))
  (test #f (ck () (c-string=? '"tests" '"test"))))

(test-group "c-string-ci=?"
  (test #t (ck () (c-string-ci=? '"test" '"test")))
  (test #t (ck () (c-string-ci=? '"test" '"TEST")))
  (test #f (ck () (c-string-ci=? '"tests" '"test"))))


(test-group "c-substring"
  (test "est" (ck () (c-substring '"test" '1)))
  (test "es" (ck () (c-substring '"test" '1 '3)))
  (test "" (ck () (c-substring '"test" '1 '1))))

(test-group "c-string-append"
  (test "test" (ck () (c-string-append '"te" '"s" '"t"))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; VECTORS

(test-group "c-vector-length"
  (test 0 (ck () (c-vector-length '#())))
  (test 3 (ck () (c-vector-length '#(2 7 1)))))

(test-group "c-vector-ref"
  (test 7 (ck () (c-vector-ref '#(2 7 1) '1))))