(load-relative "loadtest.ss")
(require (lib "specs.ss" "framework")
	 (lib "class.ss"))
  
(SECTION 'contracts)

(parameterize ([error-print-width 200])
(let ()
  ;; test/spec-passed : symbol sexp -> void
  ;; tests a passing specification
  (define (test/spec-passed name expression)
    (printf "testing: ~s\n" name)
    (test (void)
          (let ([for-each-eval (lambda (l) (for-each eval l))]) for-each-eval)
          (list expression '(void))))
  
  (define (test/spec-passed/result name expression result)
    (printf "testing: ~s\n" name)
    (test result
          eval
          expression))
  
  ;; test/spec-failed : symbol sexp string -> void
  ;; tests a failing specification with blame assigned to `blame'
  (define (test/spec-failed name expression blame)
    (define (ensure-contract-failed x)
      (let ([result (with-handlers ([(lambda (x) (and (not-break-exn? x) (exn? x)))
                                     exn-message])
                      (list 'normal-termination
                            (eval x)))])
        (if (string? result)
            (cond
              [(regexp-match ": ([^ ]*) broke" result) => cadr]
              [(regexp-match "([^ ]+): .* does not imply" result) => cadr]
              [else (format "no blame in error message: \"~a\"" result)])
            result)))
    (printf "testing: ~s\n" name)
    (test blame
          ensure-contract-failed
          expression))
  
  (test/spec-passed
   'contract-flat1 
   '(contract not #f 'pos 'neg))
  
  (test/spec-failed
   'contract-flat2 
   '(contract not #t 'pos 'neg)
   "pos")
  
  (test/spec-passed
   'contract-arrow-star0a
   '(contract (->* (integer?) (integer?))
              (lambda (x) x)
              'pos
              'neg))
  
  (test/spec-failed
   'contract-arrow-star0b
   '((contract (->* (integer?) (integer?))
               (lambda (x) x)
               'pos
               'neg)
     #f)
   "neg")
  
  (test/spec-failed
   'contract-arrow-star0c
   '((contract (->* (integer?) (integer?))
               (lambda (x) #f)
               'pos
               'neg)
     1)
   "pos")
  
  (test/spec-passed
   'contract-arrow-star1
   '(let-values ([(a b) ((contract (->* (integer?) (integer? integer?))
                                   (lambda (x) (values x x))
                                   'pos
                                   'neg)
                         2)])
      1))
  
  (test/spec-failed
   'contract-arrow-star2
   '((contract (->* (integer?) (integer? integer?))
               (lambda (x) (values x x))
               'pos
               'neg)
     #f)
   "neg")
  
  (test/spec-failed
   'contract-arrow-star3
   '((contract (->* (integer?) (integer? integer?))
               (lambda (x) (values 1 #t))
               'pos
               'neg)
     1)
   "pos")
  
  (test/spec-failed
   'contract-arrow-star4
   '((contract (->* (integer?) (integer? integer?))
               (lambda (x) (values #t 1))
               'pos
               'neg)
     1)
   "pos")
  
  
  (test/spec-passed
   'contract-arrow-star5
   '(let-values ([(a b) ((contract (->* (integer?) 
                                        (listof integer?)
                                        (integer? integer?))
                                   (lambda (x) (values x x))
                                   'pos
                                   'neg)
                         2)])
      1))
  
  (test/spec-failed
   'contract-arrow-star6
   '((contract (->* (integer?) (listof integer?) (integer? integer?))
               (lambda (x) (values x x))
               'pos
               'neg)
     #f)
   "neg")
  
  (test/spec-failed
   'contract-arrow-star7
   '((contract (->* (integer?) (listof integer?) (integer? integer?))
               (lambda (x) (values 1 #t))
               'pos
               'neg)
     1)
   "pos")
  
  (test/spec-failed
   'contract-arrow-star8
   '((contract (->* (integer?) (listof integer?) (integer? integer?))
               (lambda (x) (values #t 1))
               'pos
               'neg)
     1)
   "pos")
  
  (test/spec-passed
   'contract-arrow-star9
   '((contract (->* (integer?) (listof integer?) (integer?))
               (lambda (x . y) 1)
               'pos
               'neg)
     1 2))
  
  (test/spec-failed
   'contract-arrow-star10
   '((contract (->* (integer?) (listof integer?) (integer?))
               (lambda (x . y) 1)
               'pos
               'neg)
     1 2 'bad)
   "neg")

  (test/spec-failed
   'contract-d1
   '(contract (integer? . ->d . (lambda (x) (lambda (y) (= x y))))
              1
              'pos
              'neg)
   "pos")
  
  (test/spec-passed
   'contract-d2
   '(contract (integer? . ->d . (lambda (x) (lambda (y) (= x y))))
              (lambda (x) x)
              'pos
              'neg))
  
  (test/spec-failed
   'contract-d2
   '((contract (integer? . ->d . (lambda (x) (lambda (y) (= x y))))
               (lambda (x) (+ x 1))
               'pos
               'neg)
     2)
   "pos")

  (test/spec-passed
   'contract-arrow1
   '(contract (integer? . -> . integer?) (lambda (x) x) 'pos 'neg))
  
  (test/spec-failed
   'contract-arrow2
   '(contract (integer? . -> . integer?) (lambda (x y) x) 'pos 'neg)
   "pos")
  
  (test/spec-failed
   'contract-arrow3
   '((contract (integer? . -> . integer?) (lambda (x) #f) 'pos 'neg) #t)
   "neg")
  
  (test/spec-failed
   'contract-arrow4
   '((contract (integer? . -> . integer?) (lambda (x) #f) 'pos 'neg) 1)
   "pos")


  (test/spec-passed
   'contract-arrow-any1
   '(contract (integer? . -> . any) (lambda (x) x) 'pos 'neg))
  
  (test/spec-failed
   'contract-arrow-any2
   '(contract (integer? . -> . any) (lambda (x y) x) 'pos 'neg)
   "pos")
  
  (test/spec-failed
   'contract-arrow-any3
   '((contract (integer? . -> . any) (lambda (x) #f) 'pos 'neg) #t)
   "neg")

  (test/spec-passed
   'contract-arrow-star-d1
   '((contract (->d* (integer?) (lambda (arg) (lambda (res) (= arg res))))
               (lambda (x) x)
               'pos
               'neg)
     1))
  
  (test/spec-passed
   'contract-arrow-star-d2
   '(let-values ([(a b)
                  ((contract (->d* (integer?) (lambda (arg) 
                                                (values (lambda (res) (= arg res)) 
                                                        (lambda (res) (= arg res)))))
                             (lambda (x) (values x x))
                             'pos
                             'neg)
                   1)])
      1))
  
  (test/spec-failed
   'contract-arrow-star-d3
   '((contract (->d* (integer?) (lambda (arg) 
                                  (values (lambda (res) (= arg res)) 
                                          (lambda (res) (= arg res)))))
               (lambda (x) (values 1 2))
               'pos
               'neg)
     2)
   "pos")
  
  (test/spec-failed
   'contract-arrow-star-d4
   '((contract (->d* (integer?) (lambda (arg) 
                                  (values (lambda (res) (= arg res)) 
                                          (lambda (res) (= arg res)))))
               (lambda (x) (values 2 1))
               'pos
               'neg)
     2)
   "pos")
  
  (test/spec-passed
   'contract-arrow-star-d5
   '((contract (->d* ()
                     (listof integer?)
                     (lambda (arg) (lambda (res) (= arg res))))
               (lambda (x) x)
               'pos
               'neg)
     1))
  
  (test/spec-passed
   'contract-arrow-star-d6
   '((contract (->d* () 
                     (listof integer?)
                     (lambda (arg) 
                       (values (lambda (res) (= arg res)) 
                               (lambda (res) (= arg res)))))
               (lambda (x) (values x x))
               'pos
               'neg)
     1))
  
  (test/spec-failed
   'contract-arrow-star-d7
   '((contract (->d* () 
                     (listof integer?)
                     (lambda (arg) 
                       (values (lambda (res) (= arg res)) 
                               (lambda (res) (= arg res)))))
               (lambda (x) (values 1 2))
               'pos
               'neg)
     2)
   "pos")
  
  (test/spec-failed
   'contract-arrow-star-d8
   '((contract (->d* ()
                     (listof integer?)
                     (lambda (arg) 
                       (values (lambda (res) (= arg res)) 
                               (lambda (res) (= arg res)))))
               (lambda (x) (values 2 1))
               'pos
               'neg)
     2)
   "pos")
  
  (test/spec-failed
   'contract-case->1
   '(contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
              (lambda (x) x)
              'pos
              'neg)
   "pos")
  
  (test/spec-failed
   'contract-case->2
   '((contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
               (case-lambda 
                 [(x y) 'case1]
                 [(x) 'case2])
               'pos
               'neg)
     1 2)
   "pos")
  
  (test/spec-failed
   'contract-case->3
   '((contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
               (case-lambda 
                 [(x y) 'case1]
                 [(x) 'case2])
               'pos
               'neg)
     1)
   "pos")
  
  (test/spec-failed
   'contract-case->4
   '((contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
               (case-lambda 
                 [(x y) 'case1]
                 [(x) 'case2])
               'pos
               'neg)
     'a 2)
   "neg")
  
  (test/spec-failed
   'contract-case->5
   '((contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
               (case-lambda 
                 [(x y) 'case1]
                 [(x) 'case2])
               'pos
               'neg)
     2 'a)
   "neg")
  
  (test/spec-failed
   'contract-case->6
   '((contract (case-> (integer? integer? . -> . integer?) (integer? . -> . integer?))
               (case-lambda 
                 [(x y) 'case1]
                 [(x) 'case2])
               'pos
               'neg)
     #t)
   "neg")
  
  (test/spec-failed
   'contract-d-protect-shared-state
   '(let ([x 1])
      ((contract ((->d (lambda () (let ([pre-x x]) (lambda (res) (= x pre-x)))))
                  . -> .
                  (lambda (x) #t))
                 (lambda (thnk) (thnk))
                 'pos
                 'neg)
       (lambda () (set! x 2))))
   "neg")
 
  (test/spec-failed
   'combo1
   '(let ([cf (contract (case->
                         ((class? . ->d . (lambda (%) (lambda (x) #f))) . -> . void?)
                         ((class? . ->d . (lambda (%) (lambda (x) #f))) boolean? . -> . void?))
                        (letrec ([c% (class object% (super-instantiate ()))]
                                 [f
                                  (case-lambda
                                    [(class-maker) (f class-maker #t)]
                                    [(class-maker b) 
                                     (class-maker c%)
                                     (void)])])
                          f)
                        'pos
                        'neg)])
      (cf (lambda (x%) 'going-to-be-bad)))
   "neg")   

  (test/spec-failed
   'union1
   '(contract (union false?) #t 'pos 'neg)
   "pos")

  (test/spec-passed
   'union2
   '(contract (union false?) #f 'pos 'neg))

  (test/spec-passed
   'union3
   '((contract (union (-> integer? integer?)) (lambda (x) x) 'pos 'neg) 1))
  
  (test/spec-failed
   'union4
   '((contract (union (-> integer? integer?)) (lambda (x) x) 'pos 'neg) #f)
   "neg")
  
  (test/spec-failed
   'union5
   '((contract (union (-> integer? integer?)) (lambda (x) #f) 'pos 'neg) 1)
   "pos")
  
  (test/spec-passed
   'union6
   '(contract (union false? (-> integer? integer?)) #f 'pos 'neg))
  
  (test/spec-passed
   'union7
   '((contract (union false? (-> integer? integer?)) (lambda (x) x) 'pos 'neg) 1))

  (test/spec-passed
   'define/contract1
   '(let ()
      (define/contract i integer? 1)
      i))
  
  (test/spec-failed
   'define/contract2
   '(let ()
      (define/contract i integer? #t)
      i)
   "i")
  
  (test/spec-failed
   'define/contract3
   '(let ()
      (define/contract i (-> integer? integer?) (lambda (x) #t))
      (i 1))
   "i")
  
  (test/spec-failed
   'define/contract4
   '(let ()
      (define/contract i (-> integer? integer?) (lambda (x) 1))
      (i #f))
   "")
  
  (test/spec-failed
   'define/contract5
   '(let ()
      (define/contract i (-> integer? integer?) (lambda (x) (i #t)))
      (i 1))
   "")
  
  (test/spec-passed
   'define/contract6
   '(let ()
      (define/contract contracted-func
                       (string?  string? . -> . string?)
                       (lambda (label t)
                         t))
      (contracted-func
       "I'm a string constant with side effects"
       "ans")))
  
  (test/spec-passed
   'provide/contract1
   '(let ()
      (eval '(module contract-test-suite1 mzscheme
               (require (lib "contracts.ss"))
               (provide/contract (x integer?))
               (define x 1)))
      (eval '(require contract-test-suite1))
      (eval 'x)))
  
  (test/spec-passed
   'provide/contract2
   '(let ()
      (eval '(module contract-test-suite2 mzscheme
               (require (lib "contracts.ss"))
               (provide/contract)))
      (eval '(require contract-test-suite2))))
  
  (test/spec-failed
   'provide/contract3
   '(let ()
      (eval '(module contract-test-suite3 mzscheme
               (require (lib "contracts.ss"))
               (provide/contract (x integer?))
               (define x #f)))
      (eval '(require contract-test-suite3))
      (eval 'x))
   "contract-test-suite3")
  
  (test/spec-passed
   'provide/contract4
   '(let ()
      (eval '(module contract-test-suite4 mzscheme
               (require (lib "contracts.ss"))
               (provide/contract (struct s ((a any?))))
               (define-struct s (a))))
      (eval '(require contract-test-suite4))
      (eval '(list (make-s 1)
                   (s-a (make-s 1))
                   (s? (make-s 1))
                   (set-s-a! (make-s 1) 2)))))
  
  (test/spec-passed
   'provide/contract5
   '(let ()
      (eval '(module contract-test-suite5 mzscheme
               (require (lib "contracts.ss"))
               (provide/contract (struct s ((a any?)))
                                 (struct t ((a any?))))
               (define-struct s (a))
               (define-struct t (a))))
      (eval '(require contract-test-suite5))
      (eval '(list (make-s 1)
                   (s-a (make-s 1))
                   (s? (make-s 1))
                   (set-s-a! (make-s 1) 2)
                   (make-t 1)
                   (t-a (make-t 1))
                   (t? (make-t 1))
                   (set-t-a! (make-t 1) 2)))))
  
  (test/spec-passed
   'provide/contract6
   '(let ()
      (eval '(module contract-test-suite6 mzscheme
               (require (lib "contracts.ss"))
               (provide/contract (struct s ((a any?))))
               (define-struct s (a))))
      (eval '(require contract-test-suite6))
      (eval '(define-struct (t s) ()))))
  
  
  (test/spec-passed/result
   'contract-=>flat1
   '(contract-=> (>=/c 5) (>=/c 10) 1 'badguy)
   1)
  (test/spec-passed/result
   'contract-=>flat2
   '(contract-=> (>=/c 5) (>=/c 10) 12 'badguy)
   12)
  (test/spec-failed
   'contract-=>flat3
   '(contract-=> (>=/c 5) (>=/c 10) 6 'badguy)
   "badguy")

  (test/spec-passed
   'contract-=>->1
   '(contract-=> ((>=/c 10) . -> . (>=/c 5)) ((>=/c 5) . -> . (>=/c 10)) (lambda (x) x) 'badguy))
  
  (test/spec-failed
   'contract-=>->2
   '(contract-=> ((>=/c 10) . -> . (>=/c 5)) ((>=/c 5) . -> . (>=/c 10)) 'not-a-proc 'badguy)
   "badguy")
  
  (test/spec-passed/result
   'contract-=>->3
   '((contract-=> ((>=/c 10) . -> . (>=/c 5)) ((>=/c 5) . -> . (>=/c 10)) (lambda (x) x) 'badguy)
     1)
   1)
  
  (test/spec-passed/result
   'contract-=>->4
   '((contract-=> ((>=/c 10) . -> . (>=/c 5)) ((>=/c 5) . -> . (>=/c 10)) (lambda (x) x) 'badguy)
     12)
   12)
  
  (test/spec-failed
   'contract-=>->5
   '((contract-=> ((>=/c 10) . -> . (>=/c 5)) ((>=/c 5) . -> . (>=/c 5)) (lambda (x) x) 'badguy)
     7)
   "badguy")
  
  (test/spec-failed
   'contract-=>->6
   '((contract-=> ((>=/c 10) . -> . (>=/c 5)) ((>=/c 10) . -> . (>=/c 10)) (lambda (x) 7) 'badguy)
     7)
   "badguy")

  (test/spec-passed
   'contract-=>->*1
   '(contract-=> (->* ((>=/c 10) (>=/c 20)) ((>=/c 3) (>=/c 8)))
                 (->* ((>=/c 3) (>=/c 8)) ((>=/c 10) (>=/c 20)))
                 (lambda (x y) (values x y))
                 'badguy))
  
  (test/spec-failed
   'contract-=>->*2
   '(contract-=> (->* ((>=/c 10) (>=/c 20)) ((>=/c 3) (>=/c 8)))
                 (->* ((>=/c 3) (>=/c 8)) ((>=/c 10) (>=/c 20)))
                 'not-a-proc
                 'badguy)
   "badguy")
  
  (test/spec-passed/result
   'contract-=>->*3
   '(let-values ([(r1 r2)
                  ((contract-=> (->* ((>=/c 10) (>=/c 20)) ((>=/c 3) (>=/c 8)))
                                (->* ((>=/c 3) (>=/c 8)) ((>=/c 10) (>=/c 20)))
                                (lambda (x y) (values x y))
                                'badguy)
                   1 7)])
      r1)
   1)
  
  (test/spec-passed/result
   'contract-=>->*4
   '(let-values ([(r1 r2)
                  ((contract-=> (->* ((>=/c 10) (>=/c 20)) ((>=/c 3) (>=/c 8)))
                                (->* ((>=/c 3) (>=/c 8)) ((>=/c 10) (>=/c 20)))
                                (lambda (x y) (values x y))
                                'badguy)
                   11 21)])
      r1)
   11)
  
  (test/spec-failed
   'contract-=>->*5
   '((contract-=> (->* ((>=/c 10) (>=/c 20)) ((>=/c 3) (>=/c 8)))
                  (->* ((>=/c 3) (>=/c 8)) ((>=/c 10) (>=/c 20)))
                  (lambda (x y) (values x y))
                  'badguy)
     5 21)
   "badguy")
  
  (test/spec-failed
   'contract-=>->*6
   '((contract-=> (->* ((>=/c 10) (>=/c 20)) ((>=/c 3) (>=/c 8)))
                  (->* ((>=/c 3) (>=/c 8)) ((>=/c 10) (>=/c 20)))
                  (lambda (x y) (values x y))
                  'badguy)
     11 10)
   "badguy")
  
  (test/spec-failed
   'contract-=>->*7
   '((contract-=> (->* ((>=/c 10) (>=/c 20)) ((>=/c 3) (>=/c 8)))
                  (->* ((>=/c 3) (>=/c 8)) ((>=/c 10) (>=/c 20)))
                  (lambda (x y) (values 8 25))
                  'badguy)
     11 21)
   "badguy")
  
  (test/spec-failed
   'contract-=>->*8
   '((contract-=> (->* ((>=/c 10) (>=/c 20)) ((>=/c 3) (>=/c 8)))
                  (->* ((>=/c 3) (>=/c 8)) ((>=/c 10) (>=/c 20)))
                  (lambda (x y) (values 15 10))
                  'badguy)
     11 21)
   "badguy")
  
  (test/spec-passed/result
   'contract-=>->*9
   '(let-values ([(a b)
                  ((contract-=> (->* ((>=/c 10) (>=/c 20) (>=/c 30)) ((>=/c 3) (>=/c 8)))
                                (->* ((>=/c 3) (>=/c 8) (>=/c 30)) ((>=/c 10) (>=/c 20)))
                                (lambda (x y z) (values x z))
                                'badguy)
                   101 102 103)])
      b)
   103)
  
  (test/spec-failed
   'contract-=>mismatch
   '(contract-=> (>=/c 5)
                 (-> (>=/c 3) (>=/c 8))
                 1
                 'badguy)
   "badguy")

  (test/spec-passed/result
   'contract-=>->*10
   '((contract-=> (->* ((>=/c 10)) (listof (>=/c 20)) ((>=/c 3)))
                  (->* ((>=/c 3)) (listof (>=/c 8)) ((>=/c 10)))
                  (lambda (x . y) 1)
                  'badguy)
     100
     200
     300)
   1)
  
  (test/spec-failed
   'contract-=>->*11
   '((contract-=> (->* ((>=/c 10)) (listof (>=/c 20)) ((>=/c 3)))
                  (->* ((>=/c 3)) (listof (>=/c 8)) ((>=/c 10)))
                  (lambda (x . y) 1)
                  'badguy)
     7
     200
     300)
   "badguy")
  
  (test/spec-failed
   'contract-=>->*12
   '((contract-=> (->* ((>=/c 10)) (listof (>=/c 20)) ((>=/c 3)))
                  (->* ((>=/c 3)) (listof (>=/c 8)) ((>=/c 10)))
                  (lambda (x . y) 1)
                  'badguy)
     100
     10
     300)
   "badguy")
  
  (test/spec-failed
   'contract-=>->*13
   '((contract-=> (->* ((>=/c 10)) (listof (>=/c 20)) ((>=/c 3)))
                  (->* ((>=/c 3)) (listof (>=/c 8)) ((>=/c 10)))
                  (lambda (x . y) 1)
                  'badguy)
     100
     200
     10)
   "badguy")
  
  (test/spec-failed
   'contract-=>->*14
   '((contract-=> (->* ((>=/c 10)) (listof (>=/c 20)) ((>=/c 3)))
                  (->* ((>=/c 3)) (listof (>=/c 8)) ((>=/c 10)))
                  (lambda (x . y) 5)
                  'badguy)
     100
     200
     300)
   "badguy")
  
  (test/spec-passed/result
   'contract-=>-case->1
   '((contract-=> (case-> (integer? . -> . integer?)) (case-> (integer? . -> . integer?)) (case-lambda [(x) x]) 'badguy) 1)
   1)
  
  (test/spec-passed/result
   'contract-=>-case->2
   '((contract-=> (case->
                   (-> (>=/c 10) (>=/c 3))
                   (-> (>=/c 10) (>=/c 10) (>=/c 3)))
                  (case->
                   (-> (>=/c 3) (>=/c 10))
                   (-> (>=/c 3) (>=/c 3) (>=/c 10)))
                  (case-lambda
                    [(x) x]
                    [(x y) x])
                  'badguy)
     100)
   100)
  
  (test/spec-passed/result
   'contract-=>-case->3
   '((contract-=> (case->
                   (-> (>=/c 10) (>=/c 3))
                   (-> (>=/c 10) (>=/c 10) (>=/c 3)))
                  (case->
                   (-> (>=/c 3) (>=/c 10))
                   (-> (>=/c 3) (>=/c 3) (>=/c 10)))
                  (case-lambda
                    [(x) x]
                    [(x y) x])
                  'badguy)
     100
     200)
   100)
  
  (test/spec-failed
   'contract-=>-case->4
   '((contract-=> (case->
                   (-> (>=/c 10) (>=/c 3))
                   (-> (>=/c 100) (>=/c 100) (>=/c 30)))
                  (case->
                   (-> (>=/c 3) (>=/c 10))
                   (-> (>=/c 30) (>=/c 30) (>=/c 100)))
                  (case-lambda
                    [(x) x]
                    [(x y) x])
                  'badguy)
     8)
   "badguy")
  
  (test/spec-failed
   'contract-=>-case->5
   '((contract-=> (case->
                   (-> (>=/c 10) (>=/c 3))
                   (-> (>=/c 100) (>=/c 100) (>=/c 30)))
                  (case->
                   (-> (>=/c 3) (>=/c 10))
                   (-> (>=/c 30) (>=/c 30) (>=/c 100)))
                  (case-lambda
                    [(x) x]
                    [(x y) x])
                  'badguy)
     80
     80)
   "badguy")
  
  (test/spec-passed/result
   'class-contract1
   '(send
     (make-object (contract (class-contract (public m (integer? . -> . integer?)))
                            (class object% (define/public (m x) x) (super-instantiate ()))
                            'pos
                            'neg))
     m
     1)
   1)
  
  (test/spec-failed
   'class-contract2
   '(contract (class-contract (public m (integer? . -> . integer?)))
              object%
              'pos
              'neg)
   "pos")
  
  (test/spec-failed
   'class-contract3
   '(send
     (make-object (contract (class-contract (public m (integer? . -> . integer?)))
                            (class object% (define/public (m x) x) (super-instantiate ()))
                            'pos
                            'neg))
     m
     'x)
   "neg")
  
  (test/spec-failed
   'class-contract4
   '(send
     (make-object (contract (class-contract (public m (integer? . -> . integer?)))
                            (class object% (define/public (m x) 'x) (super-instantiate ()))
                            'pos
                            'neg))
     m
     1)
   "pos")
  
  (test/spec-failed
   'class-contract=>1
   '(let* ([c% (contract (class-contract (public m ((>=/c 10) . -> . (>=/c 10))))
                         (class object% (define/public (m x) x) (super-instantiate ()))
                         'pos-c
                         'neg-c)]
           [d% (contract (class-contract (override m ((>=/c 15) . -> . (>=/c 5))))
                         (class c% (define/override (m x) x) (super-instantiate ()))
                         'pos-d
                         'neg-d)])
      (send (make-object d%) m 12))
   "pos-d")
  
  (test/spec-failed
   'class-contract=>2
   '(let* ([c% (contract (class-contract (public m ((>=/c 10) . -> . (>=/c 10))))
                         (class object% (define/public (m x) x) (super-instantiate ()))
                         'pos-c
                         'neg-c)]
           [d% (contract (class-contract (override m ((>=/c 15) . -> . (>=/c 5))))
                         (class c% (define/override (m x) 8) (super-instantiate ()))
                         'pos-d
                         'neg-d)])
      (send (make-object d%) m 100))
   "pos-d")
  
  ))

(report-errs)