Add first-order checks to simple-result-> contract

Fixes issue #368

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))

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))