PR 10645

svn: r18193

collects/scheme/contract/private/provide.ss

@@ -17,7 +17,7 @@
     [(_ name x) (a:known-good-contract? #'x) #'x]
     [(_ name x) #'(coerce-contract name x)]))
 
-(define-for-syntax (make-provide/contract-transformer contract-id id pos-module-source)
+(define-for-syntax (make-provide/contract-transformer contract-id id external-id pos-module-source)
   (make-set!-transformer
    (let ([saved-id-table (make-hasheq)])
      (λ (stx)
@@ -30,6 +30,7 @@
                         ;; No: lift the contract creation:
                         (with-syntax ([contract-id contract-id]
                                       [id id]
+                                      [external-id external-id]
                                       [pos-module-source pos-module-source]
                                       [id-ref (syntax-case stx (set!)
                                                 [(set! whatever e)
@@ -45,7 +46,7 @@
                                         id
                                         pos-module-source
                                         (quote-module-path)
-                                        'id
+                                        'external-id
                                         (quote-syntax id))))))])
                (when key
                  (hash-set! saved-id-table key lifted-id))
@@ -655,6 +656,7 @@
                                    (define-syntax id-rename
                                      (make-provide/contract-transformer (quote-syntax contract-id)
                                                                         (quote-syntax id)
+                                                                        (quote-syntax external-name)
                                                                         (quote-syntax pos-module-source)))
                                    
                                    (provide (rename-out [id-rename external-name]))))])

collects/tests/mzscheme/contract-test.ss

@@ -7079,7 +7079,8 @@ so that propagation occurs.
       (eval '(require 'provide/contract34-m2))
       (eval 'provide/contract34-x))
    10)
-      
+  
+  
   (contract-error-test
    #'(begin
        (eval '(module pce1-bug scheme/base
@@ -7180,7 +7181,33 @@ so that propagation occurs.
      (printf ">> ~s\n" (exn-message x))
      (and (exn? x)
           (regexp-match #rx"pce8-bug" (exn-message x)))))
+
+  (contract-error-test
+   #'(begin
+       (eval '(module pce9-bug scheme
+                (define (f x) "wrong")
+                (provide/contract
+                 [rename f g
+                         (-> number? number?)])))
+       (eval '(require 'pce9-bug))
+       (eval '(g 12)))
+   (λ (x)
+     (and (exn? x)
+          (regexp-match #rx"broke the contract.*on g" (exn-message x)))))
   
+  (contract-error-test
+   #'(begin
+       (eval '(module pce10-bug scheme
+                (define (f x) "wrong")
+                (provide/contract
+                 [rename f g
+                         (-> number? number?)])))
+       (eval '(require 'pce10-bug))
+       (eval '(g 'a)))
+   (λ (x)
+     (and (exn? x)
+          (regexp-match #rx"broke the contract.*on g" (exn-message x)))))
+   
   (contract-eval
    `(,test
      'pos