From 31a629ff9c60b446bfd1f7c525d3853e4f4833d9 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 7 Jan 2011 05:15:26 -0600
Subject: [PATCH] make provide/contract work properly when it is the only thing
 in a module body   closes PR 11596

---
 collects/racket/contract/private/provide.rkt | 18 +++++++++++++++++-
 collects/tests/racket/contract-test.rktl     | 16 ++++++++++++++++
 2 files changed, 33 insertions(+), 1 deletion(-)

diff --git a/collects/racket/contract/private/provide.rkt b/collects/racket/contract/private/provide.rkt
index b252064be7..513961d9e2 100644
--- a/collects/racket/contract/private/provide.rkt
+++ b/collects/racket/contract/private/provide.rkt
@@ -123,7 +123,7 @@
            ;; delay expansion until it's a good time to lift expressions:
            (quasisyntax/loc stx (#%expression #,stx)))))))
 
-(define-syntax (provide/contract provide-stx)
+(define-for-syntax (true-provide/contract provide-stx)
   (syntax-case provide-stx (struct)
     [(_ p/c-ele ...)
      (let ()
@@ -756,6 +756,22 @@
           (begin
             bodies ...))))]))
 
+(define-syntax (provide/contract stx)
+  (define s-l-c (syntax-local-context))
+  (case s-l-c
+   [(module-begin) ;; the case under discussion
+    #`(begin (define-values () (values))  ;; force us into the 'module' local context
+             #,stx)]
+   [(module) ;; the good case
+    (true-provide/contract stx)]
+   [else ;; expression or internal definition
+    (raise-syntax-error 'provide/contract 
+                        (format "not allowed in a ~a context"
+                                (if (pair? s-l-c)
+                                    "internal definition"
+                                    s-l-c))
+                        stx)]))
+
 (define (make-pc-struct-type struct-name struct:struct-name . ctcs)
   (let-values ([(struct:struct-name _make _pred _get _set)
                 (make-struct-type struct-name
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index b971c8782f..2873d66042 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -10925,6 +10925,22 @@ so that propagation occurs.
               
               (contract-eval '(require 'provide/contract-35/n)))))
   
+  ;; test that provide/contract by itself in a module doesn't signal an error
+  (test/spec-passed/result
+   'provide/contract35
+   '(begin
+      (eval '(module provide/contract35-m1 racket
+               (provide/contract [add1 (-> number? number?)])))
+      
+      (eval '(module provide/contract35-m2 racket/base
+               (require 'provide/contract35-m1)
+               (provide provide/contract35-three)
+               (define provide/contract35-three (add1 2))))
+      
+      (eval '(require 'provide/contract35-m2))
+      (eval 'provide/contract35-three))
+   3)
+  
   (contract-error-test
    #'(begin
        (eval '(module pce1-bug scheme/base