fix global exception compilation

Author: Hongbo Zhang

jscomp/lam_util.ml

@@ -56,11 +56,18 @@ let sort_dag_args  param_args =
 
 
 let add_required_module (x : Ident.t) (meta : Lam_stats.meta) = 
-  meta.required_modules <- Lam_module_ident.of_ml x :: meta.required_modules 
+  if not @@ Ident.is_predef_exn x then   
+    meta.required_modules <- Lam_module_ident.of_ml x :: meta.required_modules 
 
 let add_required_modules ( x : Ident.t list) (meta : Lam_stats.meta) = 
-  meta.required_modules <- List.map (fun x ->  Lam_module_ident.of_ml x)  x
-    @ meta.required_modules
+  let required_modules = 
+    Ext_list.filter_map 
+      (fun x ->
+         if Ident.is_predef_exn x then
+           None 
+         else Some ( Lam_module_ident.of_ml x))  x
+    @ meta.required_modules in
+  meta.required_modules <- required_modules
 
 (* Apply a substitution to a lambda-term.
    Assumes that the bound variables of the lambda-term do not

jscomp/test/.depend

@@ -88,6 +88,8 @@ for_loop_test.cmo : mt.cmo ../stdlib/list.cmi ../stdlib/array.cmi
 for_loop_test.cmx : mt.cmx ../stdlib/list.cmx ../stdlib/array.cmx
 for_side_effect_test.cmo : mt.cmo
 for_side_effect_test.cmx : mt.cmx
+global_exception_regression_test.cmo : mt.cmo
+global_exception_regression_test.cmx : mt.cmx
 google_closure_test.cmo : test_google_closure.cmo mt.cmo
 google_closure_test.cmx : test_google_closure.cmx mt.cmx
 hashtbl_test.cmo : mt.cmo ../stdlib/list.cmi ../stdlib/hashtbl.cmi \
@@ -444,6 +446,8 @@ for_loop_test.cmo : mt.cmo ../stdlib/list.cmi ../stdlib/array.cmi
 for_loop_test.cmj : mt.cmj ../stdlib/list.cmj ../stdlib/array.cmj
 for_side_effect_test.cmo : mt.cmo
 for_side_effect_test.cmj : mt.cmj
+global_exception_regression_test.cmo : mt.cmo
+global_exception_regression_test.cmj : mt.cmj
 google_closure_test.cmo : test_google_closure.cmo mt.cmo
 google_closure_test.cmj : test_google_closure.cmj mt.cmj
 hashtbl_test.cmo : mt.cmo ../stdlib/list.cmi ../stdlib/hashtbl.cmi \

jscomp/test/global_exception_regression_test.d.ts

@@ -0,0 +1,5 @@
+export var v: any ;
+export var u: any ;
+export var s: any ;
+export var suites: any ;
+

jscomp/test/global_exception_regression_test.js

@@ -0,0 +1,53 @@
+// Generated CODE, PLEASE EDIT WITH CARE
+'use strict';
+
+var Caml_exceptions = require("../runtime/caml_exceptions");
+var Mt              = require("./mt");
+
+var v = Caml_exceptions.Not_found;
+
+var u = Caml_exceptions.Not_found;
+
+var s = Caml_exceptions.End_of_file;
+
+var suites_001 = [
+  /* tuple */0,
+  "not_found_equal",
+  function () {
+    return [
+            /* Eq */0,
+            u,
+            v
+          ];
+  }
+];
+
+var suites_002 = [
+  /* :: */0,
+  [
+    /* tuple */0,
+    "not_found_not_equal_end_of_file",
+    function () {
+      return [
+              /* Neq */1,
+              u,
+              s
+            ];
+    }
+  ],
+  /* [] */0
+];
+
+var suites = [
+  /* :: */0,
+  suites_001,
+  suites_002
+];
+
+Mt.from_pair_suites("global_exception_regression_test.ml", suites);
+
+exports.v      = v;
+exports.u      = u;
+exports.s      = s;
+exports.suites = suites;
+/*  Not a pure module */

jscomp/test/global_exception_regression_test.ml

@@ -0,0 +1,12 @@
+
+let v = Not_found 
+
+
+let u = Not_found 
+let s = End_of_file
+let suites = Mt.[
+  "not_found_equal", (fun _ -> Eq(u,v));
+  "not_found_not_equal_end_of_file", (fun _ -> Neq(u,s))
+]
+
+;; Mt.from_pair_suites __FILE__ suites

jscomp/test/mt.d.ts

@@ -1,4 +1,5 @@
 export var assert_equal: (prim : any, prim : any) => any ;
+export var assert_notequal: (prim : any, prim : any) => any ;
 export var from_suites: (name : any, suite : any) => any ;
 export var from_pair_suites: (name : any, suites : any) => any ;
 

jscomp/test/mt.js

@@ -8,6 +8,10 @@ function assert_equal(prim, prim$1) {
   return Assert.deepEqual(prim, prim$1);
 }
 
+function assert_notequal(prim, prim$1) {
+  return Assert.notDeepEqual(prim, prim$1);
+}
+
 function from_suites(name, suite) {
   return describe(name, function () {
               return List.iter(function (param) {
@@ -22,13 +26,19 @@ function from_pair_suites(name, suites) {
                           var code = param[2];
                           return it(param[1], function () {
                                       var match = code(/* () */0);
-                                      return Assert.deepEqual(match[1], match[2]);
+                                      if (match[0]) {
+                                        return Assert.notDeepEqual(match[1], match[2]);
+                                      }
+                                      else {
+                                        return Assert.deepEqual(match[1], match[2]);
+                                      }
                                     });
                         }, suites);
             });
 }
 
 exports.assert_equal     = assert_equal;
+exports.assert_notequal  = assert_notequal;
 exports.from_suites      = from_suites;
 exports.from_pair_suites = from_pair_suites;
 /* assert Not a pure module */

jscomp/test/mt.ml

@@ -10,6 +10,10 @@ external eq : 'a -> 'a -> unit = ""
     [@@js.call "deepEqual"]
     [@@js.module "assert"]
 
+external neq : 'a -> 'a -> unit = "" 
+    [@@js.call "notDeepEqual"]
+    [@@js.module "assert"]
+
 (* external dump : 'a array -> unit = "js_dump" [@@js.splice] *)
 
 external dump : 'a array -> unit = "" [@@js.call "console.log"] [@@js.splice]
@@ -18,6 +22,7 @@ external dump : 'a array -> unit = "" [@@js.call "console.log"] [@@js.splice]
  *)
 
 let assert_equal = eq 
+let assert_notequal = neq
 (* assert -- raises an AssertionError which mocha handls better
 *)
 let from_suites name (suite :  (string * ('a -> unit)) list) = 
@@ -26,12 +31,16 @@ let from_suites name (suite :  (string * ('a -> unit)) list) =
 
 type _ eq = 
   | Eq :  'a *'a  -> _ eq
-
+  | Neq : 'a * 'a -> _ eq
 
 type 'a pair_suites = (string * (unit -> 'a eq)) list
 let from_pair_suites name (suites : 'a pair_suites) = 
   describe name (fun _ -> 
     List.iter (fun (name, code) -> 
-      it name (fun _ -> let (Eq (a,b)) = code () in assert_equal a b)
+      it name (fun _ -> 
+              match code () with 
+              | Eq(a,b) -> assert_equal a b 
+              | Neq(a,b) -> assert_notequal a b 
+            )
               ) suites
                 ) 

jscomp/test/test.mllib

@@ -155,4 +155,5 @@ ari_regress_test
 record_with_test
 complex_if_test
 module_parameter_test
-regression_print
+regression_print
+global_exception_regression_test