add bindings to node.process, make unit tests work with both mocha and node

Hongbo Zhang · Hongbo Zhang · commit 129d5cbc338a · 2016-08-15T10:09:10.000-04:00
diff --git a/jscomp/others/.depend b/jscomp/others/.depend
@@ -1,9 +1,13 @@
-bs_node.cmi : bs_node_path.cmj bs_node_fs.cmj
+bs_node.cmi : bs_node_process.cmj bs_node_path.cmj bs_node_fs.cmj
 bs_node_fs.cmj :
 bs_node_fs.cmx :
 bs_node_path.cmj :
 bs_node_path.cmx :
+bs_node_process.cmj :
+bs_node_process.cmx :
 bs_node_fs.cmo :
 bs_node_fs.cmj :
 bs_node_path.cmo :
 bs_node_path.cmj :
+bs_node_process.cmo :
+bs_node_process.cmj :
diff --git a/jscomp/others/Makefile b/jscomp/others/Makefile
@@ -2,7 +2,7 @@ include ../Makefile.shared
 
 COMPILER=../bin/bsc
 
-SOURCE_LIST= bs_node bs_node_path bs_node_fs
+SOURCE_LIST= bs_node bs_node_path bs_node_fs bs_node_process
 
 
 RUNTIME := $(addsuffix .cmj, $(SOURCE_LIST)) 
diff --git a/jscomp/others/bs_node.mli b/jscomp/others/bs_node.mli
@@ -28,6 +28,8 @@ module Path = Bs_node_path
 
 module Fs = Bs_node_fs
 
+module Process = Bs_node_process
+  
 type node_exports 
 type node_module = <
        id : string ;
diff --git a/jscomp/others/bs_node_process.ml b/jscomp/others/bs_node_process.ml
@@ -0,0 +1,35 @@
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type t =
+  < argv : string array;
+    arch : string ;
+    abort : unit -> unit [@bs.meth];
+    chdir : string -> unit [@bs.meth];
+    (** @raise *)
+    cwd : unit -> string [@bs.meth];
+    disconnect : unit -> unit [@bs.meth];    
+  >   Js.t
+  
+external process : t = "" [@@bs.module]
diff --git a/jscomp/syntax/ast_comb.ml b/jscomp/syntax/ast_comb.ml
@@ -77,7 +77,7 @@ let to_js_type loc  x  =
 let to_js_re_type loc  =
   Typ.constr ~loc { txt = re_id ; loc} []
     
-let to_js_undefined_type loc x =
+let to_undefined_type loc x =
   Typ.constr ~loc
     {txt = Ast_literal.Lid.js_undefined ; loc}
     [x]  
diff --git a/jscomp/syntax/ast_comb.mli b/jscomp/syntax/ast_comb.mli
@@ -58,7 +58,7 @@ val to_js_type :
 
 
 (** TODO: make it work for browser too *)
-val to_js_undefined_type :
+val to_undefined_type :
   Location.t -> Parsetree.core_type -> Parsetree.core_type  
 
 val to_js_re_type : Location.t -> Parsetree.core_type
diff --git a/jscomp/syntax/ast_external_attributes.ml b/jscomp/syntax/ast_external_attributes.ml
@@ -446,7 +446,7 @@ let handle_attributes
                                    Ldot (Lident "*predef*", "option") },
                                 [ty])}
                  ->                
-                 (s, [], Ast_comb.to_js_undefined_type loc ty) :: acc
+                 (s, [], Ast_comb.to_undefined_type loc ty) :: acc
                | _ -> assert false                 
              end                 
            | (_, _), Ast_core_type.Empty -> acc                
diff --git a/jscomp/syntax/ppx_entry.ml b/jscomp/syntax/ppx_entry.ml
@@ -294,31 +294,35 @@ let rec unsafe_mapper : Ast_mapper.mapper =
             ({txt = "bs.node"; loc},
              payload)
           ->
+          let strip s =
+            let len = String.length s in            
+            if s.[len - 1] = '_' then
+              String.sub s 0 (len - 1)
+            else s in                  
           begin match Ast_payload.as_ident payload with
-            | Some {txt = Lident ("__filename" | "__dirname" as name); loc}
+            | Some {txt = Lident
+                        ("__filename"
+                        | "__dirname"
+                        | "module_"
+                        | "require" as name); loc}
               ->
-
-              Exp.constraint_ ~loc
-                (Ast_util.handle_raw loc
-                   (Ast_payload.raw_string_payload loc
-                      name ))                
-                (Ast_literal.type_string ~loc ())
-            | Some {txt = Lident "__module"}
-              ->
-              Exp.constraint_ ~loc
-                (Ast_util.handle_raw loc
-                   (Ast_payload.raw_string_payload loc "module"))                
-                (Typ.constr ~loc
-                   { txt = Ldot (Lident "Bs_node", "node_module") ;
-                     loc} [] )
-            | Some {txt = Lident "__require"}
-              ->
-              Exp.constraint_ ~loc
-                (Ast_util.handle_raw loc
-                   (Ast_payload.raw_string_payload loc "require"))                
-                (Typ.constr ~loc
-                   { txt = Ldot (Lident "Bs_node", "node_require") ;
-                     loc} [] )
+              let exp =
+                Ast_util.handle_raw loc
+                  (Ast_payload.raw_string_payload loc
+                     (strip name) ) in
+              let typ =
+                Ast_comb.to_undefined_type loc @@                 
+                if name = "module_" then
+                  Typ.constr ~loc
+                    { txt = Ldot (Lident "Bs_node", "node_module") ;
+                      loc} []   
+                else if name = "require" then
+                  (Typ.constr ~loc
+                     { txt = Ldot (Lident "Bs_node", "node_require") ;
+                       loc} [] )  
+                else
+                  Ast_literal.type_string ~loc () in                  
+              Exp.constraint_ ~loc exp typ                
             | Some _ | None -> Location.raise_errorf ~loc "Ilegal payload"              
           end             
 
diff --git a/jscomp/test/.depend b/jscomp/test/.depend
@@ -392,8 +392,8 @@ module_missing_conversion.cmx : ../stdlib/string.cmx \
     ../stdlib/moreLabels.cmx ../stdlib/hashtbl.cmx ../stdlib/array.cmx
 module_parameter_test.cmj : ../stdlib/string.cmi mt.cmi
 module_parameter_test.cmx : ../stdlib/string.cmx mt.cmx
-mt.cmj : ../stdlib/list.cmi mt.cmi
-mt.cmx : ../stdlib/list.cmx mt.cmi
+mt.cmj : ../stdlib/list.cmi ../others/bs_node.cmi ../stdlib/array.cmi mt.cmi
+mt.cmx : ../stdlib/list.cmx ../others/bs_node.cmi ../stdlib/array.cmx mt.cmi
 mt_global.cmj : mt.cmi mt_global.cmi
 mt_global.cmx : mt.cmx mt_global.cmi
 mutual_non_recursive_type.cmj :
@@ -1152,8 +1152,8 @@ module_missing_conversion.cmj : ../stdlib/string.cmj \
     ../stdlib/moreLabels.cmj ../stdlib/hashtbl.cmj ../stdlib/array.cmj
 module_parameter_test.cmo : ../stdlib/string.cmi mt.cmi
 module_parameter_test.cmj : ../stdlib/string.cmj mt.cmj
-mt.cmo : ../stdlib/list.cmi mt.cmi
-mt.cmj : ../stdlib/list.cmj mt.cmi
+mt.cmo : ../stdlib/list.cmi ../others/bs_node.cmi ../stdlib/array.cmi mt.cmi
+mt.cmj : ../stdlib/list.cmj ../others/bs_node.cmi ../stdlib/array.cmj mt.cmi
 mt_global.cmo : mt.cmi mt_global.cmi
 mt_global.cmj : mt.cmj mt_global.cmi
 mutual_non_recursive_type.cmo :
diff --git a/jscomp/test/fs_test.js b/jscomp/test/fs_test.js
@@ -1,7 +1,7 @@
 'use strict';
 
-var Fs    = require("fs");
 var Mt    = require("./mt");
+var Fs    = require("fs");
 var Block = require("../../lib/js/block");
 var Path  = require("path");
 
@@ -28,31 +28,36 @@ function eq(loc, param) {
   return /* () */0;
 }
 
-var current_file = (__filename);
+var match = (__filename);
+
+var current_file = match !== undefined ? match : "<Not Node JS>";
+
+var match$1 = (__dirname);
 
-var current_dir_name = (__dirname);
+var current_dir_name = match$1 !== undefined ? match$1 : "<Not Node Js>";
 
 Fs.readFileSync(current_file, "utf8");
 
 Fs.readdirSync(current_dir_name);
 
 var pathobj = Path.parse(current_dir_name);
 
-var module_ = (module);
-
-console.log(/* tuple */[
-      module_.id,
-      module_.paths
-    ]);
-
-eq('File "fs_test.ml", line 38, characters 5-12', /* tuple */[
-      pathobj.name,
-      "test"
-    ]);
+var match$2 = (module);
+
+if (match$2 !== undefined) {
+  console.log(/* tuple */[
+        match$2.id,
+        match$2.paths
+      ]);
+  eq('File "fs_test.ml", line 45, characters 7-14', /* tuple */[
+        pathobj.name,
+        "test"
+      ]);
+}
 
 Mt.from_pair_suites("fs_test.ml", suites[0]);
 
 exports.suites  = suites;
 exports.test_id = test_id;
 exports.eq      = eq;
-/* current_file Not a pure module */
+/* match Not a pure module */
diff --git a/jscomp/test/fs_test.ml b/jscomp/test/fs_test.ml
@@ -28,15 +28,24 @@ external on :
 
 open Bs_node 
 let () =
-  let current_file : string = [%bs.node __filename] in
-  let current_dir_name : string = [%bs.node __dirname] in
+  let current_file : string =
+    match Js.Undefined.to_opt [%bs.node __filename] with
+    | Some x -> x
+    | None -> "<Not Node JS>"  in
+  let current_dir_name : string =
+    match Js.Undefined.to_opt [%bs.node __dirname] with
+    | Some x -> x
+    | None -> "<Not Node Js>"  in
   let _content = readFileSync current_file `utf8 in
   let _file_list = Fs.readdirSync current_dir_name in
   let pathobj =   Path.parse current_dir_name in
-  let module_  = [%bs.node __module] in
-  Js.log (module_##id, module_##paths) ;   
-  eq __LOC__ (pathobj##name, "test" )
+  match Js.Undefined.to_opt [%bs.node module_] with
+  | Some module_ ->   
+    Js.log (module_##id, module_##paths) ;   
+    eq __LOC__ (pathobj##name, "test" )
+  | None -> ()      
 
 
   
-let () = Mt.from_pair_suites __FILE__ !suites
+let () =
+  Mt.from_pair_suites __FILE__ !suites
diff --git a/jscomp/test/mt.js b/jscomp/test/mt.js
@@ -1,62 +1,77 @@
 'use strict';
 
+var Assert                  = require("assert");
+var Path                    = require("path");
 var Caml_builtin_exceptions = require("../../lib/js/caml_builtin_exceptions");
 var Curry                   = require("../../lib/js/curry");
-var Assert                  = require("assert");
+var Process                 = require("process");
+var $$Array                 = require("../../lib/js/array");
 var List                    = require("../../lib/js/list");
 
 function from_suites(name, suite) {
-  describe(name, function () {
-        return List.iter(function (param) {
-                    it(param[0], param[1]);
-                    return /* () */0;
-                  }, suite);
-      });
-  return /* () */0;
+  var match = $$Array.to_list(Process.argv);
+  if (match && Path.basename(match[0]) === "mocha") {
+    describe(name, function () {
+          return List.iter(function (param) {
+                      it(param[0], param[1]);
+                      return /* () */0;
+                    }, suite);
+        });
+    return /* () */0;
+  }
+  else {
+    return /* () */0;
+  }
 }
 
 function close_enough(x, y) {
   return +(Math.abs(x - y) < 0.0000001);
 }
 
 function from_pair_suites(name, suites) {
-  describe(name, function () {
-        return List.iter(function (param) {
-                    var code = param[1];
-                    it(param[0], function () {
-                          var match = Curry._1(code, /* () */0);
-                          switch (match.tag | 0) {
-                            case 0 : 
-                                Assert.deepEqual(match[0], match[1]);
-                                return /* () */0;
-                            case 1 : 
-                                Assert.notDeepEqual(match[0], match[1]);
-                                return /* () */0;
-                            case 2 : 
-                                if (close_enough(match[0], match[1])) {
-                                  return 0;
-                                }
-                                else {
-                                  throw [
-                                        Caml_builtin_exceptions.assert_failure,
-                                        [
-                                          "mt.ml",
-                                          56,
-                                          16
-                                        ]
-                                      ];
-                                }
-                                break;
-                            case 3 : 
-                                Assert.throws(match[0]);
-                                return /* () */0;
-                            
-                          }
-                        });
-                    return /* () */0;
-                  }, suites);
-      });
-  return /* () */0;
+  var match = $$Array.to_list(Process.argv);
+  if (match && Path.basename(match[0]) === "mocha") {
+    describe(name, function () {
+          return List.iter(function (param) {
+                      var code = param[1];
+                      it(param[0], function () {
+                            var match = Curry._1(code, /* () */0);
+                            switch (match.tag | 0) {
+                              case 0 : 
+                                  Assert.deepEqual(match[0], match[1]);
+                                  return /* () */0;
+                              case 1 : 
+                                  Assert.notDeepEqual(match[0], match[1]);
+                                  return /* () */0;
+                              case 2 : 
+                                  if (close_enough(match[0], match[1])) {
+                                    return 0;
+                                  }
+                                  else {
+                                    throw [
+                                          Caml_builtin_exceptions.assert_failure,
+                                          [
+                                            "mt.ml",
+                                            64,
+                                            20
+                                          ]
+                                        ];
+                                  }
+                                  break;
+                              case 3 : 
+                                  Assert.throws(match[0]);
+                                  return /* () */0;
+                              
+                            }
+                          });
+                      return /* () */0;
+                    }, suites);
+        });
+    return /* () */0;
+  }
+  else {
+    return /* () */0;
+  }
 }
 
 exports.from_suites      = from_suites;
diff --git a/jscomp/test/mt.ml b/jscomp/test/mt.ml
diff --git a/jscomp/test/test_require.js b/jscomp/test/test_require.js
diff --git a/jscomp/test/test_require.ml b/jscomp/test/test_require.ml
diff --git a/lib/js/bs_node_process.js b/lib/js/bs_node_process.js
