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

Identifiers in signature contracts don't use whatever prefixing or such may be

Browse Source 
in play in the body of a unit, so we need to rename the "external" version to
the "internal" version.  This fixes PR 10246.

svn: r17571
This commit is contained in:
Stevie Strickland 2010-01-08 17:20:19 +00:00
parent e0509fa28e
commit 9e0f2a3c5f
2 changed files with 44 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/mzlib/unit.ss
View File

@ -463,13 +463,13 @@
(cons (car x)
(signature-siginfo (lookup-signature (cdr x)))))
(define-for-syntax (make-import-unboxing var loc ctc)
(define-for-syntax (make-import-unboxing var renamings loc ctc)
(if ctc
(with-syntax ([ctc-stx (syntax-property ctc 'inferred-name var)])
(quasisyntax/loc (error-syntax)
(quote-syntax (let ([v/c (#,loc)])
(if (pair? v/c)
(contract ctc-stx (car v/c) (cdr v/c)
(contract (let-syntax #,renamings ctc-stx) (car v/c) (cdr v/c)
(current-contract-region)
#,(id->contract-src-info var))
(error 'unit "contracted import ~a used before definition"
@ -561,16 +561,24 @@
(let-values ([(iloc ...)
(vector->values (hash-table-get import-table import-key) 0 icount)]
...)
(letrec-syntaxes (#,@(map (lambda (ivs ils ics)
(quasisyntax/loc (error-syntax)
[#,ivs
(make-id-mappers
#,@(map (lambda (iv l c)
(make-import-unboxing iv l c))
(syntax->list ivs)
(syntax->list ils)
ics))]))
(letrec-syntaxes (#,@(map (lambda (ivs e-ivs ils ics)
(with-syntax ([renamings
(map (λ (ev iv)
#`(#,ev
(make-rename-transformer
(quote-syntax #,iv))))
(syntax->list e-ivs)
(syntax->list ivs))])
(quasisyntax/loc (error-syntax)
[#,ivs
(make-id-mappers
#,@(map (lambda (iv l c)
(make-import-unboxing iv #'renamings l c))
(syntax->list ivs)
(syntax->list ils)
ics))])))
(syntax->list #'((int-ivar ...) ...))
(syntax->list #'((ext-ivar ...) ...))
(syntax->list #'((iloc ...) ...))
(map cadddr import-sigs)))
(letrec-syntaxes+values (renames ...

25
collects/tests/units/test-unit-contracts.ss
View File

@ -862,3 +862,28 @@
(make-student 4 3))
(test-contract-error top-level "student-id" "not a student"
(student-id 'a)))
;; Test that prefixing doesn't cause issues.
(let ()
(define-signature t^
((contracted (t? (any/c . -> . boolean?))
(make-t (-> t?)))))
(define-unit t@
(import)
(export t^)
(define-struct t ()))
(define-signature s^ (new-make-t))
(define-unit s@
(import (prefix pre: t^))
(export s^)
(define new-make-t pre:make-t))
(define c@ (compound-unit (import)
(export S)
(link [((T : t^)) t@]
[((S : s^)) s@ T])))
(define-values/invoke-unit c@ (import) (export s^))
(new-make-t))