#lang scheme

(require (planet schematics/schemeunit:2:10/test)
         "../function.ss")

(provide test-function)

(define test-function
  (test-suite "function.ss"
    (test-suite "identity"
      (test-case "unique symbol"
        (let* ([sym (gensym)])
          (check-eq? (identity sym) sym))))
    (test-suite "constant"
      (test-case "unique symbol"
        (let* ([sym (gensym)])
          (check-eq? ((constant sym) 'x #:y 'z) sym))))
    (test-suite "curry*"
      (test-case "list"
        (check-equal? ((curry* list 1 2) 3 4) (list 1 2 3 4)))
      (test-case "sort"
        (check-equal?
         ((curry* sort '((1 a) (4 d) (2 b) (3 c)) #:cache-keys? #f)
          < #:key car)
         '((1 a) (2 b) (3 c) (4 d)))))
    (test-suite "curryr*"
      (test-case "list"
        (check-equal? ((curryr* list 1 2) 3 4) (list 3 4 1 2)))
      (test-case "sort"
        (check-equal?
         ((curryr* sort < #:key car)
          '((1 a) (4 d) (2 b) (3 c)) #:cache-keys? #f)
         '((1 a) (2 b) (3 c) (4 d)))))
    (test-suite "conjoin"
      (test-case "no functions"
        (check-true ((conjoin) 'x #:y 'z)))
      (test-case "true"
        (check-true ((conjoin integer? exact?) 1)))
      (test-case "false"
        (check-false ((conjoin integer? exact?) 1.0)))
      (test-case "false"
        (check-false ((conjoin integer? exact?) 0.5))))
    (test-suite "disjoin"
      (test-case "no functions"
        (check-false ((disjoin) 'x #:y 'z)))
      (test-case "true"
        (check-true ((disjoin integer? exact?) 1)))
      (test-case "true"
        (check-true ((disjoin integer? exact?) 1/2)))
      (test-case "false"
        (check-false ((disjoin integer? exact?) 0.5))))
    (test-suite "call"
      (test-case "string-append"
        (check-equal? (call string-append "a" "b" "c") "abc")))
    (test-suite "thunk"
      (test-case "unique symbol"
        (let* ([count 0]
               [f (thunk (set! count (+ count 1)) count)])
          (check = count 0)
          (check = (f) 1)
          (check = count 1))))
    (test-suite "lambda/parameter"
      (test-case "provided"
        (let* ([p (make-parameter 0)])
          (check = ((lambda/parameter ([x #:param p]) x) 1) 1)))
      (test-case "not provided"
        (let* ([p (make-parameter 0)])
          (check = ((lambda/parameter ([x #:param p]) x)) 0))))))