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

fixed PR 8190

Browse Source 
svn: r3839
This commit is contained in:
Robby Findler 2006-07-27 14:10:55 +00:00
parent 0bab258328
commit 967cd9ab14
2 changed files with 23 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -552,9 +552,15 @@ add struct contracts for immutable structs?
;; builds a begin expression for the entire contract and provide
;; the first syntax object is used for source locations
(define (code-for-one-id/new-name stx id ctrct user-rename-id)
(with-syntax ([id-rename (a:mangle-id provide-stx "provide/contract-id" id)]
[contract-id (a:mangle-id provide-stx "provide/contract-contract-id" id)]
[pos-module-source (a:mangle-id provide-stx "provide/contract-pos-module-source" id)]
(with-syntax ([id-rename (a:mangle-id provide-stx
"provide/contract-id"
(or user-rename-id id))]
[contract-id (a:mangle-id provide-stx
"provide/contract-contract-id"
(or user-rename-id id))]
[pos-module-source (a:mangle-id provide-stx
"provide/contract-pos-module-source"
(or user-rename-id id))]
[pos-stx (datum->syntax-object provide-stx 'here)]
[id id]
[ctrct (syntax-property ctrct 'inferred-name id)]

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

@ -4243,7 +4243,7 @@
;; (at the end, becuase they are slow w/out .zo files)
;;
(test/spec-passed
(test/spec-passed
'provide/contract1
'(let ()
(eval '(module contract-test-suite1 mzscheme
@ -4417,6 +4417,19 @@
[s-a 3])))
(eval '(require n))))
(test/spec-passed
'provide/contract11
'(parameterize ([current-namespace (make-namespace)])
(eval '(module m mzscheme
(require (lib "contract.ss"))
(define x 1)
(provide/contract [rename x y integer?]
[rename x z integer?])))
(eval '(module n mzscheme
(require m)
(+ y z)))
(eval '(require n))))
;; this test is broken, not sure why
#|
(test/spec-failed