diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss index 95af546c09..3ab590aaa6 100644 --- a/collects/scheme/private/contract.ss +++ b/collects/scheme/private/contract.ss @@ -129,6 +129,11 @@ improve method arity mismatch contract violation error messages? [name (identifier? (syntax name)) (syntax saved-id)] + [(set! id arg) + (raise-syntax-error 'provide/contract + "cannot set! a provide/contract variable" + stx + (syntax id))] [(name . more) (with-syntax ([app (datum->syntax stx '#%app)]) (syntax/loc stx (app saved-id . more)))])))) diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss index 1177d516b9..e0f698f057 100644 --- a/collects/tests/mzscheme/contract-test.ss +++ b/collects/tests/mzscheme/contract-test.ss @@ -5778,6 +5778,19 @@ so that propagation occurs. (and (exn? x) (regexp-match #rx"expected field name to be b, but found string?" (exn-message x))))) + (contract-error-test + #'(begin + (eval '(module pce7-bug scheme/base + (require scheme/contract) + (define x 1) + (provide/contract [x integer?]))) + (eval '(module pce7-bug2 scheme/base + (require 'pce7-bug) + (set! x 5)))) + (λ (x) + (and (exn? x) + (regexp-match #rx"cannot set!" (exn-message x))))) + (contract-eval `(,test 'pos guilty-party (with-handlers ((void values)) (contract not #t 'pos 'neg)))) (report-errs)