From ce10c4a5fc5ed7543c633957d08fda0bb89e20e3 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 22 Sep 2008 13:08:40 +0000
Subject: [PATCH] fix 'module-langugage tracking

svn: r11832
---
 collects/tests/mzscheme/lang/reader.ss | 16 +++++++++++++++
 collects/tests/mzscheme/module.ss      | 27 ++++++++++++++++++++++++++
 src/mzscheme/src/eval.c                |  4 ++--
 src/mzscheme/src/module.c              |  4 ++--
 4 files changed, 47 insertions(+), 4 deletions(-)
 create mode 100644 collects/tests/mzscheme/lang/reader.ss

diff --git a/collects/tests/mzscheme/lang/reader.ss b/collects/tests/mzscheme/lang/reader.ss
new file mode 100644
index 0000000000..a3a965777c
--- /dev/null
+++ b/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)))
diff --git a/collects/tests/mzscheme/module.ss b/collects/tests/mzscheme/module.ss
index 5223abf88d..3cd2d93fa2 100644
--- a/collects/tests/mzscheme/module.ss
+++ b/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)
diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c
index a15da6a97f..9b2fe75ef1 100644
--- a/src/mzscheme/src/eval.c
+++ b/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);
         }
       }
     }
diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c
index f12fa6a763..a22bbff3f0 100644
--- a/src/mzscheme/src/module.c
+++ b/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);
-    if (pv) {
+    pv = scheme_stx_property(form, scheme_intern_symbol("module-language"), NULL);
+    if (pv && SCHEME_TRUEP(pv)) {
       if (SCHEME_VECTORP(pv)
           && (3 == SCHEME_VEC_SIZE(pv))
           && scheme_is_module_path(SCHEME_VEC_ELS(pv)[0])