suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed bug where the name has disappeared from a contract violation (and added test cases, of course)

Browse Source 
svn: r4235
This commit is contained in:
Robby Findler 2006-09-04 02:07:01 +00:00
parent 204bc48a50
commit 4a6cee9cf8
2 changed files with 43 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mzlib/private/contract.ss
View File

@ -86,11 +86,11 @@ add struct contracts for immutable structs?
[id id]
[pos-module-source pos-module-source])
(syntax-case stx (set!)
[(set! _ body) (raise-syntax-error
[(set! id body) (raise-syntax-error
#f
"cannot set! provide/contract identifier"
stx
(syntax _))]
(syntax id))]
[(name arg ...)
(syntax
((begin-lifted
@ -98,7 +98,7 @@ add struct contracts for immutable structs?
id
pos-module-source
(module-source-as-symbol #'name)
(quote-syntax _)))
(quote-syntax name)))
arg
...))]
[name
@ -109,7 +109,7 @@ add struct contracts for immutable structs?
id
pos-module-source
(module-source-as-symbol #'name)
(quote-syntax _))))])))))
(quote-syntax name))))])))))
;; (define/contract id contract expr)
;; defines `id' with `contract'; initially binding

42
collects/tests/mzscheme/contract-test.ss
View File

@ -4554,12 +4554,48 @@
#'(parameterize ([current-namespace (make-namespace)])
(eval '(module bug mzscheme
(require (lib "contract.ss"))
(define the-defined-variable 'five)
(provide/contract [the-defined-variable number?])))
(define the-defined-variable1 'five)
(provide/contract [the-defined-variable1 number?])))
(eval '(require bug)))
(λ (x)
(and (exn? x)
(regexp-match #rx"on the-defined-variable" (exn-message x)))))
(regexp-match #rx"on the-defined-variable1" (exn-message x)))))
(error-test
#'(parameterize ([current-namespace (make-namespace)])
(eval '(module bug mzscheme
(require (lib "contract.ss"))
(define the-defined-variable2 values)
(provide/contract [the-defined-variable2 (-> number? any)])))
(eval '(require bug))
(eval '(the-defined-variable2 #f)))
(λ (x)
(and (exn? x)
(regexp-match #rx"on the-defined-variable2" (exn-message x)))))
(error-test
#'(parameterize ([current-namespace (make-namespace)])
(eval '(module bug mzscheme
(require (lib "contract.ss"))
(define the-defined-variable3 (λ (x) #f))
(provide/contract [the-defined-variable3 (-> any/c number?)])))
(eval '(require bug))
(eval '(the-defined-variable3 #f)))
(λ (x)
(and (exn? x)
(regexp-match #rx"on the-defined-variable3" (exn-message x)))))
(error-test
#'(parameterize ([current-namespace (make-namespace)])
(eval '(module bug mzscheme
(require (lib "contract.ss"))
(define the-defined-variable4 (λ (x) #f))
(provide/contract [the-defined-variable4 (-> any/c number?)])))
(eval '(require bug))
(eval '((if #t the-defined-variable4) #f)))
(λ (x)
(and (exn? x)
(regexp-match #rx"on the-defined-variable4" (exn-message x)))))