From 8656e7e918e2f08e4873dbfc48f738cbb234a1d4 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Thu, 12 Feb 2009 03:51:40 +0000 Subject: [PATCH] Fix up the contracts so that they properly refer to locally defined variables. svn: r13527 --- collects/mzlib/unit.ss | 2 +- collects/tests/units/test-unit-contracts.ss | 26 +++++++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss index aa5c441af4..ff1c7690cc 100644 --- a/collects/mzlib/unit.ss +++ b/collects/mzlib/unit.ss @@ -602,7 +602,7 @@ (raise-stx-err "cannot export syntax from a unit" name)) (set-var-info-exported?! v loc) (when (pair? (syntax-e ctc)) - (set-var-info-ctc! v (cdr (syntax-e ctc)))))) + (set-var-info-ctc! v (localify (cdr (syntax-e ctc)) def-ctx))))) (syntax->list (localify #'evars def-ctx)) (syntax->list #'elocs) (syntax->list #'ectcs)) diff --git a/collects/tests/units/test-unit-contracts.ss b/collects/tests/units/test-unit-contracts.ss index c6548a2676..f44a8e58e3 100644 --- a/collects/tests/units/test-unit-contracts.ss +++ b/collects/tests/units/test-unit-contracts.ss @@ -599,3 +599,29 @@ (unit/c (import) (export)) 3) not-a-unit)) + +;; Adding a test to make sure that contracts can refer +;; to other parts of the signature. + +(module m3 scheme + (define-signature toy-factory^ + ((contracted + [build-toys (-> integer? (listof toy?))] + [repaint (-> toy? symbol? toy?)] + [toy? (-> any/c boolean?)] + [toy-color (-> toy? symbol?)]))) + + (define-unit simple-factory@ + (import) + (export toy-factory^) + + (printf "Factory started.\n") + + (define-struct toy (color) #:transparent) + + (define (build-toys n) + (for/list ([i (in-range n)]) + (make-toy 'blue))) + + (define (repaint t col) + (make-toy col))))