fix 'module-langugage tracking

svn: r11832

collects/tests/mzscheme/lang/reader.ss

@@ -0,0 +1,16 @@
+#lang scheme/base
+
+(require syntax/module-reader)
+(provide (rename-out [my-read read]
+                     [my-read-syntax read-syntax]))
+
+(define (my-read port modpath line col pos)
+  (wrap-read-all 'scheme port read modpath (object-name port) line col pos))
+
+(define (my-read-syntax src port modpath line col pos)
+  (syntax-property
+   (datum->syntax #f
+                  (wrap-read-all 'scheme port (lambda (in) (read-syntax src in)) modpath src line col pos)
+                  #f)
+   'module-language
+   '#(tests/mzscheme/lang/getinfo get-info closure-data)))

collects/tests/mzscheme/module.ss

@@ -407,6 +407,33 @@
 (test #t module-path? '(planet "foo.ss" ("robby" "redex.plt") "sub" "deeper"))
 (test #t module-path? '(planet "foo%2e.ss" ("robby%2e" "redex%2e.plt") "sub%2e" "%2edeeper"))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check 'module-language, `module-compiled-language-info', and `module->language-info'
+
+(let ([mk (lambda (val)
+            (compile (syntax-property #'(module m scheme/base)
+                                      'module-language
+                                      val)))])
+  (test #f 'info (module-compiled-language-info (mk 10)))
+  (test '#(scheme x "whatever") 'info (module-compiled-language-info (mk '#(scheme x "whatever"))))
+  (let ([ns (make-base-namespace)])
+    (parameterize ([current-namespace ns])
+      (eval mk ns)
+      (eval (mk '#(scheme x "whatever")))
+      (test '#(scheme x "whatever") module->language-info ''m)
+      (let ([path (build-path (collection-path "tests" "mzscheme")
+                              "langm.ss")])
+        (parameterize ([read-accept-reader #t]
+                       [current-module-declare-name (module-path-index-resolve
+                                                     (module-path-index-join path #f))])
+          (eval
+           (read-syntax path
+                        (open-input-string "#lang tests/mzscheme (provide x) (define x 1)"
+                                           path)))
+          ((current-module-name-resolver) (current-module-declare-name))))
+      (test '#(tests/mzscheme/lang/getinfo get-info closure-data)
+            module->language-info 'tests/mzscheme/langm))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

src/mzscheme/src/eval.c

@@ -4715,7 +4715,7 @@ static Scheme_Object *add_renames_unless_module(Scheme_Object *form, Scheme_Env
 	     module's language take over. */
 	  d = SCHEME_STX_CDR(form);
 	  a = scheme_make_pair(a, d);
-	  form = scheme_datum_to_syntax(a, form, form, 1, 0);
+	  form = scheme_datum_to_syntax(a, form, form, 0, 1);
 	  return form;
 	}
       }
@@ -9282,7 +9282,7 @@ static Scheme_Object *do_eval_string_all(const char *str, Scheme_Env *env, int c
                                                       scheme_sys_wraps(NULL), 
                                                       0, 0),
                                SCHEME_CDR(m));
-          expr = scheme_datum_to_syntax(m, expr, expr, 0, 0);
+          expr = scheme_datum_to_syntax(m, expr, expr, 0, 1);
         }
       }
     }

src/mzscheme/src/module.c

@@ -5267,8 +5267,8 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
 
     m->ii_src = NULL;
 
-    pv = scheme_stx_property(form, scheme_intern_symbol("module-lanuage"), NULL);
+    pv = scheme_stx_property(form, scheme_intern_symbol("module-language"), NULL);
-    if (pv) {
+    if (pv && SCHEME_TRUEP(pv)) {
       if (SCHEME_VECTORP(pv)
           && (3 == SCHEME_VEC_SIZE(pv))
           && scheme_is_module_path(SCHEME_VEC_ELS(pv)[0])