diff --git a/typed-racket-lib/typed-racket/utils/simple-result-arrow.rkt b/typed-racket-lib/typed-racket/utils/simple-result-arrow.rkt index c988cb3d..dbe968b3 100644 --- a/typed-racket-lib/typed-racket/utils/simple-result-arrow.rkt +++ b/typed-racket-lib/typed-racket/utils/simple-result-arrow.rkt @@ -17,6 +17,19 @@ #:late-neg-projection (λ (blm) (lambda (v neg) + (unless (procedure? v) + (raise-blame-error + #:missing-party neg + blm #f + (list 'expected: "a procedure" 'given: (~s v)))) + (unless (procedure-arity-includes? v arity) + (raise-blame-error + #:missing-party neg + blm #f + (list 'expected: + (format "a procedure that accepts ~a non-keyword argument" + arity) + 'given: (~s v)))) ;; We could have separate kinda-fast paths for when one of these conditions ;; is true, but that is unlikely to be an important case in practice. (if (and (equal? arity (procedure-arity v)) diff --git a/typed-racket-test/unit-tests/contract-tests.rkt b/typed-racket-test/unit-tests/contract-tests.rkt index 9c28f238..81746371 100644 --- a/typed-racket-test/unit-tests/contract-tests.rkt +++ b/typed-racket-test/unit-tests/contract-tests.rkt @@ -355,6 +355,19 @@ (class object% (super-new) (define/public (m) "m")) #:untyped) + + ;; Github issue #368 + (t-int/fail (-> -Integer -Integer) + values + 3 + #:untyped + #:msg #rx"promised: a procedure") + (t-int/fail (-> -Integer -Integer) + values + (λ () 3) + #:untyped + #:msg #rx"that accepts 1 non-keyword") + ;; intersection types (t (-unsafe-intersect (-seq -Symbol) (-pair -Symbol (-lst -Symbol)))) (t/fail (-unsafe-intersect (-Number . -> . -Number) (-String . -> . -String))