diff --git a/collects/mzlib/private/unit-compiletime.ss b/collects/mzlib/private/unit-compiletime.ss
index c65a5df3d9..49ad4d8b49 100644
--- a/collects/mzlib/private/unit-compiletime.ss
+++ b/collects/mzlib/private/unit-compiletime.ss
@@ -45,8 +45,8 @@
             (cons (reverse requires) l)))))))
                  
         
-  ;; (make-var-info bool bool identifier (or #f (syntax-object -> syntax-object)))
-  (define-struct var-info (syntax? [exported? #:mutable] id [add-ctc #:mutable]))
+  ;; (make-var-info bool bool identifier (U #f syntax-object))
+  (define-struct var-info (syntax? [exported? #:mutable] id [ctc #:mutable]))
   
   (define-syntax define-struct/proc
     (syntax-rules ()
diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss
index 4503056fd1..e2d1b30118 100644
--- a/collects/mzlib/unit.ss
+++ b/collects/mzlib/unit.ss
@@ -472,9 +472,10 @@
   (define-for-syntax (make-import-unboxing var loc ctc)
     (if ctc
         (quasisyntax/loc (error-syntax)
-          (quote-syntax (contract #,ctc (unbox #,loc) 'cant-happen
-                                  (current-contract-region)
-                                  #,(id->contract-src-info var))))
+          (quote-syntax (let ([v/c (unbox #,loc)])
+                          (contract #,ctc (car v/c) (cdr v/c)
+                                    (current-contract-region)
+                                    #,(id->contract-src-info var)))))
         (quasisyntax/loc (error-syntax)
           (quote-syntax (unbox #,loc)))))
   
@@ -688,11 +689,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-add-ctc! 
-                   v
-                   (λ (e)
-                     #`(contract #,(cdr (syntax-e ctc)) #,e (current-contract-region) 
-                                 'cant-happen #,(id->contract-src-info e)))))))
+                  (set-var-info-ctc! v (cdr (syntax-e ctc))))))
             (syntax->list (localify #'evars def-ctx))
             (syntax->list #'elocs)
             (syntax->list #'ectcs))
@@ -726,11 +723,20 @@
                                                            [(var-info-exported? var-info)
                                                             =>
                                                             (λ (export-loc)
-                                                              (let ([add-ctc (var-info-add-ctc var-info)])
-                                                                (list (quasisyntax/loc defn-or-expr
-                                                                        (set-box! #,export-loc 
-                                                                                  (let ([#,id #,(if add-ctc (add-ctc tmp) tmp)])
-                                                                                    #,id)))
+                                                              (let ([ctc (var-info-ctc var-info)])
+                                                                (list (if ctc
+                                                                          (quasisyntax/loc defn-or-expr
+                                                                            (begin
+                                                                              (contract #,ctc #,tmp
+                                                                                        (current-contract-region)
+                                                                                        'cant-happen
+                                                                                        #,(id->contract-src-info id))
+                                                                              (set-box! #,export-loc 
+                                                                                        (let ([#,id #,tmp])
+                                                                                          (cons #,id (current-contract-region))))))
+                                                                          (quasisyntax/loc defn-or-expr
+                                                                            (set-box! #,export-loc 
+                                                                                      (let ([#,id #,tmp]) #,id))))
                                                                       (quasisyntax/loc defn-or-expr
                                                                         (define-syntax #,id 
                                                                           (make-id-mapper (quote-syntax #,tmp)))))))]
@@ -1216,9 +1222,10 @@
                            (map 
                             (lambda (i v c)
                               (if c
-                                  #`(contract #,c (unbox (vector-ref #,ov #,i))
-                                              'cant-happen (current-contract-region)
-                                              #,(id->contract-src-info v))
+                                  #`(let ([v/c (unbox (vector-ref #,ov #,i))])
+                                      (contract #,c (car v/c) (cdr v/c)
+                                                (current-contract-region)
+                                                #,(id->contract-src-info v)))
                                   #`(unbox (vector-ref #,ov #,i))))
                             (iota (length (car os)))
                             (map car (car os))
diff --git a/collects/tests/units/test-unit-contracts.ss b/collects/tests/units/test-unit-contracts.ss
index 4b355450b5..4b8538ba6d 100644
--- a/collects/tests/units/test-unit-contracts.ss
+++ b/collects/tests/units/test-unit-contracts.ss
@@ -162,3 +162,36 @@
 
 (test-runtime-error exn:fail:contract? "top-level misuses f"
   (f #t))
+
+(define-unit unit10
+  (import sig1 sig2) (export)
+  (if (zero? x)
+      (f 3)
+      (f #t)))
+
+(let ()
+  (define x 0)
+  (define f (lambda (x) #t))
+  (test-runtime-error exn:fail:contract? "top-level (via anonymous unit) provides improper f"
+    (invoke-unit unit10 (import sig1 sig2))))
+
+(let ()
+  (define x 1)
+  (define f values)
+  (test-runtime-error exn:fail:contract? "unit10 misuses f from top-level"
+    (invoke-unit unit10 (import sig1 sig2))))
+
+;; testing that contracts from extended signatures are checked properly
+(define-unit unit11
+  (import) (export sig3)
+  (define (f n) #t)
+  (define (g n) 3))
+
+(let ()
+  (define-values/invoke-unit unit11
+    (import)
+    (export sig3))
+  (test-runtime-error exn:fail:contract? "unit11 provides improper f"
+    (f 3))
+  (test-runtime-error exn:fail:contract? "top-level misuses f"
+    (f #t)))
\ No newline at end of file