contract-test.ss

#lang scheme/base

(require "contract.ss"
         "test-base.ss")

; Tests ------------------------------------------

; test-suite
(define/provide-test-suite contract-tests
  
  (test-case "arity/c : fixed arity procedures"
    (check-false (contract-first-order-passes? (arity/c 1) (lambda () #t)))
    (check-true  (contract-first-order-passes? (arity/c 1) (lambda (a) #t)))
    (check-false (contract-first-order-passes? (arity/c 1) (lambda (a b) #t))))
  
  (test-case "arity/c : rest arguments"
    (check-false (contract-first-order-passes? (arity/c 2) (lambda (a b c . d) #t)))
    (check-true  (contract-first-order-passes? (arity/c 2) (lambda (a b . c) #t)))
    (check-true  (contract-first-order-passes? (arity/c 2) (lambda (a . b) #t)))
    (check-true  (contract-first-order-passes? (arity/c 2) (lambda a #t))))
  
  (test-case "arity/c : optional arguments"
    (check-false (contract-first-order-passes? (arity/c 2) (lambda (a b c) #t)))
    (check-true  (contract-first-order-passes? (arity/c 2) (lambda (a b [c #f]) #t)))
    (check-true  (contract-first-order-passes? (arity/c 2) (lambda (a [b #f] [c #f]) #t)))
    (check-true  (contract-first-order-passes? (arity/c 2) (lambda ([a #f] [b #f] [c #f]) #t))))
  
  (test-case "arity/c : keyword arguments"
    ; Basically, arity/c doesn't work with keyword procedures
    (check-false (contract-first-order-passes? (arity/c 2) (lambda (#:a a #:b b #:c c) #t)))
    (check-false (contract-first-order-passes? (arity/c 2) (lambda (#:a a #:b b #:c [c #f]) #t)))
    (check-false (contract-first-order-passes? (arity/c 2) (lambda (#:a a #:b [b #f] #:c [c #f]) #t)))
    (check-false (contract-first-order-passes? (arity/c 2) (lambda (#:a [a #f] #:b [b #f] #:c [c #f]) #t)))
    (check-false (contract-first-order-passes? (arity/c 2) (lambda (x #:a a #:b b #:c c) #t)))
    (check-true (contract-first-order-passes? (arity/c 2) (lambda (x y #:a a #:b b #:c c) #t)))
    (check-false (contract-first-order-passes? (arity/c 2) (lambda (x y z #:a a #:b b #:c c) #t)))
    (check-true (contract-first-order-passes? (arity/c 2) (lambda (x y [z #f] #:a a #:b b #:c c) #t)))))