Add more tests for require/provide.

Author: LeifAndersen

private/languages.rkt

@@ -35,8 +35,6 @@
                   (submodule id module-path
                              (module-level-form ...))
                   (submodule* id module-path
-                              (module-level-form ...))
-                  (submodule* id
                               (module-level-form ...)))
   (general-top-level-form (general-top-level-form)
                           expr
@@ -115,8 +113,6 @@
                   (- (submodule id module-path
                                 (module-level-form ...))
                      (submodule* id module-path
-                                 (module-level-form ...))
-                     (submodule* id
                                  (module-level-form ...)))
                   (+ (module id module-path
                        (module-level-form ...)

private/passes.rkt

@@ -100,12 +100,6 @@
                   `(submodule* ,(syntax->datum #'id) ,(syntax->datum #'path)
                                (,(for/list ([i (in-list (syntax->list #'(body ...)))])
                                    (parse-mod i env)) ...)))]
-               [(module* id:id path
-                  (#%plain-module-begin body ...))
-                (parameterize ([current-global-env/parse-and-rename (make-hash)])
-                  `(submodule* ,(syntax->datum #'id)
-                               (,(for/list ([i (in-list (syntax->list #'(body ...)))])
-                                   (parse-mod i env)) ...)))]
                [else
                 (parse-gen #'else env)]))
 
@@ -250,12 +244,12 @@
                                   (parse-phaseless-req-spec i env)) ...)]
                             [(for-template phaseless-req-spec ...)
                              `(for-meta
-                               ,#f
+                               ,-1
                                ,(for/list ([i (in-list (syntax->list #'(phaseless-req-spec ...)))])
                                   (parse-phaseless-req-spec i env)) ...)]
                             [(for-label phaseless-req-spec ...)
                              `(for-meta
-                               ,-1
+                               ,#f
                                ,(for/list ([i (in-list (syntax->list #'(phaseless-req-spec ...)))])
                                   (parse-phaseless-req-spec i env)) ...)]
                             [(just-meta phase-level raw-req-spec ...)
@@ -275,7 +269,7 @@
                                `(prefix-all-except ,(syntax-e #'id)
                                                    ,(parse-raw-module-path #'raw-module-path env))]
                               [(all-except raw-module-path ids:id ...)
-                               `(all-except ,(parse-raw-module-path #'raw-module-path)
+                               `(all-except ,(parse-raw-module-path #'raw-module-path env)
                                             ,(map (curryr parse-expr env)
                                                   (syntax->list #'(ids ...))) ...)]
                               [(prefix-all-except id:id raw-module-path ids:id ...)
@@ -284,7 +278,7 @@
                                  ,(parse-raw-module-path #'raw-module-path env)
                                  ,(map (curryr parse-expr env) (syntax->list #'(ids ...))) ...)]
                               [(rename raw-module-path id1:id id2:id)
-                               `(rename ,(parse-raw-module-path #'raw-module-path)
+                               `(rename ,(parse-raw-module-path #'raw-module-path env)
                                         ,(parse-expr #'id1 env)
                                         ,(parse-expr #'id2 env))]
                               [else (parse-raw-module-path #'else env)]))
@@ -391,15 +385,6 @@
                           null
                           (list (with-output-language (Lsubmodules submodule-form)
                                   `(module ,id ,module-path
-                                     (,module-level-form ...)
-                                     (,(append* pre) ...)
-                                     (,(append* post) ...)))))]
-                 [(submodule* ,id
-                              (,[module-level-form pre post] ...))
-                  (values `(#%plain-app (primitive void))
-                          null
-                          (list (with-output-language (Lsubmodules submodule-form)
-                                  `(module ,id #f
                                      (,module-level-form ...)
                                      (,(append* pre) ...)
                                      (,(append* post) ...)))))])

private/tests.rkt

@@ -108,6 +108,8 @@
    (define a (make-variable 'a))
    (define b (make-variable 'b))
    (define c (make-variable 'c))
+   (define match (make-variable 'match))
+   (define match2 (make-variable 'match2))
    (define-compiler-test Lsrc top-level-form
       (check-equal?
        (current-compile #'(lambda (x) x))
@@ -158,6 +160,34 @@
        `(module foo racket/base
           ((#%require racket/match)
            (#%provide (all-from-except racket/match ,(make-variable 'match))))))
+      (check-equal?
+       (current-compile #'(module bar racket/base
+                            (#%plain-module-begin
+                             (#%require (for-template racket/base)
+                                        (for-label racket/base)
+                                        (just-meta 0 racket))
+                             42)))
+       `(module bar racket/base
+          ((#%require (for-meta -1 racket/base)
+                      (for-meta #f racket/base)
+                      (just-meta 0 racket))
+           '42)))
+      (check-equal?
+       (current-compile #'(module bar racket/base
+                            (#%plain-module-begin
+                             (#%require (only racket/match match)
+                                        (all-except racket/match match)
+                                        (rename racket/match match2 match)
+                                        (prefix-all-except match: racket/match match)
+                                        ; TODO (planet "match" ("match" "match")) ; Not a real package
+                                        ))))
+       `(module bar racket/base
+          ((#%require (only racket/match ,match)
+                      (all-except racket/match ,match)
+                      (rename racket/match ,match2 ,match)
+                      (prefix-all-except match: racket/match ,match)
+                      ; TODO (planet "match" ("match" "match"))
+                      ))))
       (check-equal?
        (current-compile #'(module bar racket
                             (#%plain-module-begin
@@ -214,6 +244,17 @@
           ()
           ((module test #f
              (,x) () ()))))
+      (check-equal?
+       (current-compile #'(module outer racket
+                            (#%plain-module-begin
+                             (module* inner #f
+                               (#%plain-module-begin
+                                5)))))
+       `(module outer racket
+          ((#%plain-app (primitive void)))
+          ()
+          ((module inner #f
+             ('5) () ()))))
       (check-equal?
        (current-compile #'(module foo racket/base
                             (#%plain-module-begin