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

contract error: shift path normalization to error time

Browse Source 
Making a pathcollects-relative  at contract-formation time means a
lot of extra work then and a change to the needed sandbox permissions.
Aormalizing at error time is more consistent with other parts of a
contract message.
This commit is contained in:
Matthew Flatt 2013-03-29 06:50:36 -06:00
parent 3f7fcdf1b7
commit 70eb426aa4
2 changed files with 3 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/racket/contract/private/blame.rkt
View File

@ -215,13 +215,13 @@
(define blaming-line (define blaming-line
(cond (cond
[(null? (cdr blame-parties)) [(null? (cdr blame-parties))
(format " blaming: ~a" (car blame-parties))] (format " blaming: ~a" (convert-blame-singleton (car blame-parties)))]
[else [else
(apply (apply
string-append string-append
" blaming multiple parties:" " blaming multiple parties:"
(for/list ([party (in-list blame-parties)]) (for/list ([party (in-list blame-parties)])
(format "\n ~a" party)))])) (format "\n ~a" (convert-blame-singleton party))))]))
(define from-line (define from-line
(if (blame-original? blme) (if (blame-original? blme)

9
collects/racket/contract/private/provide.rkt
View File

@ -18,7 +18,6 @@
[make-module-identifier-mapping make-free-identifier-mapping] [make-module-identifier-mapping make-free-identifier-mapping]
[module-identifier-mapping-get free-identifier-mapping-get] [module-identifier-mapping-get free-identifier-mapping-get]
[module-identifier-mapping-put! free-identifier-mapping-put!])) [module-identifier-mapping-put! free-identifier-mapping-put!]))
setup/path-to-relative
"arrow.rkt" "arrow.rkt"
"base.rkt" "base.rkt"
"guts.rkt" "guts.rkt"
@ -91,7 +90,7 @@
#`(contract contract-id #`(contract contract-id
id id
pos-module-source pos-module-source
(maybe-call-path->relative-string/library (quote-module-name)) (quote-module-name)
'external-id 'external-id
#,srcloc-code))))))]) #,srcloc-code))))))])
(when key (hash-set! saved-id-table key lifted-id)) (when key (hash-set! saved-id-table key lifted-id))
@ -122,12 +121,6 @@
(provide/contract-transformer contract-id id external-id new-pos (make-hasheq))))) (provide/contract-transformer contract-id id external-id new-pos (make-hasheq)))))
(define (maybe-call-path->relative-string/library x)
(if (path? x)
(path->relative-string/library x)
x))
(define-for-syntax (true-provide/contract provide-stx just-check-errors? who) (define-for-syntax (true-provide/contract provide-stx just-check-errors? who)
(syntax-case provide-stx () (syntax-case provide-stx ()
[(_ p/c-ele ...) [(_ p/c-ele ...)