clean up some confusion about the timing of errors

specifically, always wait for the neg party to come in
before signalling any errors
This commit is contained in:
Robby Findler 2016-02-10 17:35:46 -06:00
parent 640895645f
commit 71f338430b
3 changed files with 32 additions and 24 deletions

View File

@ -1068,6 +1068,19 @@
(define a (s-x (chaperone-struct an-s s-x (λ (s x) x))))))
(eval '(dynamic-require ''provide/contract55-m2 'a)))
'5)
(test/spec-failed
'provide/contract56
'(let ()
(eval '(module provide/contract56-m1 racket/base
(require racket/contract/base)
(provide
(contract-out
[f (-> integer? integer?)]))
(define f 1)))
(eval '(dynamic-require ''provide/contract56-m1 #f)))
"provide/contract56-m1")
(contract-error-test
'contract-error-test8

View File

@ -15,8 +15,7 @@
->stct-kwd-infos)
(let/ec k
(unless (procedure? val)
(maybe-err
k blame
(k
(λ (neg-party)
(raise-blame-error blame #:missing-party neg-party val
'(expected: "a procedure" given: "~e")
@ -37,8 +36,7 @@
(<= (arity-at-least-value lst) ->stct-min-arity)))
#t)))
(unless matching-arity?
(maybe-err
k blame
(k
(λ (neg-party)
(raise-blame-error blame #:missing-party neg-party val
'(expected:
@ -54,8 +52,7 @@
(arity-as-string val)))))
(define (should-have-supplied kwd)
(maybe-err
k blame
(k
(λ (neg-party)
(raise-blame-error blame #:missing-party neg-party val
'(expected:
@ -67,8 +64,7 @@
(arity-as-string val)))))
(define (should-not-have-supplied kwd)
(maybe-err
k blame
(k
(λ (neg-party)
(raise-blame-error blame #:missing-party neg-party val
'(expected:
@ -107,8 +103,7 @@
[(equal? kwd (kwd-info-kwd kwd-info))
(when (and (not (kwd-info-mandatory? kwd-info))
mandatory?)
(maybe-err
k blame
(k
(λ (neg-party)
(raise-blame-error
blame #:missing-party neg-party val
@ -224,7 +219,3 @@
(cons (format "~a, " (car kwds))
(loop (cdr kwds)))])))]))
(define (maybe-err k blame neg-accepter)
(if (blame-original? blame)
(neg-accepter #f)
(k neg-accepter)))

View File

@ -548,17 +548,21 @@
(define (arrow-higher-order:vfp val)
(define-values (normal-proc proc-with-no-result-checking expected-number-of-results)
(apply plus-one-arity-function orig-blame val plus-one-constructor-args))
(wrapped-extra-arg-arrow
(cond
[(do-arity-checking orig-blame val doms rest min-arity kwd-infos)
=>
values]
[else
(cond
[(do-arity-checking orig-blame val doms rest min-arity kwd-infos)
=>
(λ (neg-party-acceptor)
;; probably don't need to include the wrapped-extra-arrow wrapper
;; here, but it is easier to reason about the contract-out invariant
;; with it here
(wrapped-extra-arg-arrow neg-party-acceptor normal-proc))]
[else
(wrapped-extra-arg-arrow
(λ (neg-party)
(successfully-got-the-right-kind-of-function val neg-party))])
(if (equal? (procedure-result-arity val) expected-number-of-results)
proc-with-no-result-checking
normal-proc)))
(successfully-got-the-right-kind-of-function val neg-party))
(if (equal? (procedure-result-arity val) expected-number-of-results)
proc-with-no-result-checking
normal-proc))]))
(if okay-to-do-only-arity-check?
(λ (val)
(cond