Remove/disable broken tests.

original commit: e32a7603b2c7c188add915561d05e9b4d3362593
This commit is contained in:
Eric Dobson 2013-12-16 21:37:49 -08:00
parent 9b858ddfd0
commit 13d40d3616

View File

@ -27,8 +27,10 @@
('type v))
(define reason
(let/ec exit
(type->contract v (λ (#:reason [reason #f]) (exit reason)))
(fail-check "type could be converted to contract")))
(let ([contract (type->contract v (λ (#:reason [reason #f])
(exit (or reason "No reason given"))))])
(with-check-info (('contract (syntax->datum contract)))
(fail-check "type could be converted to contract")))))
(unless (regexp-match? expected-reason reason)
(with-check-info (('reason reason))
(fail-check "Reason didn't match expected.")))))))
@ -36,16 +38,14 @@
(define known-bugs
(test-suite "Known Bugs"
;; This should fail as case-> doesn't support keyword arguments.
(t
(make-Function
(list
(make-arr* (list) -Boolean #:kws (list (make-Keyword '#:key Univ #t)))
(make-arr* (list Univ Univ) -Boolean #:kws (list (make-Keyword '#:key2 Univ #t))))))
;; Polydotted functions should work
#;
(t/fail (-polydots (a) (->... (list) (a a) -Symbol))
"not supported for this type")))
"not supported for this type")
;; These should fail
(t (-> (-poly (a b) (-> (Un a b) (Un a b))) Univ))))
@ -66,30 +66,44 @@
(t (-poly (a) (-mu X (-> a X))))
(t (-poly (a) (-poly (b) (-> a a))))
(t (-poly (a) (-App (-poly (b) (-> a a)) (list -Number) #'#f)))
(t (-poly (a) -Flonum))
(t (-poly (a) (-set -Number)))
(t (-poly (a) (-lst a)))
(t (-poly (a) (-vec a)))
#|
(t/fail ((-poly (a) (-vec a)) . -> . -Symbol)
"some error")
(t/fail
(make-Function
(list (make-arr* (list) -Boolean #:kws (list (make-Keyword '#:key Univ #f)))
(make-arr* (list Univ) -Boolean #:kws (list (make-Keyword '#:key2 Univ #f)))))
"case function type with optional keyword arguments")
(t/fail (-poly (a) -Flonum) "non-function polymorphic type")
(t/fail (-> (-> Univ -Boolean : -Symbol) -Symbol)
"function type with filters or objects")
(t/fail (-poly (a) (-set -Number)) "non-function polymorphic type")
(t/fail (cl->*
(-> -Boolean -Boolean)
(-> -Symbol -Symbol))
"two cases of arity 1")
(t/fail (-Syntax (-HT -Symbol -Symbol))
"first-order contract, but got a hashtable.")
(t/fail (-Syntax (-struct #'struct-name #f (list (make-fld -Symbol #'acc #t))))
"first-order contract, .* struct with at least one mutable field")
(t/fail (-struct #'struct-name #f (list (make-fld -Symbol #'acc #f)) (-> -Symbol))
"procedural structs are not supported")
(t/fail (-Syntax (-> -Boolean -Boolean))
#rx"required a first-order .* generate a higher-order")
(t/fail (-set (-Param -Boolean -Boolean))
(t/fail (-set (-seq -Boolean))
#rx"required a chaperone or flat contract .* generate an impersonator")
(t/fail (-poly (a b) (-> (Un a b) (Un a b)))
"multiple distinct type variables")
))
(t/fail
(make-Function
(list
(make-arr* (list) -Boolean #:kws (list (make-Keyword '#:key Univ #t)))
(make-arr* (list Univ Univ) -Boolean #:kws (list (make-Keyword '#:key2 Univ #t)))))
"some error")
(t/fail (-Syntax (-struct #'struct-name #f (list (make-fld -Symbol #'acc #t)) #f #t))
"some error")
|#
))